home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.yorku.ca 2015 / ftp.cs.yorku.ca.tar / ftp.cs.yorku.ca / pub / ostroff / tools / build.changes.Z / build.changes
Text File  |  1995-10-05  |  2MB  |  55,794 lines

  1.  
  2.  
  3. Object subclass: #GraphNode
  4.     instanceVariableNames: ''
  5.     classVariableNames: ''
  6.     poolDictionaries: ''
  7.     category: 'Collections-Graph Nodes'!
  8. GraphNode comment:
  9. '=================================================
  10.     Copyright (c) 1992 by Justin O. Graver.
  11.     All rights reserved (with exceptions).
  12.     For complete information evaluate "Object tgenCopyright."
  13. =================================================
  14.  
  15. I am an abstract class of graph nodes.'!
  16.  
  17. GraphNode comment:
  18. '=================================================
  19.     Copyright (c) 1992 by Justin O. Graver.
  20.     All rights reserved (with exceptions).
  21.     For complete information evaluate "Object tgenCopyright."
  22. =================================================
  23.  
  24. I am an abstract class of graph nodes.'!
  25.  
  26. GraphNode subclass: #EdgeLabeledDigraphNode
  27.     instanceVariableNames: 'edgeLabelMap '
  28.     classVariableNames: ''
  29.     poolDictionaries: ''
  30.     category: 'Collections-Graph Nodes'!
  31. EdgeLabeledDigraphNode comment:
  32. '=================================================
  33.     Copyright (c) 1992 by Justin O. Graver.
  34.     All rights reserved (with exceptions).
  35.     For complete information evaluate "Object tgenCopyright."
  36. =================================================
  37.  
  38. I represent a node in an edge-labeled digraph.
  39.  
  40. Instance Variables:
  41.  
  42.     edgeLabelMap        <SetDictionary from: labels to: successors>'!
  43.  
  44. EdgeLabeledDigraphNode comment:
  45. '=================================================
  46.     Copyright (c) 1992 by Justin O. Graver.
  47.     All rights reserved (with exceptions).
  48.     For complete information evaluate "Object tgenCopyright."
  49. =================================================
  50.  
  51. I represent a node in an edge-labeled digraph.
  52.  
  53. Instance Variables:
  54.  
  55.     edgeLabelMap        <SetDictionary from: labels to: successors>'!
  56.  
  57. !EdgeLabeledDigraphNode methodsFor: 'accessing'!
  58. successors
  59.  
  60.     ^self edgeLabelMap elements! !
  61.  
  62. !EdgeLabeledDigraphNode methodsFor: 'state accessing'!
  63. edgeLabelMap
  64.  
  65.     ^edgeLabelMap! !
  66.  
  67. !EdgeLabeledDigraphNode methodsFor: 'state accessing'!
  68. edgeLabelMap: argument 
  69.  
  70.     edgeLabelMap := argument! !
  71.  
  72. !EdgeLabeledDigraphNode methodsFor: 'initialization'!
  73. init
  74.  
  75.     self edgeLabelMap: SetDictionary new! !
  76.  
  77. !EdgeLabeledDigraphNode methodsFor: 'enumerating'!
  78. successorsDo: aBlock 
  79.  
  80.     self successors do: aBlock! !
  81.  
  82. !EdgeLabeledDigraphNode methodsFor: 'enumerating'!
  83. successorsExceptSelfDo: aBlock 
  84.  
  85.     (self successors reject: [:succ | succ = self])
  86.         do: aBlock! !
  87.  
  88. !EdgeLabeledDigraphNode methodsFor: 'modifying'!
  89. addSuccessor: node withEdgeLabeled: label 
  90.  
  91.     self edgeLabelMap at: label add: node! !
  92.  
  93. !EdgeLabeledDigraphNode methodsFor: 'printing'!
  94. printOn: aStream 
  95.  
  96.     self hash printOn: aStream.
  97.     aStream nextPutAll: ': '; crtab.
  98.     self edgeLabelMap
  99.         associationsDo: 
  100.             [:assoc | 
  101.             assoc key printOn: aStream.
  102.             aStream nextPutAll: ' ==> '.
  103.             assoc value hash printOn: aStream.
  104.             aStream crtab]! !
  105.  
  106. !EdgeLabeledDigraphNode methodsFor: 'converting'!
  107. spaceOptimizeMap
  108.     "Assumes self edgeLabelMap isDeterministic. 
  109.     Note: doing this will dissable the messages #successors, 
  110.     #addSuccessor:withEdgeLabeled:, and any senders of them, 
  111.     since they assume a SetDictionary."
  112.  
  113.     self edgeLabelMap: self edgeLabelMap asDictionary! !
  114.  
  115. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  116.  
  117. EdgeLabeledDigraphNode class
  118.     instanceVariableNames: ''!
  119.  
  120. !EdgeLabeledDigraphNode class methodsFor: 'instance creation'!
  121. new
  122.  
  123.     ^super new init! !
  124.  
  125. GraphNode subclass: #DirectedGraphNode
  126.     instanceVariableNames: 'predecessors '
  127.     classVariableNames: ''
  128.     poolDictionaries: ''
  129.     category: 'Collections-Graph Nodes'!
  130. DirectedGraphNode comment:
  131. '=================================================
  132.     Copyright (c) 1992 by Justin O. Graver.
  133.     All rights reserved (with exceptions).
  134.     For complete information evaluate "Object tgenCopyright."
  135. =================================================
  136.  
  137. I maintain a collection of my predecessor nodes.
  138.  
  139. Instance Variables:
  140.     predecessors        <OrderedCollection of: DirectedGraphNode>'!
  141.  
  142. DirectedGraphNode comment:
  143. '=================================================
  144.     Copyright (c) 1992 by Justin O. Graver.
  145.     All rights reserved (with exceptions).
  146.     For complete information evaluate "Object tgenCopyright."
  147. =================================================
  148.  
  149. I maintain a collection of my predecessor nodes.
  150.  
  151. Instance Variables:
  152.     predecessors        <OrderedCollection of: DirectedGraphNode>'!
  153.  
  154. !DirectedGraphNode methodsFor: 'state accessing'!
  155. predecessors
  156.  
  157.     ^predecessors! !
  158.  
  159. !DirectedGraphNode methodsFor: 'state accessing'!
  160. predecessors: argument 
  161.  
  162.     predecessors := argument! !
  163.  
  164. !DirectedGraphNode methodsFor: 'initialization'!
  165. init
  166.  
  167.     self predecessors: OrderedCollection new! !
  168.  
  169. !DirectedGraphNode methodsFor: 'modifying'!
  170. addPredecessor: node 
  171.  
  172.     self predecessors add: node! !
  173.  
  174. !DirectedGraphNode methodsFor: 'modifying'!
  175. removePredecessor: node 
  176.  
  177.     self predecessors remove: node ifAbsent: [self error: 'precedessor not found']! !
  178.  
  179. !DirectedGraphNode methodsFor: 'modifying'!
  180. removePredecessor: node ifAbsent: aBlock 
  181.  
  182.     self predecessors remove: node ifAbsent: [^aBlock value]! !
  183.  
  184. !DirectedGraphNode methodsFor: 'enumerating'!
  185. predecessorsDo: aBlock 
  186.     "Evaluate aBlock with each of my predecessors."
  187.  
  188.     self predecessors do: aBlock! !
  189.  
  190. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  191.  
  192. DirectedGraphNode class
  193.     instanceVariableNames: ''!
  194.  
  195. !DirectedGraphNode class methodsFor: 'instance creation'!
  196. new
  197.  
  198.     ^super new init! !
  199.  
  200. DirectedGraphNode subclass: #NodeLabeledDigraphNode
  201.     instanceVariableNames: 'label '
  202.     classVariableNames: ''
  203.     poolDictionaries: ''
  204.     category: 'Collections-Graph Nodes'!
  205. NodeLabeledDigraphNode comment:
  206. '=================================================
  207.     Copyright (c) 1992 by Justin O. Graver.
  208.     All rights reserved (with exceptions).
  209.     For complete information evaluate "Object tgenCopyright."
  210. =================================================
  211.  
  212. I add labels to my nodes.  Node labels are assumed to be unique (see LabeledDigraph) although hashing and such is still done based on the node itself.
  213.  
  214. Instance Variables:
  215.     label    <String>'!
  216.  
  217. NodeLabeledDigraphNode comment:
  218. '=================================================
  219.     Copyright (c) 1992 by Justin O. Graver.
  220.     All rights reserved (with exceptions).
  221.     For complete information evaluate "Object tgenCopyright."
  222. =================================================
  223.  
  224. I add labels to my nodes.  Node labels are assumed to be unique (see LabeledDigraph) although hashing and such is still done based on the node itself.
  225.  
  226. Instance Variables:
  227.     label    <String>'!
  228.  
  229. !NodeLabeledDigraphNode methodsFor: 'state accessing'!
  230. label
  231.  
  232.     ^label! !
  233.  
  234. !NodeLabeledDigraphNode methodsFor: 'state accessing'!
  235. label: argument 
  236.  
  237.     label := argument! !
  238.  
  239. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  240.  
  241. NodeLabeledDigraphNode class
  242.     instanceVariableNames: ''!
  243.  
  244. !NodeLabeledDigraphNode class methodsFor: 'instance creation'!
  245. label: arg1 
  246.  
  247.     | newMe |
  248.     newMe := self new.
  249.     newMe label: arg1.
  250.     ^newMe! !
  251.  
  252. Object subclass: #TreeNode
  253.     instanceVariableNames: ''
  254.     classVariableNames: ''
  255.     poolDictionaries: ''
  256.     category: 'Collections-Graph Nodes'!
  257. TreeNode comment:
  258. '=================================================
  259.     Copyright (c) 1992 by Justin O. Graver.
  260.     All rights reserved (with exceptions).
  261.     For complete information evaluate "Object tgenCopyright."
  262. =================================================
  263.  
  264. This abstract class provides the framework for both destructive and non-destructive tree traversals in which references to locally global objects are available without being explicitly passed as arguments.
  265.  
  266. Concrete subclasses must implement methods for traversing
  267.  
  268.     childrenDo:
  269.         "Evaluate the argument block with each of my children."
  270.  
  271.     updateChildrenUsing:
  272.         "Replace my children with the result of evaluating the argument block with the corresponding child."'!
  273.  
  274. TreeNode comment:
  275. '=================================================
  276.     Copyright (c) 1992 by Justin O. Graver.
  277.     All rights reserved (with exceptions).
  278.     For complete information evaluate "Object tgenCopyright."
  279. =================================================
  280.  
  281. This abstract class provides the framework for both destructive and non-destructive tree traversals in which references to locally global objects are available without being explicitly passed as arguments.
  282.  
  283. Concrete subclasses must implement methods for traversing
  284.  
  285.     childrenDo:
  286.         "Evaluate the argument block with each of my children."
  287.  
  288.     updateChildrenUsing:
  289.         "Replace my children with the result of evaluating the argument block with the corresponding child."'!
  290.  
  291. !TreeNode methodsFor: 'traversing'!
  292. childrenDo: aBlock
  293.     "Evaluate aBlock for each of my children.
  294.     This message should be reimplemented by my subclasses."
  295.  
  296.     ^self        "default"! !
  297.  
  298. !TreeNode methodsFor: 'traversing'!
  299. preorderDo: preBlock updateUsing: postBlock 
  300.     "Perform a traversal on myself and my children.  The preBlock is
  301.     evaluated when first entering a node.  My children are replaced
  302.     with the results of the traversal.  Thus, this message can be used
  303.     to generate objects or alter my structure, whereas postorderDo:
  304.     can only be used to examine my structure.  This message may be
  305.     used in the following manner. 
  306.      
  307.     a := aMethodNode
  308.         preorderDo: [:node | node msg1]
  309.         updateUsing: [:node | node msg2: globalRef]"
  310.  
  311.     preBlock value: self.
  312.     self updateChildrenUsing: [:child | child preorderDo: preBlock updateUsing: postBlock].
  313.     ^postBlock value: self! !
  314.  
  315. !TreeNode methodsFor: 'traversing'!
  316. updateChildrenUsing: aBlock
  317.     "Replace my children according to the value of aBlock.
  318.     This message should be reimplemented by my subclasses."
  319.  
  320.     ^self        "default"! !
  321.  
  322. !TreeNode methodsFor: 'traversing'!
  323. updateCopyUsing: aBlock 
  324.     "Perform a postorder traversal on a copy of myself and
  325.     my children, replacing my children with the results of the traversal. 
  326.     Thus, this message can be used to generate objects or alter 
  327.     my structure, whereas postorderDo: can only be used to examine 
  328.     my structure.  This message may be used in the following manner. 
  329.      
  330.     a := aMethodNode updateCopyUsing: [:node | node msg: globalRef]"
  331.  
  332.     | newNode |
  333.     newNode := self copy.
  334.     newNode updateChildrenUsing: [:child | child updateCopyUsing: aBlock].
  335.     ^aBlock value: newNode! !
  336.  
  337. !TreeNode methodsFor: 'traversing'!
  338. updateUsing: aBlock 
  339.     "Perform a postorder traversal on myself and my children, 
  340.     replacing my children with the results of the traversal. 
  341.     Thus, this message can be used to generate objects or alter 
  342.     my structure, whereas postorderDo: can only be used to examine 
  343.     my structure.  This message may be used in the following manner. 
  344.      
  345.     a := aMethodNode updateUsing: [:node | node msg: globalRef]"
  346.  
  347.     self updateChildrenUsing: [:child | child updateUsing: aBlock].
  348.     ^aBlock value: self! !
  349.  
  350. !TreeNode methodsFor: 'copying'!
  351. copyTree
  352.     "Answer a copy of this tree."
  353.  
  354.     ^self copy updateChildrenUsing: [:child | child copyTree]! !
  355.  
  356. !TreeNode methodsFor: 'enumerating'!
  357. postorderDo: aBlock
  358.     "Perform a postorder traversal on myself and my children.
  359.     This message may be used for examining the nodes of a tree
  360.     for the purpose of gathering data or altering data fields.
  361.     To alter the structure of the tree see traverseDo:.  One of
  362.     the main advantages of this message is that it allows all nodes
  363.     of the tree 'global' access to objects referenced in aBlock.
  364.     Before, such arguments had to be passed explitely as arguments.
  365.     This message may be used as follows.
  366.  
  367.     aMethodNode postorderDo: [:node | node enc: encoder root: self]"
  368.  
  369.     self childrenDo: [:child | child postorderDo: aBlock].
  370.     aBlock value: self! !
  371.  
  372. !TreeNode methodsFor: 'enumerating'!
  373. preorderDo: preBlock postorderDo: postBlock 
  374.     "Perform a traversal on myself and my children.  The preBlock is 
  375.     evaluated when entering a node and postBlock is evaluated just before 
  376.     leaving.  See comment in postorderDo:."
  377.  
  378.     preBlock value: self.
  379.     self childrenDo: [:child | child preorderDo: preBlock postorderDo: postBlock].
  380.     postBlock value: self! !
  381.  
  382. EdgeLabeledDigraphNode subclass: #FSAState
  383.     instanceVariableNames: ''
  384.     classVariableNames: ''
  385.     poolDictionaries: ''
  386.     category: 'T-gen-Scanning/Parsing'!
  387.  
  388. FSAState subclass: #BidirectionalEdgeLabeledDigraphNode
  389.     instanceVariableNames: 'predecessorLabelMap '
  390.     classVariableNames: ''
  391.     poolDictionaries: ''
  392.     category: 'Collections-Graph Nodes'!
  393. BidirectionalEdgeLabeledDigraphNode comment:
  394. '=================================================
  395.     Copyright (c) 1992 by Justin O. Graver.
  396.     All rights reserved (with exceptions).
  397.     For complete information evaluate "Object tgenCopyright."
  398. =================================================
  399.  
  400. I represent a node in an edge-labeled digraph.  I maintain edges in both directions, i.e. I can follow edges forwards or backwards.
  401.  
  402. Instance Variables:
  403.  
  404.     predecessorLabelMap        <SetDictionary from: labels to: predecessors>'!
  405.  
  406. BidirectionalEdgeLabeledDigraphNode comment:
  407. '=================================================
  408.     Copyright (c) 1992 by Justin O. Graver.
  409.     All rights reserved (with exceptions).
  410.     For complete information evaluate "Object tgenCopyright."
  411. =================================================
  412.  
  413. I represent a node in an edge-labeled digraph.  I maintain edges in both directions, i.e. I can follow edges forwards or backwards.
  414.  
  415. Instance Variables:
  416.  
  417.     predecessorLabelMap        <SetDictionary from: labels to: predecessors>'!
  418.  
  419. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'state accessing'!
  420. predecessorLabelMap
  421.  
  422.     ^predecessorLabelMap! !
  423.  
  424. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'state accessing'!
  425. predecessorLabelMap: argument 
  426.  
  427.     predecessorLabelMap := argument! !
  428.  
  429. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'initialization'!
  430. init
  431.  
  432.     super init.
  433.     self predecessorLabelMap: SetDictionary new! !
  434.  
  435. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'modifying'!
  436. addPredecessor: node withEdgeLabeled: label 
  437.  
  438.     self predecessorLabelMap at: label add: node! !
  439.  
  440. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'accessing'!
  441. predecessors
  442.  
  443.     ^self predecessorLabelMap elements! !
  444.  
  445. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'enumerating'!
  446. predecessorsDo: aBlock 
  447.  
  448.     self predecessors do: aBlock! !
  449.  
  450. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'enumerating'!
  451. predecessorsExceptSelfDo: aBlock 
  452.  
  453.     (self predecessors reject: [:pred | pred = self])
  454.         do: aBlock! !
  455.  
  456. Object subclass: #AbstractParser
  457.     instanceVariableNames: 'scanner prevToken requestor failBlock '
  458.     classVariableNames: ''
  459.     poolDictionaries: ''
  460.     category: 'Compilers-Parsers'!
  461. AbstractParser comment:
  462. '=================================================
  463.     Copyright (c) 1992 by Justin O. Graver.
  464.     All rights reserved (with exceptions).
  465.     For complete information evaluate "Object tgenCopyright."
  466. =================================================
  467.  
  468. This class represents abstract parsing behavior.
  469.  
  470. Instance Variables:
  471.  
  472.     scanner <a scanner class>    - this parser''s scanner
  473.     prevToken <String + Symbol>    - the last token scanned
  474.     requestor <Controller + Object>    - the object invoking the parser, errors are reported to this object
  475.     failBlock <Block>        - this block is evaluated before the parse is aborted'!
  476.  
  477. AbstractParser comment:
  478. '=================================================
  479.     Copyright (c) 1992 by Justin O. Graver.
  480.     All rights reserved (with exceptions).
  481.     For complete information evaluate "Object tgenCopyright."
  482. =================================================
  483.  
  484. This class represents abstract parsing behavior.
  485.  
  486. Instance Variables:
  487.  
  488.     scanner <a scanner class>    - this parser''s scanner
  489.     prevToken <String + Symbol>    - the last token scanned
  490.     requestor <Controller + Object>    - the object invoking the parser, errors are reported to this object
  491.     failBlock <Block>        - this block is evaluated before the parse is aborted'!
  492.  
  493. !AbstractParser methodsFor: 'state accessing'!
  494. failBlock
  495.  
  496.     ^failBlock! !
  497.  
  498. !AbstractParser methodsFor: 'state accessing'!
  499. failBlock: argument 
  500.  
  501.     failBlock := argument! !
  502.  
  503. !AbstractParser methodsFor: 'state accessing'!
  504. prevToken
  505.  
  506.     ^prevToken! !
  507.  
  508. !AbstractParser methodsFor: 'state accessing'!
  509. prevToken: argument 
  510.  
  511.     prevToken := argument! !
  512.  
  513. !AbstractParser methodsFor: 'state accessing'!
  514. requestor
  515.  
  516.     ^requestor! !
  517.  
  518. !AbstractParser methodsFor: 'state accessing'!
  519. requestor: argument 
  520.  
  521.     requestor := argument! !
  522.  
  523. !AbstractParser methodsFor: 'state accessing'!
  524. scanner
  525.  
  526.     ^scanner! !
  527.  
  528. !AbstractParser methodsFor: 'state accessing'!
  529. scanner: argument 
  530.  
  531.     scanner := argument! !
  532.  
  533. !AbstractParser methodsFor: 'scanning'!
  534. endOfInput
  535.     "Some parsers may use the eof token while others may use the eof token type."
  536.  
  537.     self subclassResponsibility! !
  538.  
  539. !AbstractParser methodsFor: 'scanning'!
  540. endOfInputToken
  541.     "Answer the token used by my scanner to represent the end of the input."
  542.  
  543.     ^self scanner endOfInputToken! !
  544.  
  545. !AbstractParser methodsFor: 'scanning'!
  546. endOfInputTokenType
  547.     "Answer the token type used by my scanner to represent the end of the input."
  548.  
  549.     ^self scanner endOfInputTokenType! !
  550.  
  551. !AbstractParser methodsFor: 'scanning'!
  552. initScannerSource: aString 
  553.     "The scanner is responsible for scanning the first token (i.e. for priming the token 
  554.     buffers)."
  555.  
  556.     self scanner scanSource: aString! !
  557.  
  558. !AbstractParser methodsFor: 'scanning'!
  559. nextToken
  560.  
  561.     ^self scanner tokenType! !
  562.  
  563. !AbstractParser methodsFor: 'scanning'!
  564. nextTokenValue
  565.  
  566.     ^self scanner token! !
  567.  
  568. !AbstractParser methodsFor: 'scanning'!
  569. scanToken
  570.     "Subclasses may not always want the previous token value and may override this 
  571.     method for efficiency."
  572.  
  573.     self prevToken: self nextTokenValue.
  574.     self scanner scanToken! !
  575.  
  576. !AbstractParser methodsFor: 'private'!
  577. scannerClass
  578.     "Answer the preferred class of scanners for this kind of parser."
  579.  
  580.     self subclassResponsibility! !
  581.  
  582. !AbstractParser methodsFor: 'initialization'!
  583. init
  584.  
  585.     self scanner: self scannerClass new! !
  586.  
  587. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  588.  
  589. AbstractParser class
  590.     instanceVariableNames: ''!
  591.  
  592. !AbstractParser class methodsFor: 'instance creation'!
  593. new
  594.  
  595.     ^super new init! !
  596.  
  597. AbstractParser subclass: #RecursiveDescentParser
  598.     instanceVariableNames: 'here hereType hereMark prevMark class encoder parseNode lastTempMark correctionDelta '
  599.     classVariableNames: ''
  600.     poolDictionaries: ''
  601.     category: 'Compilers-Parsers'!
  602. RecursiveDescentParser comment:
  603. '=================================================
  604.     Copyright (c) 1992 by Justin O. Graver.
  605.     All rights reserved (with exceptions).
  606.     For complete information evaluate "Object tgenCopyright."
  607. =================================================
  608.  
  609. I am an abstract class that provides the framework for creating objects from textual representations using a recursive descent parse.
  610. This class is what used to be called ''NewCompiler'' in old TS implementations.  It has not been rewritten to reflect its new place in the compiler framework in order to maintain compatibility with the old TS subclasses.  When they are rewritten (when the Tektronix implementation is abandoned) this class should be also.
  611.  
  612. Instance Variables:
  613.     here            <Object> the current token
  614.     hereType        <Symbol> the "type" of the current token 
  615.     hereMark        <Integer> position in source stream (mark) where this token began
  616.     prevToken*    <Integer> size in chars of the previous token parsed
  617.     prevMark        <Integer> mark of previous token
  618.     class            <Class> provides a context for the text being parsed
  619.     encoder        <Encoder> which uses tables to decode tokens
  620.     parseNode    <ParseNode> intermediate result of current parse (for use by subclasses)
  621.     lastTempMark <Integer> mark of last temp;
  622.                         points to vert bar, or last char of pattern if no temps declared
  623.     correctionDelta    <Integer> offset of corrected code relative to source stream
  624.                         owing to interactive corrections so far.
  625.  
  626. * inherited from AbstractParser, but with new semantics.'!
  627.  
  628. RecursiveDescentParser comment:
  629. '=================================================
  630.     Copyright (c) 1992 by Justin O. Graver.
  631.     All rights reserved (with exceptions).
  632.     For complete information evaluate "Object tgenCopyright."
  633. =================================================
  634.  
  635. I am an abstract class that provides the framework for creating objects from textual representations using a recursive descent parse.
  636. This class is what used to be called ''NewCompiler'' in old TS implementations.  It has not been rewritten to reflect its new place in the compiler framework in order to maintain compatibility with the old TS subclasses.  When they are rewritten (when the Tektronix implementation is abandoned) this class should be also.
  637.  
  638. Instance Variables:
  639.     here            <Object> the current token
  640.     hereType        <Symbol> the "type" of the current token 
  641.     hereMark        <Integer> position in source stream (mark) where this token began
  642.     prevToken*    <Integer> size in chars of the previous token parsed
  643.     prevMark        <Integer> mark of previous token
  644.     class            <Class> provides a context for the text being parsed
  645.     encoder        <Encoder> which uses tables to decode tokens
  646.     parseNode    <ParseNode> intermediate result of current parse (for use by subclasses)
  647.     lastTempMark <Integer> mark of last temp;
  648.                         points to vert bar, or last char of pattern if no temps declared
  649.     correctionDelta    <Integer> offset of corrected code relative to source stream
  650.                         owing to interactive corrections so far.
  651.  
  652. * inherited from AbstractParser, but with new semantics.'!
  653.  
  654. !RecursiveDescentParser methodsFor: 'public access'!
  655. compile: textOrStream encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
  656.     "Answer with the result of the compilation. NOTE: information may be added 
  657.     to the argument anEncoder during the course of this compilation."
  658.  
  659.     | result |
  660.     self
  661.         init: textOrStream
  662.         notifying: aRequestor
  663.         failBlock: aBlock.
  664.     class isNil ifTrue: [class := Object].        "some methods rely on class being non-nil"
  665.     self initEncoder: anEncoder.
  666.     result := self parse.
  667.     encoder := failBlock := requestor := parseNode := nil.        "break cycles & mitigate refct overflow"
  668.     ^result! !
  669.  
  670. !RecursiveDescentParser methodsFor: 'public access'!
  671. compile: textOrStream in: aClass encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
  672.     "Answer the result of compiling the text in the context of aClass. NOTE: 
  673.     information 
  674.     may be added to the argument anEncoder during the course of this compilation."
  675.  
  676.     class := aClass.
  677.     ^self
  678.         compile: textOrStream
  679.         encodeIn: anEncoder
  680.         notifying: aRequestor
  681.         ifFail: aBlock! !
  682.  
  683. !RecursiveDescentParser methodsFor: 'public access'!
  684. compile: textOrStream in: aClass notifying: aRequestor ifFail: aBlock 
  685.     "Answer the result of compiling the text in the context of aClass."
  686.  
  687.     class := aClass.
  688.     ^self
  689.         compile: textOrStream
  690.         notifying: aRequestor
  691.         ifFail: aBlock! !
  692.  
  693. !RecursiveDescentParser methodsFor: 'public access'!
  694. compile: textOrStream notifying: aRequestor ifFail: aBlock 
  695.     "Answer with the result of the compilation."
  696.  
  697.     | result |
  698.     self
  699.         init: textOrStream
  700.         notifying: aRequestor
  701.         failBlock: aBlock.
  702.     class isNil ifTrue: [class := Object].        "some methods rely on class being non-nil"
  703.     self initEncoder.
  704.     result := self parse.
  705.     encoder := failBlock := requestor := parseNode := nil.        "break cycles & mitigate refct overflow"
  706.     ^result! !
  707.  
  708. !RecursiveDescentParser methodsFor: 'parsing'!
  709. parse
  710.     "This is the top level method that controls the (recursive descent) parse."
  711.  
  712.     self subclassResponsibility! !
  713.  
  714. !RecursiveDescentParser methodsFor: 'comparing'!
  715. match: type 
  716.     "Answer with true if next tokens type matches"
  717.  
  718.     hereType == type
  719.         ifTrue: 
  720.             [self advance.
  721.             ^true].
  722.     ^false! !
  723.  
  724. !RecursiveDescentParser methodsFor: 'comparing'!
  725. matchToken: thing 
  726.     "matches the token, not its type"
  727.  
  728.     here = thing
  729.         ifTrue: 
  730.             [self advance.
  731.             ^true].
  732.     ^false! !
  733.  
  734. !RecursiveDescentParser methodsFor: 'scanning'!
  735. advance
  736.  
  737.     | this |
  738.     prevMark := hereMark.        "Now means prev size"
  739.     prevToken := hereType == #number | (hereType == #string)
  740.                 ifTrue: [scanner mark - prevMark]
  741.                 ifFalse: [here size].
  742.     this := here.
  743.     here := scanner nextToken.
  744.     hereType := scanner nextTokenType.
  745.     hereMark := scanner mark.
  746.     scanner scanToken.
  747.     ^this! !
  748.  
  749. !RecursiveDescentParser methodsFor: 'scanning'!
  750. bareEndOfLastToken
  751.  
  752.     ^prevMark + prevToken - 1 + correctionDelta max: 0! !
  753.  
  754. !RecursiveDescentParser methodsFor: 'scanning'!
  755. endOfInput
  756.     "Use the eof token."
  757.  
  758.     ^self endOfInputToken! !
  759.  
  760. !RecursiveDescentParser methodsFor: 'scanning'!
  761. endOfLastToken
  762.  
  763.     hereType == #doIt ifTrue: [^prevMark + prevToken + 1 + correctionDelta].
  764.     scanner atEnd ifTrue: [^prevMark + prevToken + correctionDelta].
  765.     ^prevMark + prevToken - 1 + correctionDelta! !
  766.  
  767. !RecursiveDescentParser methodsFor: 'scanning'!
  768. reset
  769.     "Reinitialize the scanner and the parse."
  770.  
  771.     scanner reset.
  772.     prevMark := hereMark := scanner mark.
  773.     self advance! !
  774.  
  775. !RecursiveDescentParser methodsFor: 'scanning'!
  776. startOfNextToken
  777.     "return starting position in source of next token"
  778.  
  779.     hereType == #doIt ifTrue: [^scanner position + 1 + correctionDelta].
  780.     ^hereMark + correctionDelta! !
  781.  
  782. !RecursiveDescentParser methodsFor: 'error handling'!
  783. abort
  784.  
  785.     | exitBlock |
  786.     encoder == nil
  787.         ifFalse: 
  788.             [encoder release.
  789.             encoder := nil].        "break cycle"
  790.     exitBlock := failBlock.
  791.     failBlock := nil.
  792.     ^exitBlock value! !
  793.  
  794. !RecursiveDescentParser methodsFor: 'error handling'!
  795. editor
  796.  
  797.     ^requestor! !
  798.  
  799. !RecursiveDescentParser methodsFor: 'error handling'!
  800. expected: aString 
  801.     "Notify a problem at token 'here'"
  802.  
  803.     scanner atEnd ifTrue: [hereMark := hereMark + 1].
  804.     hereType == #doIt ifTrue: [hereMark := hereMark + 1].
  805.     ^self notify: aString , ' expected ->' at: hereMark + correctionDelta! !
  806.  
  807. !RecursiveDescentParser methodsFor: 'error handling'!
  808. notify: aString 
  809.     "Notify problem at token before 'here'"
  810.  
  811.     ^self notify: aString , ' ->' at: prevMark + correctionDelta! !
  812.  
  813. !RecursiveDescentParser methodsFor: 'error handling'!
  814. notify: aString at: position 
  815.     "If the editor is nil, pop up a SyntaxError, otherwise have the editor insert 
  816.     aString."
  817.  
  818.     | editor |
  819.     editor := self editor.
  820.     Cursor normal show.
  821.     editor == nil
  822.         ifTrue: [SyntaxError
  823.                 errorInClass: class
  824.                 withCode: (scanner contents
  825.                         copyReplaceFrom: position
  826.                         to: position - 1
  827.                         with: aString)
  828.                 errorString: aString]
  829.         ifFalse: [editor insertAndSelect: aString at: (position max: 1)].
  830.     self abort! !
  831.  
  832. !RecursiveDescentParser methodsFor: 'error handling'!
  833. offEnd: aString 
  834.     "notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!"
  835.  
  836.     ^self notify: aString at: scanner mark + correctionDelta! !
  837.  
  838. !RecursiveDescentParser methodsFor: 'private'!
  839. init: sourceString notifying: req failBlock: aBlock 
  840.  
  841.     requestor := req.
  842.     failBlock := aBlock.
  843.     correctionDelta := 0.
  844.     scanner := self preferredScannerClass new.
  845.     scanner scan: sourceString notifying: self.
  846.     prevMark := hereMark := scanner mark.
  847.     self advance! !
  848.  
  849. !RecursiveDescentParser methodsFor: 'private'!
  850. initEncoder
  851.  
  852.     self subclassResponsibility! !
  853.  
  854. !RecursiveDescentParser methodsFor: 'private'!
  855. initEncoder: anEncoder 
  856.  
  857.     encoder := anEncoder! !
  858.  
  859. !RecursiveDescentParser methodsFor: 'private'!
  860. preferredScannerClass
  861.  
  862.     ^self class preferredScannerClass! !
  863.  
  864. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  865.  
  866. RecursiveDescentParser class
  867.     instanceVariableNames: ''!
  868.  
  869. !RecursiveDescentParser class methodsFor: 'accessing'!
  870. preferredScannerClass
  871.     "Answer with a scanner class which is appropiate for scanning tokens used 
  872.     by this compiler class. Should be overwritten by subclasses."
  873.  
  874.     self subclassResponsibility! !
  875.  
  876. AbstractParser subclass: #TableDrivenParser
  877.     instanceVariableNames: 'parseTable transcript treeBuilder '
  878.     classVariableNames: ''
  879.     poolDictionaries: ''
  880.     category: 'Compilers-Parsers'!
  881. TableDrivenParser comment:
  882. '=================================================
  883.     Copyright (c) 1992 by Justin O. Graver.
  884.     All rights reserved (with exceptions).
  885.     For complete information evaluate "Object tgenCopyright."
  886. =================================================
  887.  
  888. I am an abstract class representing table (FSA) driven parsers.
  889.  
  890.  
  891. Instance Variables:
  892.     parseTable    <LL1ParserTable | LRParserState> - basic parsing mechanism.
  893.     transcript        <TranslatorGenerator | UndefinedObject> - status messages get sent here.
  894.     treeBuilder    <ParseTreeBuilder> - used in the construction of abstract syntax trees.'!
  895.  
  896. TableDrivenParser comment:
  897. '=================================================
  898.     Copyright (c) 1992 by Justin O. Graver.
  899.     All rights reserved (with exceptions).
  900.     For complete information evaluate "Object tgenCopyright."
  901. =================================================
  902.  
  903. I am an abstract class representing table (FSA) driven parsers.
  904.  
  905.  
  906. Instance Variables:
  907.     parseTable    <LL1ParserTable | LRParserState> - basic parsing mechanism.
  908.     transcript        <TranslatorGenerator | UndefinedObject> - status messages get sent here.
  909.     treeBuilder    <ParseTreeBuilder> - used in the construction of abstract syntax trees.'!
  910.  
  911. !TableDrivenParser methodsFor: 'scanning'!
  912. endOfInput
  913.     "Use the eof token type."
  914.  
  915.     ^self endOfInputTokenType! !
  916.  
  917. !TableDrivenParser methodsFor: 'scanning'!
  918. endOfInputTokenType
  919.     "Answer the token type used by my scanner to represent the end of the input."
  920.  
  921.     ^self scanner endOfInputTokenType! !
  922.  
  923. !TableDrivenParser methodsFor: 'state accessing'!
  924. parseTable
  925.  
  926.     ^parseTable! !
  927.  
  928. !TableDrivenParser methodsFor: 'state accessing'!
  929. parseTable: argument 
  930.  
  931.     parseTable := argument! !
  932.  
  933. !TableDrivenParser methodsFor: 'state accessing'!
  934. requestor
  935.  
  936.     ^requestor! !
  937.  
  938. !TableDrivenParser methodsFor: 'state accessing'!
  939. requestor: argument 
  940.  
  941.     requestor := argument! !
  942.  
  943. !TableDrivenParser methodsFor: 'state accessing'!
  944. transcript
  945.  
  946.     ^transcript! !
  947.  
  948. !TableDrivenParser methodsFor: 'state accessing'!
  949. transcript: argument 
  950.  
  951.     transcript := argument! !
  952.  
  953. !TableDrivenParser methodsFor: 'state accessing'!
  954. treeBuilder
  955.  
  956.     ^treeBuilder! !
  957.  
  958. !TableDrivenParser methodsFor: 'state accessing'!
  959. treeBuilder: argument 
  960.  
  961.     treeBuilder := argument! !
  962.  
  963. !TableDrivenParser methodsFor: 'testing'!
  964. performsLeftmostDerivation
  965.     "This is the default, let subclasses override."
  966.  
  967.     ^false! !
  968.  
  969. !TableDrivenParser methodsFor: 'testing'!
  970. performsRightmostDerivation
  971.     "This is the default, let subclasses override."
  972.  
  973.     ^false! !
  974.  
  975. !TableDrivenParser methodsFor: 'public access'!
  976. parse: aString ifFail: aBlock 
  977.  
  978.     self failBlock: aBlock.
  979.     self exceptionHandlers
  980.         handleDo: 
  981.             [self initScannerSource: aString.
  982.             ^self parse]! !
  983.  
  984. !TableDrivenParser methodsFor: 'public access'!
  985. parseAndTrace: aString ifFail: aBlock 
  986.  
  987.     self failBlock: aBlock.
  988.     "Make sure we don't accidently write to someone else's window."
  989.     self transcript: nil.
  990.     self exceptionHandlers
  991.         handleDo: 
  992.             [self initScannerSource: aString.
  993.             ^self traceParse]! !
  994.  
  995. !TableDrivenParser methodsFor: 'public access'!
  996. parseAndTrace: aString on: aTranscript ifFail: aBlock 
  997.  
  998.     self failBlock: aBlock.
  999.     self transcript: aTranscript.
  1000.     self exceptionHandlers
  1001.         handleDo: 
  1002.             [self initScannerSource: aString.
  1003.             ^self traceParse]! !
  1004.  
  1005. !TableDrivenParser methodsFor: 'public access'!
  1006. parseForAST: aString ifFail: aBlock 
  1007.  
  1008.     self failBlock: aBlock.
  1009.     self exceptionHandlers
  1010.         handleDo: 
  1011.             [self initScannerSource: aString.
  1012.             ^self parseForAST]! !
  1013.  
  1014. !TableDrivenParser methodsFor: 'public access'!
  1015. parseForDerivationTree: aString ifFail: aBlock 
  1016.  
  1017.     self failBlock: aBlock.
  1018.     self exceptionHandlers
  1019.         handleDo: 
  1020.             [self initScannerSource: aString.
  1021.             ^self parseForDerivationTree]! !
  1022.  
  1023. !TableDrivenParser methodsFor: 'public access'!
  1024. parseForShamAST: aString ifFail: aBlock 
  1025.  
  1026.     self failBlock: aBlock.
  1027.     self exceptionHandlers
  1028.         handleDo: 
  1029.             [self initScannerSource: aString.
  1030.             ^self parseForShamAST]! !
  1031.  
  1032. !TableDrivenParser methodsFor: 'parsing'!
  1033. parse
  1034.  
  1035.     self subclassResponsibility! !
  1036.  
  1037. !TableDrivenParser methodsFor: 'parsing'!
  1038. parseForAST
  1039.  
  1040.     | builder |
  1041.     builder := self treeBuilder reset.
  1042.     ^self parseWithTreeBuilder: builder! !
  1043.  
  1044. !TableDrivenParser methodsFor: 'parsing'!
  1045. parseForDerivationTree
  1046.  
  1047.     ^self parseWithTreeBuilder: self derivationTreeBuilderClass new! !
  1048.  
  1049. !TableDrivenParser methodsFor: 'parsing'!
  1050. parseForShamAST
  1051.  
  1052.     | builder |
  1053.     builder := self treeBuilder reset.
  1054.     builder setShamMode.
  1055.     ^self parseWithTreeBuilder: builder! !
  1056.  
  1057. !TableDrivenParser methodsFor: 'parsing'!
  1058. traceParse
  1059.  
  1060.     self subclassResponsibility! !
  1061.  
  1062. !TableDrivenParser methodsFor: 'private'!
  1063. derivationTreeBuilderClass
  1064.  
  1065.     ^DerivationTreeBuilder! !
  1066.  
  1067. !TableDrivenParser methodsFor: 'private'!
  1068. myParseTable
  1069.  
  1070.     ^self class parseTable! !
  1071.  
  1072. !TableDrivenParser methodsFor: 'private'!
  1073. scannerClass
  1074.     "Translator generator tools may initially create an 'abstract' parser and 'plug-in' 
  1075.     a scanner. This allows instances of these abstract parsers to be used in this 
  1076.     fashion. Ultimately, the tools will create concrete scanner and parser classes 
  1077.     with the proper links established."
  1078.  
  1079.     ^Object! !
  1080.  
  1081. !TableDrivenParser methodsFor: 'private'!
  1082. treeBuilderClass
  1083.     "Different tree builders can either be plugged in or subclasses can override this 
  1084.     method."
  1085.  
  1086.     ^AbstractSyntaxTreeBuilder! !
  1087.  
  1088. !TableDrivenParser methodsFor: 'tracing'!
  1089. cr
  1090.  
  1091.     self show: '
  1092. '! !
  1093.  
  1094. !TableDrivenParser methodsFor: 'tracing'!
  1095. defaultTranscript
  1096.  
  1097.     ^Transcript! !
  1098.  
  1099. !TableDrivenParser methodsFor: 'tracing'!
  1100. show: aString 
  1101.  
  1102.     (self transcript isNil
  1103.         ifTrue: [self defaultTranscript]
  1104.         ifFalse: [self transcript])
  1105.         show: aString! !
  1106.  
  1107. !TableDrivenParser methodsFor: 'tracing'!
  1108. showCR: aString 
  1109.  
  1110.     self show: aString , '
  1111. '! !
  1112.  
  1113. !TableDrivenParser methodsFor: 'exception handling'!
  1114. abort
  1115.  
  1116.     | block |
  1117.     block := self failBlock.
  1118.     self failBlock: nil.
  1119.     ^block value! !
  1120.  
  1121. !TableDrivenParser methodsFor: 'exception handling'!
  1122. exceptionHandlers
  1123.     "Answer a HandlerCollection that will catch and handle scanner and parser errors."
  1124.  
  1125.     | handlers |
  1126.     handlers := HandlerCollection new.
  1127.     handlers on: self scannerErrorSignal
  1128.         handle: 
  1129.             [:ex | 
  1130.             self requestor notNil
  1131.                 ifTrue: [self requestor insertAndSelect: 'SCANNER ERROR: ' , ex errorString , ' ->' at: self scanner errorPosition].
  1132.             self abort].
  1133.     handlers on: self parserErrorSignal
  1134.         handle: 
  1135.             [:ex | 
  1136.             self requestor notNil
  1137.                 ifTrue: [self requestor insertAndSelect: '<- PARSER ERROR: ' , ex errorString at: self scanner errorPosition].
  1138.             self abort].
  1139.     ^handlers! !
  1140.  
  1141. !TableDrivenParser methodsFor: 'exception handling'!
  1142. parserErrorSignal
  1143.  
  1144.     self subclassResponsibility! !
  1145.  
  1146. !TableDrivenParser methodsFor: 'exception handling'!
  1147. scannerErrorSignal
  1148.  
  1149.     ^FSAState noTransitionSignal! !
  1150.  
  1151. !TableDrivenParser methodsFor: 'converting'!
  1152. spaceOptimize
  1153.  
  1154.     self parseTable spaceOptimize! !
  1155.  
  1156. !TableDrivenParser methodsFor: 'initialization'!
  1157. init
  1158.  
  1159.     super init.
  1160.     self parseTable: self myParseTable.
  1161.     self treeBuilder: self treeBuilderClass new! !
  1162.  
  1163. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1164. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  1165.  
  1166.     ^self subclassResponsibility! !
  1167.  
  1168. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1169. createParserClassNamed: name category: category spec: grammarSpec 
  1170.  
  1171.     | parserClass |
  1172.     parserClass := self defaultParserClass
  1173.                 subclass: name asSymbol
  1174.                 instanceVariableNames: ''
  1175.                 classVariableNames: ''
  1176.                 poolDictionaries: ''
  1177.                 category: category.
  1178.     parserClass comment: self generatedParserClassComment.
  1179.     parserClass class compile: (self classInitializationMethodTextForClassNamed: name spec: grammarSpec)
  1180.         classified: 'class initialization'.
  1181.     parserClass initialize.
  1182.     ^parserClass! !
  1183.  
  1184. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1185. generatedParserClassComment
  1186.  
  1187.     ^'This parser class was automatically generated by ', TranslatorGenerator versionName , '.'! !
  1188.  
  1189. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1190. createScannerClassNamed: name category: category spec: tokenSpec 
  1191.  
  1192.     ^self scanner
  1193.         createScannerClassNamed: name
  1194.         category: category
  1195.         spec: tokenSpec! !
  1196.  
  1197. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1198. createScannerParserClassesNamed: namePrefix category: category tokenSpec: tokenSpec grammarSpec: grammarSpec 
  1199.     | parserClass |
  1200.     self
  1201.         createScannerClassNamed: namePrefix , 'Scanner'
  1202.         category: category
  1203.         spec: tokenSpec.
  1204.     parserClass := self
  1205.                 createParserClassNamed: namePrefix , 'Parser'
  1206.                 category: category
  1207.                 spec: grammarSpec.
  1208.     parserClass compile: 'scannerClass
  1209.     ^' , namePrefix , 'Scanner' classified: 'private'.
  1210.     parserClass compile: 'treeBuilderClass
  1211.     ^' , self treeBuilder class printString classified: 'private'! !
  1212.  
  1213. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  1214. defaultParserClass
  1215.  
  1216.     ^self class! !
  1217.  
  1218. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1219.  
  1220. TableDrivenParser class
  1221.     instanceVariableNames: 'parseTable '!
  1222.  
  1223. !TableDrivenParser class methodsFor: 'class initialization'!
  1224. initialize
  1225.     "Concrete subclasses must somehow provide a parse table. Subclasses created 
  1226.     by automatic means may simply 'plug-in' a dynamically computed parse table. 
  1227.     However, if a class that can be filed-out is desired then it is worthwhile to 
  1228.     override this initialization method with one that can build the appropriate parse 
  1229.     table directly."
  1230.     "TableDrivenParser initialize"
  1231.  
  1232.     self parseTable: nil! !
  1233.  
  1234. !TableDrivenParser class methodsFor: 'state accessing'!
  1235. parseTable
  1236.  
  1237.     ^parseTable! !
  1238.  
  1239. !TableDrivenParser class methodsFor: 'state accessing'!
  1240. parseTable: argument 
  1241.  
  1242.     parseTable := argument! !
  1243.  
  1244. !TableDrivenParser class methodsFor: 'instance creation'!
  1245. new
  1246.  
  1247.     ^super new init! !
  1248.  
  1249. TableDrivenParser subclass: #LL1Parser
  1250.     instanceVariableNames: 'startSymbol '
  1251.     classVariableNames: ''
  1252.     poolDictionaries: ''
  1253.     category: 'Compilers-Parsers'!
  1254. LL1Parser comment:
  1255. '=================================================
  1256.     Copyright (c) 1992 by Justin O. Graver.
  1257.     All rights reserved (with exceptions).
  1258.     For complete information evaluate "Object tgenCopyright."
  1259. =================================================
  1260.  
  1261. I am an LL(1) parser.
  1262.  
  1263. Instance Variables:
  1264.     parseTable*    <LL1ParserTable> - basic parsing mechanism.
  1265.     startSymbol  <Symbol> - my grammars start symbol.
  1266.  
  1267. * inherited from AbstractParser'!
  1268.  
  1269. LL1Parser comment:
  1270. '=================================================
  1271.     Copyright (c) 1992 by Justin O. Graver.
  1272.     All rights reserved (with exceptions).
  1273.     For complete information evaluate "Object tgenCopyright."
  1274. =================================================
  1275.  
  1276. I am an LL(1) parser.
  1277.  
  1278. Instance Variables:
  1279.     parseTable*    <LL1ParserTable> - basic parsing mechanism.
  1280.     startSymbol  <Symbol> - my grammars start symbol.
  1281.  
  1282. * inherited from AbstractParser'!
  1283.  
  1284. !LL1Parser methodsFor: 'state accessing'!
  1285. startSymbol
  1286.  
  1287.     ^startSymbol! !
  1288.  
  1289. !LL1Parser methodsFor: 'state accessing'!
  1290. startSymbol: argument 
  1291.  
  1292.     startSymbol := argument! !
  1293.  
  1294. !LL1Parser methodsFor: 'private'!
  1295. epsilon
  1296.     "Answer an object used to represent the empty string (epsilon)."
  1297.  
  1298.     ^'<epsilon>'! !
  1299.  
  1300. !LL1Parser methodsFor: 'private'!
  1301. myStartSymbol
  1302.  
  1303.     ^self class startSymbol! !
  1304.  
  1305. !LL1Parser methodsFor: 'private'!
  1306. parserErrorSignal
  1307.  
  1308.     ^LLParserTable noTransitionSignal! !
  1309.  
  1310. !LL1Parser methodsFor: 'exception handling'!
  1311. raiseExceptionExpectedToken: aString 
  1312.  
  1313.     self raiseNoTransitionExceptionErrorString: 'expecting ' , aString! !
  1314.  
  1315. !LL1Parser methodsFor: 'exception handling'!
  1316. raiseExceptionUnparsedTokens
  1317.  
  1318.     self raiseNoTransitionExceptionErrorString: 'unparsed tokens remaining in input'! !
  1319.  
  1320. !LL1Parser methodsFor: 'exception handling'!
  1321. raiseNoTransitionExceptionErrorString: aString 
  1322.  
  1323.     self parserErrorSignal raiseErrorString: aString! !
  1324.  
  1325. !LL1Parser methodsFor: 'parsing'!
  1326. parse
  1327.  
  1328.     | stack prod |
  1329.     stack := Stack new.
  1330.     stack push: self startSymbol.
  1331.     [stack isEmpty]
  1332.         whileFalse: [stack top isTerminal
  1333.                 ifTrue: [stack top = self nextToken
  1334.                         ifTrue: 
  1335.                             [stack pop.
  1336.                             self scanToken]
  1337.                         ifFalse: [self raiseExceptionExpectedToken: stack top symbol]]
  1338.                 ifFalse: 
  1339.                     [prod := self productionAtNonterminal: stack pop andTerminal: self nextToken.
  1340.                     prod rightHandSide reverseDo: [:sym | stack push: sym]]].
  1341.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! !
  1342.  
  1343. !LL1Parser methodsFor: 'parsing'!
  1344. parseForDerivationTreeAlternative
  1345.     "Derivation trees can be build efficiently during a top-down parse. 
  1346.     This method implements this option (see parseForDerivationTree)."
  1347.  
  1348.     | stack prod root parent node |
  1349.     stack := Stack new.
  1350.     root := DerivationTreeNode symbol: self startSymbol.
  1351.     stack push: root.
  1352.     [stack isEmpty]
  1353.         whileFalse: [stack top isTerminal
  1354.                 ifTrue: [stack top symbol = self nextToken
  1355.                         ifTrue: 
  1356.                             [stack pop.
  1357.                             self scanToken]
  1358.                         ifFalse: [self raiseExceptionExpectedToken: stack top symbol]]
  1359.                 ifFalse: 
  1360.                     [prod := self productionAtNonterminal: stack top symbol andTerminal: self nextToken.
  1361.                     parent := stack pop.
  1362.                     prod rightHandSide isEmpty
  1363.                         ifTrue: 
  1364.                             [node := DerivationTreeNode symbol: self epsilon.
  1365.                             parent addChild: node]
  1366.                         ifFalse: [prod rightHandSide
  1367.                                 reverseDo: 
  1368.                                     [:sym | 
  1369.                                     node := DerivationTreeNode symbol: sym.
  1370.                                     parent addFirstChild: node.
  1371.                                     stack push: node]]]].
  1372.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens].
  1373.     ^root! !
  1374.  
  1375. !LL1Parser methodsFor: 'parsing'!
  1376. parseWithTreeBuilder: parseTreeBuilder 
  1377.     "Rather than building the tree top-down during the parse, it's easier to save 
  1378.     the productions on a stack and build the tree bottom-up after parsing."
  1379.  
  1380.     | stack productionStack |
  1381.     productionStack := Stack new.
  1382.     stack := Stack new.
  1383.     stack push: self startSymbol.
  1384.     [stack isEmpty]
  1385.         whileFalse: [stack top isTerminal
  1386.                 ifTrue: 
  1387.                     ["cancel matching tokens"
  1388.                     stack top = self nextToken
  1389.                         ifTrue: 
  1390.                             [stack pop.
  1391.                             self scanToken]
  1392.                         ifFalse: [self raiseExceptionExpectedToken: stack top]]
  1393.                 ifFalse: 
  1394.                     ["expand nonterminal"
  1395.                     productionStack push: (self productionAtNonterminal: stack pop andTerminal: self nextToken)
  1396.                             @ self nextTokenValue.
  1397.                     productionStack top x rightHandSide reverseDo: [:sym | stack push: sym]]].
  1398.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens].
  1399.     productionStack do: 
  1400.         [:prod | 
  1401.         self prevToken: prod y.
  1402.         parseTreeBuilder processProduction: prod x forParser: self].
  1403.     ^parseTreeBuilder result! !
  1404.  
  1405. !LL1Parser methodsFor: 'parsing'!
  1406. productionAtNonterminal: nont andTerminal: term
  1407.     ^self parseTable productionAtNonterminal: nont andTerminal: term! !
  1408.  
  1409. !LL1Parser methodsFor: 'parsing'!
  1410. traceParse
  1411.  
  1412.     | stack prod |
  1413.     self
  1414.          cr;
  1415.          cr;
  1416.          showCR: 'LL Parser trace of:  ' , self scanner contents;
  1417.          cr.
  1418.     stack := OrderedCollection new.
  1419.     stack addFirst: self startSymbol.
  1420.     [stack isEmpty]
  1421.         whileFalse: [stack first isTerminal
  1422.                 ifTrue: [stack first = self nextToken
  1423.                         ifTrue: 
  1424.                             [self showCR: 'cancel ''' , stack first asString, ''' from input'.
  1425.                             stack removeFirst.
  1426.                             self scanToken]
  1427.                         ifFalse: [self error: 'raise exception:  top of stack = ''' , stack first asString , ''' next token = ''' , self nextToken asString, '''']]
  1428.                 ifFalse: 
  1429.                     [prod := self productionAtNonterminal: stack first andTerminal: self nextToken.
  1430.                     self showCR: 'apply production ' , prod printString.
  1431.                     stack removeFirst.
  1432.                     prod rightHandSide reverseDo: [:sym | stack addFirst: sym]]].
  1433.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! !
  1434.  
  1435. !LL1Parser methodsFor: 'testing'!
  1436. performsLeftmostDerivation
  1437.  
  1438.     ^true! !
  1439.  
  1440. !LL1Parser methodsFor: 'initialization'!
  1441. init
  1442.  
  1443.     super init.
  1444.     self startSymbol: self myStartSymbol! !
  1445.  
  1446. !LL1Parser methodsFor: 'scanner/parser generation'!
  1447. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  1448.  
  1449.     | ws |
  1450.     ws := WriteStream on: (String new: 256).
  1451.     ws nextPutAll: 'initialize "' , name , ' initialize  " '.
  1452.     ws cr.
  1453.     ws nextPutAll: ' "  ' , grammarSpec , ' " '.
  1454.     ws nextPut: $".
  1455.     grammarSpec do: 
  1456.         [:ch | 
  1457.         "double embedded double-quote characters"
  1458.         ws nextPut: ch.
  1459.         ch = $" ifTrue: [ws nextPut: $"]].
  1460.     ws nextPut: $".
  1461.     ws nextPutAll: ' |  llParserTable table gp | '.
  1462.     ws nextPutAll: self parseTable buildParseTable.
  1463.     ws nextPutAll: ' self parseTable:  llParserTable  . '.
  1464.     ws nextPutAll: ' self startSymbol:   '.
  1465.     self startSymbol printOn: ws.
  1466.     ^ws contents! !
  1467.  
  1468. !LL1Parser methodsFor: 'converting'!
  1469. fastParser
  1470.  
  1471.     ^OptimizedLL1Parser buildFrom: self! !
  1472.  
  1473. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1474.  
  1475. LL1Parser class
  1476.     instanceVariableNames: 'startSymbol '!
  1477.  
  1478. !LL1Parser class methodsFor: 'instance creation'!
  1479. parseTable: table startSymbol: sym 
  1480.  
  1481.     | newParser |
  1482.     newParser := self new.
  1483.     newParser parseTable: table.
  1484.     newParser startSymbol: sym.
  1485.     ^newParser! !
  1486.  
  1487. !LL1Parser class methodsFor: 'state accessing'!
  1488. startSymbol
  1489.  
  1490.     ^startSymbol! !
  1491.  
  1492. !LL1Parser class methodsFor: 'state accessing'!
  1493. startSymbol: argument 
  1494.  
  1495.     startSymbol := argument! !
  1496.  
  1497. LL1Parser subclass: #OptimizedLL1Parser
  1498.     instanceVariableNames: 'nonterminals terminals '
  1499.     classVariableNames: 'NoTransitionSignal '
  1500.     poolDictionaries: ''
  1501.     category: 'Compilers-Parsers'!
  1502. OptimizedLL1Parser comment:
  1503. '=================================================
  1504.     Copyright (c) 1992 by Justin O. Graver.
  1505.     All rights reserved (with exceptions).
  1506.     For complete information evaluate "Object tgenCopyright."
  1507. =================================================
  1508.  
  1509. I am an LL(1) parser represented efficiently in Array table format.
  1510.  
  1511. Instance variables:
  1512.     tokenTypeTable <Array of: String>    - the integer mapping for terminals and nonterminals'!
  1513.  
  1514. OptimizedLL1Parser comment:
  1515. '=================================================
  1516.     Copyright (c) 1992 by Justin O. Graver.
  1517.     All rights reserved (with exceptions).
  1518.     For complete information evaluate "Object tgenCopyright."
  1519. =================================================
  1520.  
  1521. I am an LL(1) parser represented efficiently in Array table format.
  1522.  
  1523. Instance variables:
  1524.     tokenTypeTable <Array of: String>    - the integer mapping for terminals and nonterminals'!
  1525.  
  1526. !OptimizedLL1Parser methodsFor: 'exception handling'!
  1527. endOfInputErrorString
  1528.  
  1529.     ^'end of input encountered'! !
  1530.  
  1531. !OptimizedLL1Parser methodsFor: 'exception handling'!
  1532. parserErrorSignal
  1533.  
  1534.     ^self class noTransitionSignal! !
  1535.  
  1536. !OptimizedLL1Parser methodsFor: 'exception handling'!
  1537. raiseNoTransitionExceptionErrorString: aString 
  1538.  
  1539.     self parserErrorSignal raiseErrorString: aString! !
  1540.  
  1541. !OptimizedLL1Parser methodsFor: 'exception handling'!
  1542. scannerErrorSignal
  1543.  
  1544.     ^OptimizedScanner noTransitionSignal! !
  1545.  
  1546. !OptimizedLL1Parser methodsFor: 'exception handling'!
  1547. standardErrorString
  1548.  
  1549.     ^'unexpected token encountered:  '! !
  1550.  
  1551. !OptimizedLL1Parser methodsFor: 'private'!
  1552. parseError
  1553.  
  1554.     self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken
  1555.             ifTrue: [self endOfInputErrorString]
  1556.             ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! !
  1557.  
  1558. !OptimizedLL1Parser methodsFor: 'accessing'!
  1559. myNonterminals
  1560.  
  1561.     ^self class nonterminals! !
  1562.  
  1563. !OptimizedLL1Parser methodsFor: 'accessing'!
  1564. myTerminals
  1565.  
  1566.     ^self class terminals! !
  1567.  
  1568. !OptimizedLL1Parser methodsFor: 'accessing'!
  1569. myTokenTypeTable
  1570.  
  1571.     ^self class tokenTypeTable! !
  1572.  
  1573. !OptimizedLL1Parser methodsFor: 'initialization'!
  1574. init
  1575.  
  1576.     super init.
  1577.     self nonterminals: self myNonterminals.
  1578.     self terminals: self myTerminals! !
  1579.  
  1580. !OptimizedLL1Parser methodsFor: 'parsing'!
  1581. productionAtNonterminal: nont andTerminal: term 
  1582.     | nontIndex termIndex prod |
  1583.     nontIndex := self nonterminals indexOf: nont.
  1584.     termIndex := self terminals indexOf: term.
  1585.     ^(prod := (self parseTable at: nontIndex)
  1586.                 at: termIndex) isNil
  1587.         ifTrue: [self raiseNoTransitionExceptionErrorString: (term = self endOfInputToken
  1588.                     ifTrue: [self endOfInputErrorString]
  1589.                     ifFalse: [self standardErrorString , '''' , term printString , ''''])]
  1590.         ifFalse: [prod]! !
  1591.  
  1592. !OptimizedLL1Parser methodsFor: 'reconstructing'!
  1593. mapProductionToInteger
  1594.     "Answer an Array of all grammar symbols - nonterminals, terminals, 
  1595.     and translation symbols."
  1596.  
  1597.     | transSyms |
  1598.     transSyms := Set new.
  1599.     parseTable do: [:row | row do: [:ea | ea isGrammarProduction ifTrue: [ea hasTranslation ifTrue: [transSyms add: ea translationSymbol]]]].
  1600.     ^self nonterminals , self terminals , transSyms asOrderedCollection asArray! !
  1601.  
  1602. !OptimizedLL1Parser methodsFor: 'reconstructing'!
  1603. reconstructOn: aStream 
  1604.  
  1605.     | prodTable n |
  1606.     prodTable := self mapProductionToInteger.
  1607.     aStream nextPutAll: 'prodTable := '.
  1608.     prodTable reconstructOn: aStream.
  1609.     aStream
  1610.         period;
  1611.         crtab;
  1612.         nextPutAll: 'self nonterminals:  (prodTable copyFrom: 1 to:  ';
  1613.         nextPutAll: (n := self nonterminals size) printString;
  1614.         nextPutAll: ').';
  1615.         crtab;
  1616.         nextPutAll: 'self terminals:  (prodTable copyFrom: ';
  1617.         nextPutAll: (n + 1) printString;
  1618.         nextPutAll: ' to: ';
  1619.         nextPutAll: (self terminals size + n) printString;
  1620.         nextPutAll: ').';
  1621.         crtab;
  1622.         nextPutAll: 'table := '.
  1623.     self parseTable reconstructOn: aStream using: prodTable.
  1624.     aStream
  1625.         period;
  1626.         crtab;
  1627.         nextPutAll: 'self constructParseTable: table  with: prodTable.';
  1628.         crtab;
  1629.         nextPutAll: 'self startSymbol: '.
  1630.     self startSymbol printOn: aStream! !
  1631.  
  1632. !OptimizedLL1Parser methodsFor: 'scanner/parser generation'!
  1633. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  1634.     | ws |
  1635.     ws := WriteStream on: (String new: 2048).
  1636.     ws
  1637.         nextPutAll: 'initialize';
  1638.         crtab;
  1639.         nextPut: $";
  1640.         nextPutAll: name;
  1641.         nextPutAll: ' initialize"';
  1642.         crtab;
  1643.         nextPut: $".
  1644.     grammarSpec do: 
  1645.         [:ch | 
  1646.         "double embedded double-quote characters"
  1647.         ws nextPut: ch.
  1648.         ch = $" ifTrue: [ws nextPut: $"]].
  1649.     ws
  1650.         nextPut: $";
  1651.         cr;
  1652.         crtab;
  1653.         nextPutAll: '| table prodTable |';
  1654.         crtab.
  1655.     self reconstructOn: ws.
  1656.     ^ws contents! !
  1657.  
  1658. !OptimizedLL1Parser methodsFor: 'converting'!
  1659. changeToObjectTable: llParseTable 
  1660.  
  1661.     | terms objectTable |
  1662.     self nonterminals: llParseTable keys asOrderedCollection asArray.
  1663.     terms := Set new.
  1664.     llParseTable do: [:row | row
  1665.             associationsDo: 
  1666.                 [:assoc | 
  1667.                 terms add: assoc key.
  1668.                 assoc value rightHandSide do: [:sym | sym isTerminal ifTrue: [terms add: sym]]]].
  1669.     self terminals: terms asOrderedCollection asArray.
  1670.     objectTable := Array new: self nonterminals size.
  1671.     ^self convert: llParseTable to: objectTable! !
  1672.  
  1673. !OptimizedLL1Parser methodsFor: 'converting'!
  1674. convert: llParseTable to: objectTable 
  1675.     | nonterms terms row |
  1676.     nonterms := self nonterminals.
  1677.     terms := self terminals.
  1678.     llParseTable
  1679.         associationsDo: 
  1680.             [:assoc1 | 
  1681.             row := Array new: terms size.
  1682.             objectTable at: (nonterms indexOf: assoc1 key)
  1683.                 put: row.
  1684.             assoc1 value associationsDo: [:assoc2 | row at: (terms indexOf: assoc2 key)
  1685.                     put: assoc2 value]].
  1686.     ^objectTable! !
  1687.  
  1688. !OptimizedLL1Parser methodsFor: 'converting'!
  1689. convertToTable: ll1Parser 
  1690.  
  1691.     self scanner: ll1Parser scanner fastScanner.
  1692.     self parseTable: (self changeToObjectTable: ll1Parser parseTable).
  1693.     self treeBuilder:  ll1Parser treeBuilder.
  1694.     self startSymbol: ll1Parser startSymbol! !
  1695.  
  1696. !OptimizedLL1Parser methodsFor: 'state accessing'!
  1697. nonterminals
  1698.     ^nonterminals! !
  1699.  
  1700. !OptimizedLL1Parser methodsFor: 'state accessing'!
  1701. nonterminals: arg
  1702.     nonterminals := arg! !
  1703.  
  1704. !OptimizedLL1Parser methodsFor: 'state accessing'!
  1705. terminals
  1706.     ^terminals! !
  1707.  
  1708. !OptimizedLL1Parser methodsFor: 'state accessing'!
  1709. terminals: arg
  1710.     terminals := arg! !
  1711.  
  1712. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1713.  
  1714. OptimizedLL1Parser class
  1715.     instanceVariableNames: 'nonterminals terminals '!
  1716.  
  1717. !OptimizedLL1Parser class methodsFor: 'class initialization'!
  1718. initialize
  1719.     "OptimizedLL1Parser initialize"
  1720.  
  1721.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  1722.  
  1723. !OptimizedLL1Parser class methodsFor: 'instance creation'!
  1724. buildFrom: ll1Parser
  1725.  
  1726.     ^self new convertToTable: ll1Parser! !
  1727.  
  1728. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1729. nonterminals 
  1730.     ^nonterminals! !
  1731.  
  1732. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1733. nonterminals: arg
  1734.     nonterminals := arg! !
  1735.  
  1736. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1737. noTransitionSignal
  1738.  
  1739.     ^NoTransitionSignal! !
  1740.  
  1741. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1742. noTransitionSignal: arg
  1743.  
  1744.     NoTransitionSignal := arg! !
  1745.  
  1746. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1747. terminals
  1748.     ^terminals! !
  1749.  
  1750. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  1751. terminals: arg
  1752.     terminals := arg! !
  1753.  
  1754. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  1755. constructGrammarProduction: arg with: prodTable 
  1756.  
  1757.     | rhs |
  1758.     (arg at: 2) isEmpty
  1759.         ifTrue: [rhs := OrderedCollection new]
  1760.         ifFalse: 
  1761.             [rhs := OrderedCollection new.
  1762.             (arg at: 2)
  1763.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  1764.     ^GrammarProduction
  1765.         leftHandSide: (prodTable at: (arg at: 1))
  1766.         rightHandSide: rhs! !
  1767.  
  1768. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  1769. constructParseTable: table with: prodTable 
  1770.  
  1771.     | ea row |
  1772.     parseTable := Array new: table size.
  1773.     1 to: table size do: 
  1774.         [:index | 
  1775.         row := Array new: (table at: index) size.
  1776.         parseTable at: index put: row.
  1777.         1 to: (table at: index) size do: 
  1778.             [:i | 
  1779.             ea := (table at: index)
  1780.                         at: i.
  1781.             ea isNil ifFalse: [ea isInteger
  1782.                     ifTrue: [row at: i put: ea]
  1783.                     ifFalse: [ea size == 2
  1784.                             ifTrue: [row at: i put: (self constructGrammarProduction: ea with: prodTable)]
  1785.                             ifFalse: [row at: i put: (self constructTransductionGrammarProduction: ea with: prodTable)]]]]]! !
  1786.  
  1787. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  1788. constructTransductionGrammarProduction: arg with: prodTable 
  1789.  
  1790.     | rhs |
  1791.     (arg at: 2) isEmpty
  1792.         ifTrue: [rhs := OrderedCollection new]
  1793.         ifFalse: 
  1794.             [rhs := OrderedCollection new.
  1795.             (arg at: 2)
  1796.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  1797.     ^TransductionGrammarProduction
  1798.         leftHandSide: (prodTable at: (arg at: 1))
  1799.         rightHandSide: rhs
  1800.         translationSymbol: (prodTable at: (arg at: 3))! !
  1801.  
  1802. TableDrivenParser subclass: #LR1Parser
  1803.     instanceVariableNames: 'finalState '
  1804.     classVariableNames: ''
  1805.     poolDictionaries: ''
  1806.     category: 'Compilers-Parsers'!
  1807. LR1Parser comment:
  1808. '=================================================
  1809.     Copyright (c) 1992 by Justin O. Graver.
  1810.     All rights reserved (with exceptions).
  1811.     For complete information evaluate "Object tgenCopyright."
  1812. =================================================
  1813.  
  1814. I am an LR parser.
  1815.  
  1816. Instance Variables:
  1817.     parseTable*    <LRParserState> - basic parsing mechanism, a CFSM.
  1818.     finalState        <LRParserState> - final state of my CFSM.
  1819.  
  1820. * inherited from AbstractParser'!
  1821.  
  1822. LR1Parser comment:
  1823. '=================================================
  1824.     Copyright (c) 1992 by Justin O. Graver.
  1825.     All rights reserved (with exceptions).
  1826.     For complete information evaluate "Object tgenCopyright."
  1827. =================================================
  1828.  
  1829. I am an LR parser.
  1830.  
  1831. Instance Variables:
  1832.     parseTable*    <LRParserState> - basic parsing mechanism, a CFSM.
  1833.     finalState        <LRParserState> - final state of my CFSM.
  1834.  
  1835. * inherited from AbstractParser'!
  1836.  
  1837. !LR1Parser methodsFor: 'state accessing'!
  1838. finalState
  1839.  
  1840.     ^finalState! !
  1841.  
  1842. !LR1Parser methodsFor: 'state accessing'!
  1843. finalState: argument 
  1844.  
  1845.     finalState := argument! !
  1846.  
  1847. !LR1Parser methodsFor: 'parsing'!
  1848. acceptSymbol
  1849.  
  1850.     ^self lrParserStateClass acceptSymbol! !
  1851.  
  1852. !LR1Parser methodsFor: 'parsing'!
  1853. actionAt: currState 
  1854.  
  1855.     ^currState actionFor: self nextToken! !
  1856.  
  1857. !LR1Parser methodsFor: 'parsing'!
  1858. at: state transitionFor: symbol 
  1859.  
  1860.     ^state transitionFor: symbol! !
  1861.  
  1862. !LR1Parser methodsFor: 'parsing'!
  1863. lrParserStateClass
  1864.  
  1865.     ^LRParserState! !
  1866.  
  1867. !LR1Parser methodsFor: 'parsing'!
  1868. parse
  1869.  
  1870.     | stack action currState |
  1871.     stack := Stack new.
  1872.     currState := self startState.
  1873.     stack push: currState.
  1874.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  1875.         whileFalse: 
  1876.             [currState := action isGrammarProduction
  1877.                         ifTrue: 
  1878.                             ["reduce"
  1879.                             stack pop: action rightHandSide size.
  1880.                             self at: stack top transitionFor: action leftHandSide]
  1881.                         ifFalse: 
  1882.                             ["shift"
  1883.                             self scanToken.
  1884.                             action].
  1885.             stack push: currState]! !
  1886.  
  1887. !LR1Parser methodsFor: 'parsing'!
  1888. parseWithTreeBuilder: parseTreeBuilder 
  1889.  
  1890.     | stack currState action |
  1891.     stack := Stack new.
  1892.     currState := self startState.
  1893.     stack push: currState.
  1894.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  1895.         whileFalse: 
  1896.             [currState := action isGrammarProduction
  1897.                         ifTrue: 
  1898.                             ["reduce"
  1899.                             stack pop: action rightHandSide size.
  1900.                             parseTreeBuilder processProduction: action forParser: self.
  1901.                             self at: stack top transitionFor: action leftHandSide]
  1902.                         ifFalse: 
  1903.                             ["shift"
  1904.                             self scanToken.
  1905.                             action].
  1906.             stack push: currState].
  1907.     ^parseTreeBuilder result! !
  1908.  
  1909. !LR1Parser methodsFor: 'parsing'!
  1910. startState
  1911.  
  1912.     ^self parseTable! !
  1913.  
  1914. !LR1Parser methodsFor: 'parsing'!
  1915. traceParse
  1916.  
  1917.     | stack action currState nextState |
  1918.     self
  1919.          cr;
  1920.          cr;
  1921.          showCR: 'LR Parser trace of:  ' , self scanner contents;
  1922.          cr.
  1923.     stack := Stack new.
  1924.     currState := self startState.
  1925.     stack push: currState.
  1926.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  1927.         whileFalse: 
  1928.             [currState := action isGrammarProduction
  1929.                         ifTrue: 
  1930.                             ["reduce"
  1931.                             stack pop: action rightHandSide size.
  1932.                             nextState := self at: stack top transitionFor: action leftHandSide.
  1933.                             self showCR: 'reduce by ' , action printString , ' then goto state ' , nextState hash printString.
  1934.                             nextState]
  1935.                         ifFalse: 
  1936.                             ["shift"
  1937.                             self showCR: 'shift on ''' , self nextToken asString, ''' to state ' , action hash printString.
  1938.                             self scanToken.
  1939.                             action].
  1940.             stack push: currState]! !
  1941.  
  1942. !LR1Parser methodsFor: 'lalr analysis'!
  1943. lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar 
  1944.  
  1945.     ^self parseTable lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar! !
  1946.  
  1947. !LR1Parser methodsFor: 'private'!
  1948. myFinalState
  1949.  
  1950.     ^self class finalState! !
  1951.  
  1952. !LR1Parser methodsFor: 'private'!
  1953. parserErrorSignal
  1954.  
  1955.     ^LRParserState noTransitionSignal! !
  1956.  
  1957. !LR1Parser methodsFor: 'testing'!
  1958. performsRightmostDerivation
  1959.  
  1960.     ^true! !
  1961.  
  1962. !LR1Parser methodsFor: 'initialization'!
  1963. init
  1964.  
  1965.     super init.
  1966.     self finalState: self myFinalState! !
  1967.  
  1968. !LR1Parser methodsFor: 'converting'!
  1969. fastParser
  1970.  
  1971.     ^OptimizedLR1Parser buildFrom: self! !
  1972.  
  1973. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1974.  
  1975. LR1Parser class
  1976.     instanceVariableNames: 'finalState '!
  1977.  
  1978. !LR1Parser class methodsFor: 'instance creation'!
  1979. parseTable: table finalState: state 
  1980.  
  1981.     | newParser |
  1982.     newParser := self new.
  1983.     newParser parseTable: table.
  1984.     newParser finalState: state.
  1985.     ^newParser! !
  1986.  
  1987. !LR1Parser class methodsFor: 'state accessing'!
  1988. finalState
  1989.  
  1990.     ^finalState! !
  1991.  
  1992. !LR1Parser class methodsFor: 'state accessing'!
  1993. finalState: argument 
  1994.  
  1995.     finalState := argument! !
  1996.  
  1997. LR1Parser subclass: #OptimizedLR1Parser
  1998.     instanceVariableNames: 'tokenTypeTable '
  1999.     classVariableNames: 'NoTransitionSignal '
  2000.     poolDictionaries: ''
  2001.     category: 'Compilers-Parsers'!
  2002. OptimizedLR1Parser comment:
  2003. '=================================================
  2004.     Copyright (c) 1992 by Justin O. Graver.
  2005.     All rights reserved (with exceptions).
  2006.     For complete information evaluate "Object tgenCopyright."
  2007. =================================================
  2008.  
  2009. I am an LR parser represented efficietly in Array table form.
  2010.  
  2011. Instance variables:
  2012.     tokenTypeTable <Array of: String>    - the integer mapping of terminals and nonterminals'!
  2013.  
  2014. OptimizedLR1Parser comment:
  2015. '=================================================
  2016.     Copyright (c) 1992 by Justin O. Graver.
  2017.     All rights reserved (with exceptions).
  2018.     For complete information evaluate "Object tgenCopyright."
  2019. =================================================
  2020.  
  2021. I am an LR parser represented efficietly in Array table form.
  2022.  
  2023. Instance variables:
  2024.     tokenTypeTable <Array of: String>    - the integer mapping of terminals and nonterminals'!
  2025.  
  2026. !OptimizedLR1Parser methodsFor: 'state accessing'!
  2027. tokenTypeTable
  2028.  
  2029.     ^tokenTypeTable! !
  2030.  
  2031. !OptimizedLR1Parser methodsFor: 'state accessing'!
  2032. tokenTypeTable: arg 
  2033.  
  2034.     tokenTypeTable := arg! !
  2035.  
  2036. !OptimizedLR1Parser methodsFor: 'reconstructing'!
  2037. mapProductionToInteger
  2038.     "Answer an Array of all grammar symbols - nonterminals, terminals, 
  2039.     and translation symbols."
  2040.  
  2041.     | transSyms |
  2042.     transSyms := Set new.
  2043.     parseTable do: [:row | row do: [:ea | ea isGrammarProduction ifTrue: [ea hasTranslation ifTrue: [transSyms add: ea translationSymbol]]]].
  2044.     ^self tokenTypeTable , transSyms asOrderedCollection asArray! !
  2045.  
  2046. !OptimizedLR1Parser methodsFor: 'reconstructing'!
  2047. reconstructOn: aStream 
  2048.     "Recreate a parse table and a token type table"
  2049.  
  2050.     | prodTable |
  2051.     prodTable := self mapProductionToInteger.
  2052.     aStream nextPutAll: 'prodTable := '.
  2053.     prodTable reconstructOn: aStream.
  2054.     aStream
  2055.         period;
  2056.         crtab;
  2057.         nextPutAll: 'self tokenTypeTable:  (prodTable copyFrom: 1 to:  ';
  2058.         nextPutAll: tokenTypeTable size printString;
  2059.         nextPutAll: ').';
  2060.         crtab;
  2061.         nextPutAll: 'table := '.
  2062.     self parseTable reconstructOn: aStream using: prodTable.
  2063.     aStream
  2064.         period;
  2065.         crtab;
  2066.         nextPutAll: 'self constructParseTable: table  with: prodTable.';
  2067.         crtab;
  2068.         nextPutAll: 'self finalState: '.
  2069.     self finalState printOn: aStream! !
  2070.  
  2071. !OptimizedLR1Parser methodsFor: 'private'!
  2072. parseError
  2073.  
  2074.     self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken
  2075.             ifTrue: [self endOfInputErrorString]
  2076.             ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! !
  2077.  
  2078. !OptimizedLR1Parser methodsFor: 'exception handling'!
  2079. endOfInputErrorString
  2080.  
  2081.     ^'end of input encountered'! !
  2082.  
  2083. !OptimizedLR1Parser methodsFor: 'exception handling'!
  2084. parserErrorSignal
  2085.  
  2086.     ^self class noTransitionSignal! !
  2087.  
  2088. !OptimizedLR1Parser methodsFor: 'exception handling'!
  2089. raiseNoTransitionExceptionErrorString: aString 
  2090.  
  2091.     self parserErrorSignal raiseErrorString: aString! !
  2092.  
  2093. !OptimizedLR1Parser methodsFor: 'exception handling'!
  2094. scannerErrorSignal
  2095.  
  2096.     ^OptimizedScanner noTransitionSignal! !
  2097.  
  2098. !OptimizedLR1Parser methodsFor: 'exception handling'!
  2099. standardErrorString
  2100.  
  2101.     ^'unexpected token encountered:  '! !
  2102.  
  2103. !OptimizedLR1Parser methodsFor: 'converting'!
  2104. assignNextIDAfter: id toSuccessorOf: state 
  2105.  
  2106.     | nextID nextState |
  2107.     nextID := id + 1.
  2108.     state edgeLabelMap
  2109.         associationsDo: 
  2110.             [:assoc | 
  2111.             tokenTypeTable add: assoc key.
  2112.             nextState := assoc value.
  2113.             nextState stateID isNil
  2114.                 ifTrue: 
  2115.                     [nextState stateID: nextID.
  2116.                     nextID := self assignNextIDAfter: nextID toSuccessorOf: nextState]].
  2117.     state reduceMap associationsDo: [:assoc | tokenTypeTable add: assoc key].
  2118.     ^nextID! !
  2119.  
  2120. !OptimizedLR1Parser methodsFor: 'converting'!
  2121. changeToObjectTable: lrParserState 
  2122.  
  2123.     | sizePlusOne objectTable |
  2124.     lrParserState stateID notNil ifTrue: [lrParserState nilOutStateIDs].
  2125.     lrParserState stateID: self startState.
  2126.     self tokenTypeTable: Set new.
  2127.     sizePlusOne := self assignNextIDAfter: self startState toSuccessorOf: lrParserState.
  2128.     self tokenTypeTable: tokenTypeTable asOrderedCollection asArray.
  2129.     objectTable := Array new: sizePlusOne - 1.
  2130.     ^self convert: lrParserState to: objectTable! !
  2131.  
  2132. !OptimizedLR1Parser methodsFor: 'converting'!
  2133. convert: state to: objectTable 
  2134.     "I try to create a table that maps state ( represented by integer ) to state or state to 
  2135.     production"
  2136.  
  2137.     | arr nextState |
  2138.     arr := Array new: self tokenTypeTable size.
  2139.     objectTable at: state stateID put: arr.
  2140.     state edgeLabelMap
  2141.         associationsDo: 
  2142.             [:assoc | 
  2143.             nextState := assoc value.
  2144.             (objectTable at: nextState stateID) isNil ifTrue: [self convert: nextState to: objectTable].
  2145.             arr at: (tokenTypeTable indexOf: assoc key)
  2146.                 put: nextState stateID].
  2147.     state reduceMap associationsDo: [:assoc | arr at: (tokenTypeTable indexOf: assoc key)
  2148.             put: assoc value first].
  2149.     ^objectTable! !
  2150.  
  2151. !OptimizedLR1Parser methodsFor: 'converting'!
  2152. convertToTable: lr1Parser 
  2153.  
  2154.     self scanner: lr1Parser scanner fastScanner.
  2155.     self parseTable: (self changeToObjectTable: lr1Parser parseTable).
  2156.     self treeBuilder:  lr1Parser treeBuilder.
  2157.     self finalState: lr1Parser finalState stateID! !
  2158.  
  2159. !OptimizedLR1Parser methodsFor: 'scanner/parser generation'!
  2160. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  2161.     | ws |
  2162.     ws := WriteStream on: (String new: 2048).
  2163.     ws
  2164.         nextPutAll: 'initialize';
  2165.         crtab;
  2166.         nextPut: $";
  2167.         nextPutAll: name;
  2168.         nextPutAll: ' initialize"';
  2169.         crtab;
  2170.         nextPut: $".
  2171.     grammarSpec do: 
  2172.         [:ch | 
  2173.         "double embedded double-quote characters"
  2174.         ws nextPut: ch.
  2175.         ch = $" ifTrue: [ws nextPut: $"]].
  2176.     ws
  2177.         nextPut: $";
  2178.         cr;
  2179.         crtab;
  2180.         nextPutAll: '| table prodTable |';
  2181.         crtab.
  2182.     self reconstructOn: ws.
  2183.     ^ws contents! !
  2184.  
  2185. !OptimizedLR1Parser methodsFor: 'parsing'!
  2186. actionAt: currState 
  2187.  
  2188.     | action |
  2189.     (action := (parseTable at: currState)
  2190.                 at: (tokenTypeTable indexOf: self nextToken)) isNil ifTrue: [(scanner finalStateTable includes: currState)
  2191.             ifTrue: [^#accept]
  2192.             ifFalse: [self parseError]].
  2193.     ^action! !
  2194.  
  2195. !OptimizedLR1Parser methodsFor: 'parsing'!
  2196. at: currState transitionFor: symbol 
  2197.  
  2198.     | value |
  2199.     (value := (parseTable at: currState)
  2200.                 at: (tokenTypeTable indexOf: symbol)) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (symbol = self endOfInputToken
  2201.                 ifTrue: [self endOfInputErrorString]
  2202.                 ifFalse: [self standardErrorString , '''' , symbol printString , ''''])].
  2203.     ^value! !
  2204.  
  2205. !OptimizedLR1Parser methodsFor: 'initialization'!
  2206. init
  2207.  
  2208.     super init.
  2209.     self tokenTypeTable: self myTokenTypeTable! !
  2210.  
  2211. !OptimizedLR1Parser methodsFor: 'accessing'!
  2212. myTokenTypeTable
  2213.  
  2214.     ^self class tokenTypeTable! !
  2215.  
  2216. !OptimizedLR1Parser methodsFor: 'accessing'!
  2217. startState
  2218.  
  2219.     ^1! !
  2220.  
  2221. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2222.  
  2223. OptimizedLR1Parser class
  2224.     instanceVariableNames: 'tokenTypeTable '!
  2225.  
  2226. !OptimizedLR1Parser class methodsFor: 'class initialization'!
  2227. initialize
  2228.     "OptimizedLR1Parser initialize"
  2229.  
  2230.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  2231.  
  2232. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  2233. noTransitionSignal
  2234.  
  2235.     ^NoTransitionSignal! !
  2236.  
  2237. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  2238. noTransitionSignal: argument 
  2239.  
  2240.     NoTransitionSignal := argument! !
  2241.  
  2242. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  2243. tokenTypeTable
  2244.  
  2245.     ^tokenTypeTable! !
  2246.  
  2247. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  2248. tokenTypeTable: arg 
  2249.  
  2250.     tokenTypeTable := arg! !
  2251.  
  2252. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  2253. constructGrammarProduction: arg with: prodTable 
  2254.  
  2255.     | rhs |
  2256.     (arg at: 2) isEmpty
  2257.         ifTrue: [rhs := OrderedCollection new]
  2258.         ifFalse: 
  2259.             [rhs := OrderedCollection new.
  2260.             (arg at: 2)
  2261.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  2262.     ^GrammarProduction leftHandSide: (prodTable at: (arg at: 1))
  2263.         rightHandSide: rhs! !
  2264.  
  2265. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  2266. constructParseTable: table with: prodTable 
  2267.  
  2268.     | ea row |
  2269.     parseTable := Array new: table size.
  2270.     1 to: table size do: 
  2271.         [:index | 
  2272.         row := Array new: (table at: index) size.
  2273.         parseTable at: index put: row.
  2274.         1 to: (table at: index) size do: 
  2275.             [:i | 
  2276.             ea := (table at: index)
  2277.                         at: i.
  2278.             ea isNil ifFalse: [ea isInteger
  2279.                     ifTrue: [row at: i put: ea]
  2280.                     ifFalse: [ea size == 2
  2281.                             ifTrue: [row at: i put: (self constructGrammarProduction: ea with: prodTable)]
  2282.                             ifFalse: [row at: i put: (self constructTransductionGrammarProduction: ea with: prodTable)]]]]]! !
  2283.  
  2284. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  2285. constructTransductionGrammarProduction: arg with: prodTable 
  2286.  
  2287.     | rhs |
  2288.     (arg at: 2) isEmpty
  2289.         ifTrue: [rhs := OrderedCollection new]
  2290.         ifFalse: 
  2291.             [rhs := OrderedCollection new.
  2292.             (arg at: 2)
  2293.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  2294.     ^TransductionGrammarProduction
  2295.         leftHandSide: (prodTable at: (arg at: 1))
  2296.         rightHandSide: rhs
  2297.         translationSymbol: (prodTable at: (arg at: 3))! !
  2298.  
  2299. !OptimizedLR1Parser class methodsFor: 'instance creation'!
  2300. buildFrom: fsaParser
  2301.  
  2302.     ^self new convertToTable: fsaParser! !
  2303.  
  2304. TableDrivenParser initialize!
  2305.  
  2306. OptimizedLL1Parser initialize!
  2307.  
  2308. OptimizedLR1Parser initialize!
  2309.  
  2310. Object subclass: #AbstractScanner
  2311.     instanceVariableNames: 'source nextChar token tokenType buffer '
  2312.     classVariableNames: ''
  2313.     poolDictionaries: ''
  2314.     category: 'Compilers-Scanners'!
  2315. AbstractScanner comment:
  2316. '=================================================
  2317.     Copyright (c) 1992 by Justin O. Graver.
  2318.     All rights reserved (with exceptions).
  2319.     For complete information evaluate "Object tgenCopyright."
  2320. =================================================
  2321.  
  2322. I scan a source string and break it up into tokens using mechanisms provided in concrete subclasses.
  2323.  
  2324. Instance Variables:
  2325.     source            <ReadStream> - character input stream.
  2326.     nextChar        <Character + UndefinedObject> - one-character lookahead buffer for source, nil if no input left.
  2327.     token            <String> - current token buffer.
  2328.     tokenType    <String + Symbol> - current token type buffer.
  2329.     buffer            <WriteStream> - character accumulation buffer for tokens.
  2330. '!
  2331.  
  2332. AbstractScanner comment:
  2333. '=================================================
  2334.     Copyright (c) 1992 by Justin O. Graver.
  2335.     All rights reserved (with exceptions).
  2336.     For complete information evaluate "Object tgenCopyright."
  2337. =================================================
  2338.  
  2339. I scan a source string and break it up into tokens using mechanisms provided in concrete subclasses.
  2340.  
  2341. Instance Variables:
  2342.     source            <ReadStream> - character input stream.
  2343.     nextChar        <Character + UndefinedObject> - one-character lookahead buffer for source, nil if no input left.
  2344.     token            <String> - current token buffer.
  2345.     tokenType    <String + Symbol> - current token type buffer.
  2346.     buffer            <WriteStream> - character accumulation buffer for tokens.
  2347. '!
  2348.  
  2349. !AbstractScanner methodsFor: 'initialization'!
  2350. init
  2351.  
  2352.     self buffer: (RetractableWriteStream on: (String new: 32))! !
  2353.  
  2354. !AbstractScanner methodsFor: 'initialization'!
  2355. reset
  2356.     "Reset the initial state of the scanner before scanning a new source."
  2357.  
  2358.     self buffer reset.
  2359.     self token: nil.
  2360.     self tokenType: nil.
  2361.     self nextChar: nil! !
  2362.  
  2363. !AbstractScanner methodsFor: 'initialization'!
  2364. scanSource: aString 
  2365.     "Convert the input string to a read stream and scan the first token."
  2366.  
  2367.     self reset.
  2368.     self source: (RetractableReadStream on: aString).
  2369.     self nextChar: self source next.
  2370.     self scanToken! !
  2371.  
  2372. !AbstractScanner methodsFor: 'state accessing'!
  2373. buffer
  2374.  
  2375.     ^buffer! !
  2376.  
  2377. !AbstractScanner methodsFor: 'state accessing'!
  2378. buffer: argument 
  2379.  
  2380.     buffer := argument! !
  2381.  
  2382. !AbstractScanner methodsFor: 'state accessing'!
  2383. nextChar
  2384.  
  2385.     ^nextChar! !
  2386.  
  2387. !AbstractScanner methodsFor: 'state accessing'!
  2388. nextChar: argument 
  2389.  
  2390.     nextChar := argument! !
  2391.  
  2392. !AbstractScanner methodsFor: 'state accessing'!
  2393. source
  2394.  
  2395.     ^source! !
  2396.  
  2397. !AbstractScanner methodsFor: 'state accessing'!
  2398. source: argument 
  2399.  
  2400.     source := argument! !
  2401.  
  2402. !AbstractScanner methodsFor: 'state accessing'!
  2403. token
  2404.  
  2405.     ^token! !
  2406.  
  2407. !AbstractScanner methodsFor: 'state accessing'!
  2408. token: argument 
  2409.  
  2410.     token := argument! !
  2411.  
  2412. !AbstractScanner methodsFor: 'state accessing'!
  2413. tokenType
  2414.  
  2415.     ^tokenType! !
  2416.  
  2417. !AbstractScanner methodsFor: 'state accessing'!
  2418. tokenType: argument 
  2419.  
  2420.     tokenType := argument! !
  2421.  
  2422. !AbstractScanner methodsFor: 'scanning'!
  2423. backspaceSource
  2424.     "When the source is at the end, 'source current' is the last character."
  2425.  
  2426.     self atEnd ifFalse: [self source backspace].
  2427.     self nextChar: self source current! !
  2428.  
  2429. !AbstractScanner methodsFor: 'scanning'!
  2430. getNextChar
  2431.     "Source will answer an empty string when no more input is available. 
  2432.     Subclasses may override this to avoid unnecessary buffering."
  2433.  
  2434.     self buffer nextPut: self nextChar.
  2435.     self nextChar: self source next! !
  2436.  
  2437. !AbstractScanner methodsFor: 'scanning'!
  2438. putBackChar
  2439.     "Remove the last character in the buffer and backspace the source. 
  2440.     Subclasses may override this to avoid unnecessary buffering."
  2441.  
  2442.     self buffer backspace.
  2443.     self backspaceSource! !
  2444.  
  2445. !AbstractScanner methodsFor: 'scanning'!
  2446. scanToken
  2447.     "Subclasses must compute values for token and tokenType here."
  2448.  
  2449.     self subclassResponsibility! !
  2450.  
  2451. !AbstractScanner methodsFor: 'scanning'!
  2452. signalEndOfInput
  2453.     "Set scanner to the end-of-input state."
  2454.  
  2455.     self tokenType: self endOfInputTokenType.
  2456.     self token: self endOfInputToken! !
  2457.  
  2458. !AbstractScanner methodsFor: 'testing'!
  2459. atEnd
  2460.  
  2461.     ^self nextChar = self endOfInputToken! !
  2462.  
  2463. !AbstractScanner methodsFor: 'accessing'!
  2464. contents
  2465.  
  2466.     ^self source contents! !
  2467.  
  2468. !AbstractScanner methodsFor: 'accessing'!
  2469. endOfInputToken
  2470.     "Answer a token representing the end of the input."
  2471.  
  2472.     self subclassResponsibility! !
  2473.  
  2474. !AbstractScanner methodsFor: 'accessing'!
  2475. endOfInputTokenType
  2476.     "Answer the token type representing the end of the input."
  2477.  
  2478.     self subclassResponsibility! !
  2479.  
  2480. !AbstractScanner methodsFor: 'accessing'!
  2481. errorPosition
  2482.     "Answer the source position of the last acceptable character."
  2483.  
  2484.     ^source position + (self atEnd
  2485.             ifTrue: [1]
  2486.             ifFalse: [0]) max: 1! !
  2487.  
  2488. !AbstractScanner methodsFor: 'accessing'!
  2489. position
  2490.  
  2491.     ^self source position! !
  2492.  
  2493. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2494.  
  2495. AbstractScanner class
  2496.     instanceVariableNames: ''!
  2497.  
  2498. !AbstractScanner class methodsFor: 'instance creation'!
  2499. new
  2500.  
  2501.     ^super new init! !
  2502.  
  2503. !AbstractScanner class methodsFor: 'instance creation'!
  2504. scanFrom: aString 
  2505.  
  2506.     | newScanner |
  2507.     newScanner := self new.
  2508.     newScanner scanSource: aString.
  2509.     ^newScanner! !
  2510.  
  2511. AbstractScanner subclass: #FSABasedScanner
  2512.     instanceVariableNames: 'fsa '
  2513.     classVariableNames: ''
  2514.     poolDictionaries: ''
  2515.     category: 'Compilers-Scanners'!
  2516. FSABasedScanner comment:
  2517. '=================================================
  2518.     Copyright (c) 1992 by Justin O. Graver.
  2519.     All rights reserved (with exceptions).
  2520.     For complete information evaluate "Object tgenCopyright."
  2521. =================================================
  2522.  
  2523. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a minimal deterministic finite-state automata (FSA).  Each token is also given a type by its associated final state in the FSA.  Specific FSAs are stored in class instance variables of my concrete subclasses.
  2524.  
  2525. Instance Variables:
  2526.     fsa                <FSAState> - a local reference to the token recognizer, in minimal deterministic form, for this class of scanner.
  2527. '!
  2528.  
  2529. FSABasedScanner comment:
  2530. '=================================================
  2531.     Copyright (c) 1992 by Justin O. Graver.
  2532.     All rights reserved (with exceptions).
  2533.     For complete information evaluate "Object tgenCopyright."
  2534. =================================================
  2535.  
  2536. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a minimal deterministic finite-state automata (FSA).  Each token is also given a type by its associated final state in the FSA.  Specific FSAs are stored in class instance variables of my concrete subclasses.
  2537.  
  2538. Instance Variables:
  2539.     fsa                <FSAState> - a local reference to the token recognizer, in minimal deterministic form, for this class of scanner.
  2540. '!
  2541.  
  2542. !FSABasedScanner methodsFor: 'state accessing'!
  2543. fsa
  2544.  
  2545.     ^fsa! !
  2546.  
  2547. !FSABasedScanner methodsFor: 'state accessing'!
  2548. fsa: argument 
  2549.  
  2550.     fsa := argument! !
  2551.  
  2552. !FSABasedScanner methodsFor: 'scanning directives'!
  2553. compactDoubleApostrophes
  2554.     "Compact all two apostrophe sequences in my current token into a single 
  2555.     apostrophe."
  2556.  
  2557.     | readStream writeStream ch nextCh |
  2558.     readStream := ReadStream on: self token.
  2559.     writeStream := WriteStream on: (String new: 20).
  2560.     [readStream atEnd]
  2561.         whileFalse: 
  2562.             [writeStream nextPut: (ch := readStream next).
  2563.             (ch = $' and: [(nextCh := readStream peek) notNil and: [nextCh = $']])
  2564.                 ifTrue: [readStream skip: 1]].
  2565.     self token: writeStream contents! !
  2566.  
  2567. !FSABasedScanner methodsFor: 'scanning directives'!
  2568. ignoreComment
  2569.  
  2570.     self scanToken! !
  2571.  
  2572. !FSABasedScanner methodsFor: 'scanning directives'!
  2573. ignoreDelimiter
  2574.  
  2575.     self scanToken! !
  2576.  
  2577. !FSABasedScanner methodsFor: 'accessing'!
  2578. endOfInputToken
  2579.     "Answer a token representing the end of the input."
  2580.  
  2581.     ^Character endOfInput! !
  2582.  
  2583. !FSABasedScanner methodsFor: 'accessing'!
  2584. endOfInputTokenType
  2585.     "Answer the token type representing the end of the input."
  2586.  
  2587.     ^self endOfInputToken! !
  2588.  
  2589. !FSABasedScanner methodsFor: 'accessing'!
  2590. myFsa
  2591.  
  2592.     ^self class fsa! !
  2593.  
  2594. !FSABasedScanner methodsFor: 'accessing'!
  2595. startState
  2596.  
  2597.     ^self fsa! !
  2598.  
  2599. !FSABasedScanner methodsFor: 'scanning'!
  2600. scanToken
  2601.     "Scan the next token and compute its token type."
  2602.  
  2603.     | state nextState tok typeAction |
  2604.     self atEnd
  2605.         ifTrue: [self signalEndOfInput]
  2606.         ifFalse: 
  2607.             [state := self startState.
  2608.             [(nextState := self at: state transitionFor: self nextChar) isNil]
  2609.                 whileFalse: 
  2610.                     [state := nextState.
  2611.                     self getNextChar].
  2612.             tok := self buffer contents.
  2613.             typeAction := self at: state tokenTypeAndActionFor: tok.
  2614.             self tokenType: typeAction type.
  2615.             self token: tok.
  2616.             self buffer reset.
  2617.             typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  2618.  
  2619. !FSABasedScanner methodsFor: 'initialization'!
  2620. init
  2621.  
  2622.     super init.
  2623.     self fsa: self myFsa! !
  2624.  
  2625. !FSABasedScanner methodsFor: 'scanner generation'!
  2626. classInitializationMethodTextForClassNamed: name spec: tokenSpec 
  2627.  
  2628.     ^self subclassResponsibility! !
  2629.  
  2630. !FSABasedScanner methodsFor: 'scanner generation'!
  2631. createScannerClassNamed: name category: category spec: tokenSpec 
  2632.  
  2633.     | scannerClass |
  2634.     scannerClass := self defaultScannerClass
  2635.                 subclass: name asSymbol
  2636.                 instanceVariableNames: ''
  2637.                 classVariableNames: ''
  2638.                 poolDictionaries: ''
  2639.                 category: category.
  2640.     scannerClass comment: self generatedScannerClassComment.
  2641.     scannerClass class compile: (self classInitializationMethodTextForClassNamed: name spec: tokenSpec)
  2642.         classified: 'class initialization'.
  2643.     scannerClass initialize.
  2644.     ^scannerClass! !
  2645.  
  2646. !FSABasedScanner methodsFor: 'scanner generation'!
  2647. generatedScannerClassComment
  2648.  
  2649.     ^'This scanner class was automatically generated by ', TranslatorGenerator versionName , '.'! !
  2650.  
  2651. !FSABasedScanner methodsFor: 'scanner generation'!
  2652. defaultScannerClass
  2653.  
  2654.     ^self class! !
  2655.  
  2656. !FSABasedScanner methodsFor: 'scanner generation'!
  2657. defaultOptimizedScannerClass
  2658.  
  2659.     ^OptimizedScanner! !
  2660.  
  2661. !FSABasedScanner methodsFor: 'converting'!
  2662. fastScanner
  2663.  
  2664.     ^self defaultOptimizedScannerClass buildFrom: self! !
  2665.  
  2666. !FSABasedScanner methodsFor: 'private'!
  2667. at: state tokenTypeAndActionFor: tok 
  2668.  
  2669.     ^state tokenTypeAndActionFor: tok! !
  2670.  
  2671. !FSABasedScanner methodsFor: 'private'!
  2672. at: state transitionFor: char 
  2673.  
  2674.     ^state transitionFor: char! !
  2675.  
  2676. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2677.  
  2678. FSABasedScanner class
  2679.     instanceVariableNames: 'fsa '!
  2680.  
  2681. !FSABasedScanner class methodsFor: 'state accessing'!
  2682. fsa
  2683.  
  2684.     ^fsa! !
  2685.  
  2686. !FSABasedScanner class methodsFor: 'state accessing'!
  2687. fsa: argument 
  2688.  
  2689.     fsa := argument! !
  2690.  
  2691. !FSABasedScanner class methodsFor: 'class initialization'!
  2692. initialize
  2693.     "Concrete subclasses must somehow provide a fsa. Subclasses created by 
  2694.     automatic means may simply 'plug-in' a dynamically computed fsa. However, if a 
  2695.     class that can be filed-out is desired then it is worthwhile to override this 
  2696.     initialization method with one that can build the appropriate fsa directly."
  2697.     "FSABasedScanner initialize"
  2698.  
  2699.     self fsa: nil! !
  2700.  
  2701. FSABasedScanner subclass: #FSABasedLookaheadScanner
  2702.     instanceVariableNames: 'savePosition '
  2703.     classVariableNames: ''
  2704.     poolDictionaries: ''
  2705.     category: 'Compilers-Scanners'!
  2706. FSABasedLookaheadScanner comment:
  2707. '=================================================
  2708.     Copyright (c) 1992 by Justin O. Graver.
  2709.     All rights reserved (with exceptions).
  2710.     For complete information evaluate "Object tgenCopyright."
  2711. =================================================
  2712.  
  2713. This is an abstract class for scanners with lookahead.
  2714.  
  2715. Instance Variables:
  2716.     savePosition <Integer> - pointer into input source for error notification.'!
  2717.  
  2718. FSABasedLookaheadScanner comment:
  2719. '=================================================
  2720.     Copyright (c) 1992 by Justin O. Graver.
  2721.     All rights reserved (with exceptions).
  2722.     For complete information evaluate "Object tgenCopyright."
  2723. =================================================
  2724.  
  2725. This is an abstract class for scanners with lookahead.
  2726.  
  2727. Instance Variables:
  2728.     savePosition <Integer> - pointer into input source for error notification.'!
  2729.  
  2730. !FSABasedLookaheadScanner methodsFor: 'initialization'!
  2731. reset
  2732.     "Reset the initial state of the scanner before scanning a new source."
  2733.  
  2734.     super reset.
  2735.     self savePosition: 0! !
  2736.  
  2737. !FSABasedLookaheadScanner methodsFor: 'state accessing'!
  2738. savePosition
  2739.  
  2740.     ^savePosition! !
  2741.  
  2742. !FSABasedLookaheadScanner methodsFor: 'state accessing'!
  2743. savePosition: argument 
  2744.  
  2745.     savePosition := argument! !
  2746.  
  2747. !FSABasedLookaheadScanner methodsFor: 'accessing'!
  2748. errorPosition
  2749.     "Answer the source position of the last acceptable character."
  2750.  
  2751.     ^self savePosition max: 1! !
  2752.  
  2753. FSABasedLookaheadScanner subclass: #FSABasedScannerWithTwoTokenLookahead
  2754.     instanceVariableNames: 'stateStack saveState saveChar '
  2755.     classVariableNames: ''
  2756.     poolDictionaries: ''
  2757.     category: 'Compilers-Scanners'!
  2758. FSABasedScannerWithTwoTokenLookahead comment:
  2759. '=================================================
  2760.     Copyright (c) 1992 by Justin O. Graver.
  2761.     All rights reserved (with exceptions).
  2762.     For complete information evaluate "Object tgenCopyright."
  2763. =================================================
  2764.  
  2765. This class provides a scanner with simple two-token lookahead.
  2766.  
  2767. Instance Variables:
  2768.     stateStack    <Stack> - primary state stack for scanning tokens.
  2769.     saveState    <Integer> - pointer into input source for error notification.
  2770.     saveChar    <Character> - pointer into input source for error notification.'!
  2771.  
  2772. FSABasedScannerWithTwoTokenLookahead comment:
  2773. '=================================================
  2774.     Copyright (c) 1992 by Justin O. Graver.
  2775.     All rights reserved (with exceptions).
  2776.     For complete information evaluate "Object tgenCopyright."
  2777. =================================================
  2778.  
  2779. This class provides a scanner with simple two-token lookahead.
  2780.  
  2781. Instance Variables:
  2782.     stateStack    <Stack> - primary state stack for scanning tokens.
  2783.     saveState    <Integer> - pointer into input source for error notification.
  2784.     saveChar    <Character> - pointer into input source for error notification.'!
  2785.  
  2786. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanner generation'!
  2787. defaultOptimizedScannerClass
  2788.  
  2789.     ^OptimizedScannerWithTwoTokenLookahead! !
  2790.  
  2791. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  2792. checkForTokenIn: newStateStack buffer: charBuffer 
  2793.     "Scan the input using the arguments. Answer true if a legal token (or no illegal token) was 
  2794.     found and false otherwise."
  2795.  
  2796.     | nextState |
  2797.     self atEnd
  2798.         ifFalse: 
  2799.             [newStateStack push: self startState.
  2800.             "look for longest possible token"
  2801.             [(nextState := newStateStack top transitionFor: self nextChar ifNone: [nil]) isNil]
  2802.                 whileFalse: 
  2803.                     [newStateStack push: nextState.
  2804.                     "getNextChar for local vars"
  2805.                     charBuffer nextPut: self nextChar.
  2806.                     self nextChar: self source next].
  2807.             "save the current position for error notification"
  2808.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  2809.             newStateStack top isFSAFinalState
  2810.                 ifFalse: 
  2811.                     [self saveChar: self nextChar.
  2812.                     self saveState: newStateStack top.
  2813.                     "backup to the previous final state or to the start state"
  2814.                     [newStateStack size = 1 or: [newStateStack top isFSAFinalState]]
  2815.                         whileFalse: 
  2816.                             [newStateStack pop.
  2817.                             "putBackChar for local vars"
  2818.                             charBuffer backspace.
  2819.                             self backspaceSource].
  2820.                     newStateStack size = 1 ifTrue: 
  2821.                         ["backed up to the start state"
  2822.                         self stateStack == newStateStack
  2823.                             ifTrue: 
  2824.                                 ["this is the first token, so signal an error (abort and return)"
  2825.                                 self saveState transitionFor: self saveChar]
  2826.                             ifFalse: 
  2827.                                 ["we may be able to backup in the previous token"
  2828.                                 ^false]]]].
  2829.     ^true! !
  2830.  
  2831. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  2832. scanToken
  2833.     "Scan the next token and compute its token type."
  2834.  
  2835.     | tok typeAction newStateStack charBuffer |
  2836.     newStateStack := Stack new.
  2837.     charBuffer := RetractableWriteStream on: (String new: 32).
  2838.     (self checkForTokenIn: newStateStack buffer: charBuffer)
  2839.         ifTrue: 
  2840.             ["either a legal token or the end on input was found"
  2841.             self stateStack isEmpty ifTrue: [self atEnd
  2842.                     ifTrue: [^self signalEndOfInput]
  2843.                     ifFalse: [self error: 'no more vaild tokens']].
  2844.             tok := self buffer contents.
  2845.             typeAction := self stateStack top tokenTypeAndActionFor: tok.
  2846.             self tokenType: typeAction type.
  2847.             self token: tok.
  2848.             self buffer: charBuffer.
  2849.             self stateStack: newStateStack.
  2850.             typeAction action notNil ifTrue: [self perform: typeAction action]]
  2851.         ifFalse: 
  2852.             ["an illegal token was found, try to look for earlier final state in current token buffers"
  2853.             charBuffer size timesRepeat: 
  2854.                 ["put back illegal token chars"
  2855.                 self backspaceSource].
  2856.             "backup in current token to next smallest legal token"
  2857.             [self stateStack size = 1
  2858.                 or: 
  2859.                     [self stateStack pop.
  2860.                     self putBackChar.
  2861.                     self stateStack top isFSAFinalState]] whileFalse.
  2862.             self stateStack size = 1
  2863.                 ifTrue: 
  2864.                     ["no smaller legal token so signal error"
  2865.                     self saveState transitionFor: self saveChar]
  2866.                 ifFalse: 
  2867.                     ["try again"
  2868.                     self scanToken]]! !
  2869.  
  2870. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2871. saveChar
  2872.  
  2873.     ^saveChar! !
  2874.  
  2875. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2876. saveChar: argument 
  2877.  
  2878.     saveChar := argument! !
  2879.  
  2880. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2881. saveState
  2882.  
  2883.     ^saveState! !
  2884.  
  2885. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2886. saveState: argument 
  2887.  
  2888.     saveState := argument! !
  2889.  
  2890. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2891. stateStack
  2892.  
  2893.     ^stateStack! !
  2894.  
  2895. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  2896. stateStack: argument 
  2897.  
  2898.     stateStack := argument! !
  2899.  
  2900. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  2901. reset
  2902.     "Reset the initial state of the scanner before scanning a new source."
  2903.  
  2904.     super reset.
  2905.     self stateStack: Stack new! !
  2906.  
  2907. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  2908. scanSource: aString 
  2909.     "Convert the input string to a read stream and scan the first token."
  2910.  
  2911.     self reset.
  2912.     self source: (RetractableReadStream on: aString).
  2913.     self nextChar: self source next.
  2914.     self checkForTokenIn: self stateStack buffer: self buffer.
  2915.     self scanToken! !
  2916.  
  2917. FSABasedLookaheadScanner subclass: #FSABasedScannerWithOneTokenLookahead
  2918.     instanceVariableNames: ''
  2919.     classVariableNames: ''
  2920.     poolDictionaries: ''
  2921.     category: 'Compilers-Scanners'!
  2922. FSABasedScannerWithOneTokenLookahead comment:
  2923. '=================================================
  2924.     Copyright (c) 1992 by Justin O. Graver.
  2925.     All rights reserved (with exceptions).
  2926.     For complete information evaluate "Object tgenCopyright."
  2927. =================================================
  2928.  
  2929. This class provides a scanner with simple one-token lookahead.  '!
  2930.  
  2931. FSABasedScannerWithOneTokenLookahead comment:
  2932. '=================================================
  2933.     Copyright (c) 1992 by Justin O. Graver.
  2934.     All rights reserved (with exceptions).
  2935.     For complete information evaluate "Object tgenCopyright."
  2936. =================================================
  2937.  
  2938. This class provides a scanner with simple one-token lookahead.  '!
  2939.  
  2940. !FSABasedScannerWithOneTokenLookahead methodsFor: 'scanner generation'!
  2941. defaultOptimizedScannerClass
  2942.  
  2943.     ^OptimizedScannerWithOneTokenLookahead! !
  2944.  
  2945. !FSABasedScannerWithOneTokenLookahead methodsFor: 'scanning'!
  2946. scanToken
  2947.     "Scan the next token and compute its token type."
  2948.  
  2949.     | nextState tok typeAction stateStack saveChar saveState |
  2950.     stateStack := Stack new.
  2951.     self atEnd
  2952.         ifTrue: [self signalEndOfInput]
  2953.         ifFalse: 
  2954.             [stateStack push: self startState.
  2955.             [(nextState := stateStack top transitionFor: self nextChar ifNone: [nil]) isNil]
  2956.                 whileFalse: 
  2957.                     [stateStack push: nextState.
  2958.                     self getNextChar].
  2959.             "save the current position for error notification"
  2960.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  2961.             stateStack top isFSAFinalState
  2962.                 ifFalse: 
  2963.                     [saveChar := self nextChar.
  2964.                     saveState := stateStack top.
  2965.                     "backup to the previous final state or to the start state"
  2966.                     [stateStack size = 1 or: [stateStack top isFSAFinalState]]
  2967.                         whileFalse: 
  2968.                             [stateStack pop.
  2969.                             self putBackChar].
  2970.                     stateStack size = 1 ifTrue: 
  2971.                         ["backed up to the start state so signal an error"
  2972.                         saveState transitionFor: saveChar]].
  2973.             "answer the newly scanned token"
  2974.             tok := self buffer contents.
  2975.             typeAction := stateStack top tokenTypeAndActionFor: tok.
  2976.             self tokenType: typeAction type.
  2977.             self token: tok.
  2978.             self buffer reset.
  2979.             typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  2980.  
  2981. FSABasedScanner subclass: #OptimizedScanner
  2982.     instanceVariableNames: 'finalStateTable '
  2983.     classVariableNames: 'NoTransitionSignal '
  2984.     poolDictionaries: ''
  2985.     category: 'Compilers-Scanners'!
  2986. OptimizedScanner comment:
  2987. '=================================================
  2988.     Copyright (c) 1992 by Justin O. Graver.
  2989.     All rights reserved (with exceptions).
  2990.     For complete information evaluate "Object tgenCopyright."
  2991. =================================================
  2992.  
  2993. I am an abstract class of scanner that scans a source string and breaks it up into tokens
  2994. using a table created by converting FSA to integer.
  2995.  
  2996. instance Variables:
  2997.     finalStateTable        - a table that maps integer ( represented as final state ) to 
  2998.                            literal tokens and token classes.
  2999. '!
  3000.  
  3001. OptimizedScanner comment:
  3002. '=================================================
  3003.     Copyright (c) 1992 by Justin O. Graver.
  3004.     All rights reserved (with exceptions).
  3005.     For complete information evaluate "Object tgenCopyright."
  3006. =================================================
  3007.  
  3008. I am an abstract class of scanner that scans a source string and breaks it up into tokens
  3009. using a table created by converting FSA to integer.
  3010.  
  3011. instance Variables:
  3012.     finalStateTable        - a table that maps integer ( represented as final state ) to 
  3013.                            literal tokens and token classes.
  3014. '!
  3015.  
  3016. !OptimizedScanner methodsFor: 'converting'!
  3017. assignNextIDAfter: id toSuccessorOf: state 
  3018.     "I try to assing a number to fsa in order to create a fsa table."
  3019.  
  3020.     | nextID nextState |
  3021.     nextID := id + 1.
  3022.     state edgeLabelMap
  3023.         associationsDo: 
  3024.             [:assoc | 
  3025.             nextState := assoc value.
  3026.             nextState stateID isNil
  3027.                 ifTrue: 
  3028.                     [nextState stateID: nextID.
  3029.                     nextState isFSAFinalState ifTrue: [(finalStateTable includes: nextState)
  3030.                             ifFalse: [finalStateTable at: nextID put: nextState]].
  3031.                     nextID := self assignNextIDAfter: nextID toSuccessorOf: nextState]].
  3032.     ^nextID! !
  3033.  
  3034. !OptimizedScanner methodsFor: 'converting'!
  3035. changeFSAToObjectTable: fsaState 
  3036.  
  3037.     | sizePlusOne objectTable  |
  3038.     fsaState stateID notNil ifTrue: [fsaState nilOutStateIDs].
  3039.     fsaState stateID:  self startState.
  3040.     self finalStateTable: Dictionary new.
  3041.     sizePlusOne := self assignNextIDAfter: self startState toSuccessorOf: fsaState.
  3042.     objectTable := Array new: sizePlusOne - 1.
  3043.     self convert: fsaState to: objectTable.
  3044.     self modifyFSAFinalStates: sizePlusOne - 1.        "convert Dictionary to Array for speed"
  3045.     ^objectTable! !
  3046.  
  3047. !OptimizedScanner methodsFor: 'converting'!
  3048. convert: state to: objectTable 
  3049.     "I try to create a table that maps state ( represented by integer ) to state"
  3050.  
  3051.     | arr nextState |
  3052.     arr := Array new: 127.
  3053.     objectTable at: state stateID put: arr.
  3054.     state edgeLabelMap
  3055.         associationsDo: 
  3056.             [:assoc | 
  3057.             nextState := assoc value.
  3058.             (objectTable at: nextState stateID) isNil ifTrue: [self convert: nextState to: objectTable].
  3059.             arr at: assoc key asInteger put: nextState stateID].
  3060.     ^objectTable! !
  3061.  
  3062. !OptimizedScanner methodsFor: 'converting'!
  3063. convertToTable: fsaScanner 
  3064.  
  3065.     self fsa: (self changeFSAToObjectTable: fsaScanner fsa)! !
  3066.  
  3067. !OptimizedScanner methodsFor: 'converting'!
  3068. modifyFSAFinalStates: index 
  3069.     "Convert Dictionary and its values to Array of Array"
  3070.  
  3071.     | tokenSet table |
  3072.     table := Array new: index.
  3073.     finalStateTable do: 
  3074.         [:st | 
  3075.         tokenSet := Array new: 2.
  3076.         tokenSet at: 1 put: st literalTokens asOrderedCollection asArray; at: 2 put: st tokenClasses asArray.
  3077.         table at: st stateID put: tokenSet].
  3078.     self finalStateTable: table! !
  3079.  
  3080. !OptimizedScanner methodsFor: 'private'!
  3081. at: state transitionFor: char 
  3082.  
  3083.     | value |
  3084.     (value := (fsa at: state)
  3085.                 at: char asInteger) isNil ifTrue: [(finalStateTable at: state) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (char == self endOfInputToken
  3086.                     ifTrue: [self endOfInputErrorString]
  3087.                     ifFalse: [self standardErrorString , '''' , char printString , ''''])]].
  3088.     ^value! !
  3089.  
  3090. !OptimizedScanner methodsFor: 'initialization'!
  3091. init
  3092.  
  3093.     super init.
  3094.     self finalStateTable: self myFinalStateTable! !
  3095.  
  3096. !OptimizedScanner methodsFor: 'state accessing'!
  3097. finalStateTable
  3098.  
  3099.     ^finalStateTable! !
  3100.  
  3101. !OptimizedScanner methodsFor: 'state accessing'!
  3102. finalStateTable: arg 
  3103.  
  3104.     finalStateTable := arg! !
  3105.  
  3106. !OptimizedScanner methodsFor: 'accessing'!
  3107. myFinalStateTable
  3108.  
  3109.     ^self class finalStateTable! !
  3110.  
  3111. !OptimizedScanner methodsFor: 'accessing'!
  3112. startState
  3113.  
  3114.     ^1! !
  3115.  
  3116. !OptimizedScanner methodsFor: 'exception handling'!
  3117. endOfInputErrorString
  3118.  
  3119.     ^'end of input encountered'! !
  3120.  
  3121. !OptimizedScanner methodsFor: 'exception handling'!
  3122. raiseNoTransitionExceptionErrorString: aString 
  3123.  
  3124.     self class noTransitionSignal raiseErrorString: aString! !
  3125.  
  3126. !OptimizedScanner methodsFor: 'exception handling'!
  3127. standardErrorString
  3128.  
  3129.     ^'illegal character encountered:  '! !
  3130.  
  3131. !OptimizedScanner methodsFor: 'testing'!
  3132. atEnd
  3133.  
  3134.     ^nextChar == self endOfInputToken        "end-of-file character"! !
  3135.  
  3136. !OptimizedScanner methodsFor: 'reconstructing'!
  3137. reconstructFinalStateTableOn: aStream 
  3138.  
  3139.     aStream nextPutAll: 'table := '.
  3140.     finalStateTable reconstructOn: aStream.
  3141.     aStream
  3142.         period;
  3143.         crtab;
  3144.         nextPutAll: 'self constructFinalStateTable: table'! !
  3145.  
  3146. !OptimizedScanner methodsFor: 'reconstructing'!
  3147. reconstructFSAOn: aStream 
  3148.  
  3149.     aStream nextPutAll: 'self fsa: '.
  3150.     fsa reconstructOn: aStream.
  3151.     aStream period; crtab! !
  3152.  
  3153. !OptimizedScanner methodsFor: 'reconstructing'!
  3154. reconstructOn: aStream 
  3155.     "Recreate fsa and final state tables"
  3156.  
  3157.     self reconstructFSAOn: aStream.
  3158.     self reconstructFinalStateTableOn: aStream! !
  3159.  
  3160. !OptimizedScanner methodsFor: 'scanner generation'!
  3161. classInitializationMethodTextForClassNamed: name spec: tokenSpec 
  3162.     | ws |
  3163.     ws := WriteStream on: (String new: 2048).
  3164.     ws
  3165.         nextPutAll: 'initialize';
  3166.         crtab;
  3167.         nextPut: $";
  3168.         nextPutAll: name;
  3169.         nextPutAll: ' initialize"';
  3170.         crtab;
  3171.         nextPut: $".
  3172.     tokenSpec do: 
  3173.         [:ch | 
  3174.         "double embedded double-quote characters"
  3175.         ws nextPut: ch.
  3176.         ch = $" ifTrue: [ws nextPut: $"]].
  3177.     ws
  3178.         nextPut: $";
  3179.         cr;
  3180.         crtab;
  3181.         nextPutAll: '| table |';
  3182.         crtab.
  3183.     self reconstructOn: ws.
  3184.     ^ws contents! !
  3185.  
  3186. !OptimizedScanner methodsFor: 'scanning'!
  3187. at: state tokenTypeAndActionFor: aString 
  3188.     "The current implementation does not handle overlapping token classes. Hence, a final state 
  3189.     can only represent a literal or a single token class. Therefore, if not a literal then it must be 
  3190.     the token class."
  3191.  
  3192.     | tc |
  3193.     (((finalStateTable at: state)
  3194.         at: 1)
  3195.         includes: aString)
  3196.         ifTrue: [^TokenTypeActionHolder type: aString action: nil].
  3197.     tc := ((finalStateTable at: state)
  3198.                 at: 2) first .
  3199.     ^TokenTypeActionHolder type: tc tokenType action: tc action! !
  3200.  
  3201. !OptimizedScanner methodsFor: 'scanning'!
  3202. getNextChar
  3203.     "Source will answer an eof char when no more input is available. 
  3204.     Subclasses may override this to avoid unnecessary buffering."
  3205.  
  3206.     buffer nextPut: nextChar.
  3207.     nextChar := source next! !
  3208.  
  3209. !OptimizedScanner methodsFor: 'scanning'!
  3210. signalEndOfInput
  3211.     "Set scanner to the end-of-input state."
  3212.  
  3213.     tokenType := token := self endOfInputToken! !
  3214.  
  3215. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3216.  
  3217. OptimizedScanner class
  3218.     instanceVariableNames: 'finalStateTable tokenTable '!
  3219.  
  3220. !OptimizedScanner class methodsFor: 'state accessing'!
  3221. finalStateTable
  3222.  
  3223.     ^finalStateTable! !
  3224.  
  3225. !OptimizedScanner class methodsFor: 'state accessing'!
  3226. finalStateTable: arg 
  3227.  
  3228.     finalStateTable := arg! !
  3229.  
  3230. !OptimizedScanner class methodsFor: 'state accessing'!
  3231. noTransitionSignal
  3232.  
  3233.     ^NoTransitionSignal! !
  3234.  
  3235. !OptimizedScanner class methodsFor: 'state accessing'!
  3236. noTransitionSignal: arg 
  3237.  
  3238.     NoTransitionSignal := arg! !
  3239.  
  3240. !OptimizedScanner class methodsFor: 'state accessing'!
  3241. tokenTable
  3242.  
  3243.     ^tokenTable! !
  3244.  
  3245. !OptimizedScanner class methodsFor: 'state accessing'!
  3246. tokenTable: arg 
  3247.  
  3248.     tokenTable := arg! !
  3249.  
  3250. !OptimizedScanner class methodsFor: 'class initialization'!
  3251. initialize
  3252.     "OptimizedScanner initialize"
  3253.  
  3254.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol).! !
  3255.  
  3256. !OptimizedScanner class methodsFor: 'reconstructing'!
  3257. constructFinalStateTable: arg 
  3258.  
  3259.     finalStateTable := Array new: arg size.
  3260.     1 to: arg size do: [:index | finalStateTable at: index put: ((arg at: index) isNil
  3261.                 ifTrue: [nil]
  3262.                 ifFalse: [Array with: ((arg at: index)
  3263.                             at: 1)
  3264.                         with: (self constructTokenClassification: ((arg at: index)
  3265.                                     at: 2))])]! !
  3266.  
  3267. !OptimizedScanner class methodsFor: 'reconstructing'!
  3268. constructTokenClassification: aCollection 
  3269.  
  3270.     | tc ea arr |
  3271.     aCollection size == 1
  3272.         ifTrue: 
  3273.             [tc := aCollection first.
  3274.             ^Array with: (TokenClassification
  3275.                     tokenType: (tc at: 1)
  3276.                     action: (tc at: 2))]
  3277.         ifFalse: 
  3278.             [arr := Array new: aCollection size.
  3279.             1 to: aCollection size do: 
  3280.                 [:index | 
  3281.                 ea := aCollection at: index.
  3282.                 arr at: index put: (TokenClassification
  3283.                         tokenType: (ea at: 1)
  3284.                         action: (ea at: 2))].
  3285.             ^arr]! !
  3286.  
  3287. !OptimizedScanner class methodsFor: 'instance creation'!
  3288. buildFrom: fsaScanner
  3289.  
  3290.     ^self new convertToTable: fsaScanner! !
  3291.  
  3292. OptimizedScanner subclass: #OptimizedLookaheadScanner
  3293.     instanceVariableNames: 'savePosition '
  3294.     classVariableNames: ''
  3295.     poolDictionaries: ''
  3296.     category: 'Compilers-Scanners'!
  3297. OptimizedLookaheadScanner comment:
  3298. '=================================================
  3299.     Copyright (c) 1992 by Justin O. Graver.
  3300.     All rights reserved (with exceptions).
  3301.     For complete information evaluate "Object tgenCopyright."
  3302. =================================================
  3303.  
  3304. This is an abstract class for table-based optimized scanners with lookahead.
  3305.  
  3306. Instance Variables:
  3307.     savePosition <Integer> - pointer into input source for error notification.'!
  3308.  
  3309. OptimizedLookaheadScanner comment:
  3310. '=================================================
  3311.     Copyright (c) 1992 by Justin O. Graver.
  3312.     All rights reserved (with exceptions).
  3313.     For complete information evaluate "Object tgenCopyright."
  3314. =================================================
  3315.  
  3316. This is an abstract class for table-based optimized scanners with lookahead.
  3317.  
  3318. Instance Variables:
  3319.     savePosition <Integer> - pointer into input source for error notification.'!
  3320.  
  3321. !OptimizedLookaheadScanner methodsFor: 'accessing'!
  3322. errorPosition
  3323.     "Answer the source position of the last acceptable character."
  3324.  
  3325.     ^self savePosition max: 1! !
  3326.  
  3327. !OptimizedLookaheadScanner methodsFor: 'initialization'!
  3328. reset
  3329.     "Reset the initial state of the scanner before scanning a new source."
  3330.  
  3331.     super reset.
  3332.     self savePosition: 0! !
  3333.  
  3334. !OptimizedLookaheadScanner methodsFor: 'state accessing'!
  3335. savePosition
  3336.  
  3337.     ^savePosition! !
  3338.  
  3339. !OptimizedLookaheadScanner methodsFor: 'state accessing'!
  3340. savePosition: argument 
  3341.  
  3342.     savePosition := argument! !
  3343.  
  3344. !OptimizedLookaheadScanner methodsFor: 'testing'!
  3345. isFSAFinalState: aState
  3346.     "Answer true if aState is a final state, false otherwise."
  3347.  
  3348.     ^(self finalStateTable at: aState) notNil! !
  3349.  
  3350. AbstractScanner subclass: #HandCodedScanner
  3351.     instanceVariableNames: 'charTypeTable '
  3352.     classVariableNames: ''
  3353.     poolDictionaries: ''
  3354.     category: 'Compilers-Scanners'!
  3355. HandCodedScanner comment:
  3356. '=================================================
  3357.     Copyright (c) 1992 by Justin O. Graver.
  3358.     All rights reserved (with exceptions).
  3359.     For complete information evaluate "Object tgenCopyright."
  3360. =================================================
  3361.  
  3362. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a character type table and hand-coded scanner methods.  Specific type tables are stored in class instance variables of my concrete subclasses.
  3363.  
  3364. Instance Variables:
  3365.     charTypeTable    <Array of: Symbol> - a local reference to the type table for this class of scanner; the ascii value of each character is mapped to a symbol token type.
  3366. '!
  3367.  
  3368. HandCodedScanner comment:
  3369. '=================================================
  3370.     Copyright (c) 1992 by Justin O. Graver.
  3371.     All rights reserved (with exceptions).
  3372.     For complete information evaluate "Object tgenCopyright."
  3373. =================================================
  3374.  
  3375. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a character type table and hand-coded scanner methods.  Specific type tables are stored in class instance variables of my concrete subclasses.
  3376.  
  3377. Instance Variables:
  3378.     charTypeTable    <Array of: Symbol> - a local reference to the type table for this class of scanner; the ascii value of each character is mapped to a symbol token type.
  3379. '!
  3380.  
  3381. !HandCodedScanner methodsFor: 'state accessing'!
  3382. charTypeTable
  3383.  
  3384.     ^charTypeTable! !
  3385.  
  3386. !HandCodedScanner methodsFor: 'state accessing'!
  3387. charTypeTable: argument 
  3388.  
  3389.     charTypeTable := argument! !
  3390.  
  3391. !HandCodedScanner methodsFor: 'initialization'!
  3392. init
  3393.  
  3394.     super init.
  3395.     self charTypeTable: self myTypeTable! !
  3396.  
  3397. !HandCodedScanner methodsFor: 'accessing'!
  3398. endOfInputToken
  3399.     "Answer a token representing the end of the input."
  3400.  
  3401.     ^nil! !
  3402.  
  3403. !HandCodedScanner methodsFor: 'accessing'!
  3404. endOfInputTokenType
  3405.     "Answer the token type representing the end of the input."
  3406.  
  3407.     ^#doIt! !
  3408.  
  3409. !HandCodedScanner methodsFor: 'accessing'!
  3410. myTypeTable
  3411.  
  3412.     ^self class charTypeTable! !
  3413.  
  3414. !HandCodedScanner methodsFor: 'testing'!
  3415. atStartOfComplexToken
  3416.     "Answer true if the first character of the tokenType is an $x and false otherwise."
  3417.  
  3418.     ^(self tokenType at: 1)
  3419.         = $x! !
  3420.  
  3421. !HandCodedScanner methodsFor: 'scanning'!
  3422. scanToken
  3423.     "Scan the next token and compute its token type.  This may be 
  3424.     overridden in subclasses for efficiency and customization."
  3425.  
  3426.     
  3427.     [self atEnd ifTrue: [^self signalEndOfInput].
  3428.     self tokenType: (self charTypeTable at: self nextChar asInteger).
  3429.     self tokenType == #xDelimiter]
  3430.         whileTrue: 
  3431.             ["Skip delimiters fast, there almost always is one."
  3432.             self getNextChar].
  3433.     self atStartOfComplexToken
  3434.         ifTrue: 
  3435.             ["perform to compute token & type"
  3436.             self perform: tokenType]
  3437.         ifFalse: 
  3438.             ["else just the character"
  3439.             self token: self nextChar.
  3440.             self getNextChar]! !
  3441.  
  3442. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3443.  
  3444. HandCodedScanner class
  3445.     instanceVariableNames: 'charTypeTable '!
  3446.  
  3447. !HandCodedScanner class methodsFor: 'class initialization'!
  3448. initialize
  3449.     "Concrete subclasses must provide a character type table."
  3450.     "HandCodedScanner initialize"
  3451.  
  3452.     | newTable |
  3453.     newTable := Array new: 256 withAll: #xDefault.        "default"
  3454.     self charTypeTable: newTable! !
  3455.  
  3456. !HandCodedScanner class methodsFor: 'state accessing'!
  3457. charTypeTable
  3458.  
  3459.     ^charTypeTable! !
  3460.  
  3461. !HandCodedScanner class methodsFor: 'state accessing'!
  3462. charTypeTable: argument 
  3463.  
  3464.     charTypeTable := argument! !
  3465.  
  3466. OptimizedLookaheadScanner subclass: #OptimizedScannerWithOneTokenLookahead
  3467.     instanceVariableNames: ''
  3468.     classVariableNames: ''
  3469.     poolDictionaries: ''
  3470.     category: 'Compilers-Scanners'!
  3471. OptimizedScannerWithOneTokenLookahead comment:
  3472. '=================================================
  3473.     Copyright (c) 1992 by Justin O. Graver.
  3474.     All rights reserved (with exceptions).
  3475.     For complete information evaluate "Object tgenCopyright."
  3476. =================================================
  3477.  
  3478. This class provides a table-based optimized scanner with simple one-token lookahead.  '!
  3479.  
  3480. OptimizedScannerWithOneTokenLookahead comment:
  3481. '=================================================
  3482.     Copyright (c) 1992 by Justin O. Graver.
  3483.     All rights reserved (with exceptions).
  3484.     For complete information evaluate "Object tgenCopyright."
  3485. =================================================
  3486.  
  3487. This class provides a table-based optimized scanner with simple one-token lookahead.  '!
  3488.  
  3489. !OptimizedScannerWithOneTokenLookahead methodsFor: 'scanning'!
  3490. scanToken
  3491.     "Scan the next token and compute its token type."
  3492.  
  3493.     | nextState tok typeAction stateStack saveChar saveState |
  3494.     stateStack := Stack new.
  3495.     self atEnd
  3496.         ifTrue: [self signalEndOfInput]
  3497.         ifFalse:
  3498.             [stateStack push: self startState.
  3499.             [(nextState := (fsa at: stateStack top) at: self nextChar asInteger) isNil]
  3500.                 whileFalse:
  3501.                     [stateStack push: nextState.
  3502.                     self getNextChar].
  3503.             "save the current position for error notification"
  3504.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  3505.             (self isFSAFinalState: stateStack top)
  3506.                 ifFalse:
  3507.                     ["save the current position for error notification"
  3508.                     saveChar := self nextChar.
  3509.                     saveState := stateStack top.
  3510.                     "backup to the previous final state or to the start state"
  3511.                     [stateStack size = 1 or: [self isFSAFinalState: stateStack top]]
  3512.                         whileFalse:
  3513.                             [stateStack pop.
  3514.                             self putBackChar].
  3515.                     stateStack size = 1
  3516.                         ifTrue:
  3517.                         ["backed up to the start state so signal an error"
  3518.                         self at: saveState transitionFor: saveChar]].
  3519.         "answer the newly scanned token"
  3520.         tok := self buffer contents.
  3521.         typeAction := self at: stateStack top tokenTypeAndActionFor: tok.
  3522.         self tokenType: typeAction type.
  3523.         self token: tok.
  3524.         self buffer reset.
  3525.         typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  3526.  
  3527. OptimizedLookaheadScanner subclass: #OptimizedScannerWithTwoTokenLookahead
  3528.     instanceVariableNames: 'stateStack saveState saveChar '
  3529.     classVariableNames: ''
  3530.     poolDictionaries: ''
  3531.     category: 'Compilers-Scanners'!
  3532. OptimizedScannerWithTwoTokenLookahead comment:
  3533. '=================================================
  3534.     Copyright (c) 1992 by Justin O. Graver.
  3535.     All rights reserved (with exceptions).
  3536.     For complete information evaluate "Object tgenCopyright."
  3537. =================================================
  3538.  
  3539. This class provides a table-based optimized scanner with simple two-token lookahead.
  3540.  
  3541. Instance Variables:
  3542.     stateStack    <Stack> - primary state stack for scanning tokens.
  3543.     saveState    <Integer> - pointer into input source for error notification.
  3544.     saveChar    <Character> - pointer into input source for error notification.'!
  3545.  
  3546. OptimizedScannerWithTwoTokenLookahead comment:
  3547. '=================================================
  3548.     Copyright (c) 1992 by Justin O. Graver.
  3549.     All rights reserved (with exceptions).
  3550.     For complete information evaluate "Object tgenCopyright."
  3551. =================================================
  3552.  
  3553. This class provides a table-based optimized scanner with simple two-token lookahead.
  3554.  
  3555. Instance Variables:
  3556.     stateStack    <Stack> - primary state stack for scanning tokens.
  3557.     saveState    <Integer> - pointer into input source for error notification.
  3558.     saveChar    <Character> - pointer into input source for error notification.'!
  3559.  
  3560. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  3561. checkForTokenIn: newStateStack buffer: charBuffer 
  3562.     "Scan the input using the arguments. Answer true if a legal token (or no illegal token) was 
  3563.     found and false otherwise."
  3564.  
  3565.     | nextState |
  3566.     self atEnd
  3567.         ifFalse: 
  3568.             [newStateStack push: self startState.
  3569.             "look for longest possible token"
  3570.             [(nextState := (fsa at: newStateStack top) at: self nextChar asInteger) isNil]
  3571.                 whileFalse: 
  3572.                     [newStateStack push: nextState.
  3573.                     "getNextChar for local vars"
  3574.                     charBuffer nextPut: self nextChar.
  3575.                     self nextChar: self source next].
  3576.             "save the current position for error notification"
  3577.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  3578.             (self isFSAFinalState: newStateStack top)
  3579.                 ifFalse: 
  3580.                     ["save the current position for error notification"
  3581.                     saveChar := self nextChar.
  3582.                     saveState := newStateStack top.
  3583.                     "backup to the previous final state or to the start state"
  3584.                     [newStateStack size = 1 or: [self isFSAFinalState: newStateStack top]]
  3585.                         whileFalse: 
  3586.                             [newStateStack pop.
  3587.                             "putBackChar for local vars"
  3588.                             charBuffer backspace.
  3589.                             self backspaceSource].
  3590.                     newStateStack size = 1 ifTrue: 
  3591.                         ["backed up to the start state"
  3592.                         self stateStack == newStateStack
  3593.                             ifTrue: 
  3594.                                 ["this is the first token, so signal an error (abort and return)"
  3595.                                 self at: saveState transitionFor: saveChar]
  3596.                             ifFalse: 
  3597.                                 ["we may be able to backup in the previous token"
  3598.                                 ^false]]]].
  3599.     ^true! !
  3600.  
  3601. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  3602. scanToken
  3603.     "Scan the next token and compute its token type."
  3604.  
  3605.     | tok typeAction newStateStack charBuffer |
  3606.     newStateStack := Stack new.
  3607.     charBuffer := RetractableWriteStream on: (String new: 32).
  3608.     (self checkForTokenIn: newStateStack buffer: charBuffer)
  3609.         ifTrue: 
  3610.             ["either a legal token or the end on input was found"
  3611.             self stateStack isEmpty ifTrue: [self atEnd
  3612.                     ifTrue: [^self signalEndOfInput]
  3613.                     ifFalse: [self error: 'no more vaild tokens']].
  3614.             tok := self buffer contents.
  3615.             typeAction := self at: stateStack top tokenTypeAndActionFor: tok.
  3616.             self tokenType: typeAction type.
  3617.             self token: tok.
  3618.             self buffer: charBuffer.
  3619.             self stateStack: newStateStack.
  3620.             typeAction action notNil ifTrue: [self perform: typeAction action]]
  3621.         ifFalse: 
  3622.             ["an illegal token was found, try to look for earlier final state in current token buffers"
  3623.             charBuffer size timesRepeat: 
  3624.                 ["put back illegal token chars"
  3625.                 self backspaceSource].
  3626.             "backup in current token to next smallest legal token"
  3627.             [self stateStack size = 1
  3628.                 or: 
  3629.                     [self stateStack pop.
  3630.                     self putBackChar.
  3631.                     self isFSAFinalState: stateStack top]] whileFalse.
  3632.             self stateStack size = 1
  3633.                 ifTrue: 
  3634.                     ["no smaller legal token so signal error"
  3635.                     self at: saveState transitionFor: saveChar]
  3636.                 ifFalse: 
  3637.                     ["try again"
  3638.                     self scanToken]]! !
  3639.  
  3640. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  3641. reset
  3642.     "Reset the initial state of the scanner before scanning a new source."
  3643.  
  3644.     super reset.
  3645.     self stateStack: Stack new! !
  3646.  
  3647. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  3648. scanSource: aString 
  3649.     "Convert the input string to a read stream and scan the first token."
  3650.  
  3651.     self reset.
  3652.     self source: (RetractableReadStream on: aString).
  3653.     self nextChar: self source next.
  3654.     self checkForTokenIn: self stateStack buffer: self buffer.
  3655.     self scanToken! !
  3656.  
  3657. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3658. saveChar
  3659.  
  3660.     ^saveChar! !
  3661.  
  3662. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3663. saveChar: argument 
  3664.  
  3665.     saveChar := argument! !
  3666.  
  3667. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3668. saveState
  3669.  
  3670.     ^saveState! !
  3671.  
  3672. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3673. saveState: argument 
  3674.  
  3675.     saveState := argument! !
  3676.  
  3677. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3678. stateStack
  3679.  
  3680.     ^stateStack! !
  3681.  
  3682. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  3683. stateStack: argument 
  3684.  
  3685.     stateStack := argument! !
  3686.  
  3687. FSABasedScanner initialize!
  3688.  
  3689. HandCodedScanner initialize!
  3690.  
  3691. OptimizedScanner initialize!
  3692.  
  3693. OrderedCollection variableSubclass: #OrderedChildren
  3694.     instanceVariableNames: ''
  3695.     classVariableNames: ''
  3696.     poolDictionaries: ''
  3697.     category: 'T-gen-Parse Trees'!
  3698. OrderedChildren comment:
  3699. '=================================================
  3700.     Copyright (c) 1992 by Justin O. Graver.
  3701.     All rights reserved (with exceptions).
  3702.     For complete information evaluate "Object tgenCopyright."
  3703. =================================================
  3704.  
  3705. It is often helpful to create a node that has a arbitrary (but flat) collection of nodes as a child.  My instances provide containers for these "collection children".  In other words, I am a collection that acts like a single parse tree node.'!
  3706.  
  3707. OrderedChildren comment:
  3708. '=================================================
  3709.     Copyright (c) 1992 by Justin O. Graver.
  3710.     All rights reserved (with exceptions).
  3711.     For complete information evaluate "Object tgenCopyright."
  3712. =================================================
  3713.  
  3714. It is often helpful to create a node that has a arbitrary (but flat) collection of nodes as a child.  My instances provide containers for these "collection children".  In other words, I am a collection that acts like a single parse tree node.'!
  3715.  
  3716. !OrderedChildren methodsFor: 'building parse trees'!
  3717. addChildrenFirst: anOrderedCollection 
  3718.  
  3719.     self addAllFirst: anOrderedCollection! !
  3720.  
  3721. !OrderedChildren methodsFor: 'building parse trees'!
  3722. addChildrenInitial: anOrderedCollection 
  3723.  
  3724.     self addAll: anOrderedCollection! !
  3725.  
  3726. !OrderedChildren methodsFor: 'building parse trees'!
  3727. addChildrenLast: anOrderedCollection 
  3728.  
  3729.     self addAllLast: anOrderedCollection! !
  3730.  
  3731. !OrderedChildren methodsFor: 'building parse trees'!
  3732. setAttribute: value 
  3733.  
  3734.     self shouldNotImplement! !
  3735.  
  3736. Object subclass: #ParseTreeBuilder
  3737.     instanceVariableNames: 'stack '
  3738.     classVariableNames: ''
  3739.     poolDictionaries: ''
  3740.     category: 'T-gen-Parse Trees'!
  3741. ParseTreeBuilder comment:
  3742. '=================================================
  3743.     Copyright (c) 1992 by Justin O. Graver.
  3744.     All rights reserved (with exceptions).
  3745.     For complete information evaluate "Object tgenCopyright."
  3746. =================================================
  3747.  
  3748. This is an abstract class that provides a framework for building parse trees during parsing.  Parse trees are built in a bottom-up fashion during parsing by processing key productions, and with the help of a stack.  In general, a key production has the form:
  3749.  
  3750.     A -> N1 N2 ... Nk => symbol
  3751.  
  3752. where A and the Ni are nonterminals (terminals may be interspersed freely in the right-hand side) and symbol is the production directive (or translation symbol).  Since trees are built bottom-up, the information flow in a production is from the right-hand side to the left-hand side.  When a production is ready to be processed, the top of the stack contains objects (parse trees) associated with the right-hand-side nonterminals of the production.  Processing a production involves replacing these objects with a single object representing (associated with) the left-hand-side nonterminal.  This can be thought of as computing a value for A as a function of the values of the Ni''s, i.e. value(A) = fcn(value(N1), value(N2), ..., value(Nk)).  Default functions are defined in my concrete subclasses but users may define their own production processing functions by creating a new subclass and implementing appropriate messages.  This enables users to have direct control over exactly how parse trees are built. 
  3753.  
  3754. Instance Variables:
  3755.     stack    <Stack> - holds intermediate node values during production processing.'!
  3756.  
  3757. ParseTreeBuilder comment:
  3758. '=================================================
  3759.     Copyright (c) 1992 by Justin O. Graver.
  3760.     All rights reserved (with exceptions).
  3761.     For complete information evaluate "Object tgenCopyright."
  3762. =================================================
  3763.  
  3764. This is an abstract class that provides a framework for building parse trees during parsing.  Parse trees are built in a bottom-up fashion during parsing by processing key productions, and with the help of a stack.  In general, a key production has the form:
  3765.  
  3766.     A -> N1 N2 ... Nk => symbol
  3767.  
  3768. where A and the Ni are nonterminals (terminals may be interspersed freely in the right-hand side) and symbol is the production directive (or translation symbol).  Since trees are built bottom-up, the information flow in a production is from the right-hand side to the left-hand side.  When a production is ready to be processed, the top of the stack contains objects (parse trees) associated with the right-hand-side nonterminals of the production.  Processing a production involves replacing these objects with a single object representing (associated with) the left-hand-side nonterminal.  This can be thought of as computing a value for A as a function of the values of the Ni''s, i.e. value(A) = fcn(value(N1), value(N2), ..., value(Nk)).  Default functions are defined in my concrete subclasses but users may define their own production processing functions by creating a new subclass and implementing appropriate messages.  This enables users to have direct control over exactly how parse trees are built. 
  3769.  
  3770. Instance Variables:
  3771.     stack    <Stack> - holds intermediate node values during production processing.'!
  3772.  
  3773. !ParseTreeBuilder methodsFor: 'initialization'!
  3774. init
  3775.  
  3776.     self stack: Stack new! !
  3777.  
  3778. !ParseTreeBuilder methodsFor: 'state accessing'!
  3779. stack
  3780.  
  3781.     ^stack! !
  3782.  
  3783. !ParseTreeBuilder methodsFor: 'state accessing'!
  3784. stack: argument 
  3785.  
  3786.     stack := argument! !
  3787.  
  3788. !ParseTreeBuilder methodsFor: 'accessing'!
  3789. popStack
  3790.  
  3791.     ^self stack pop! !
  3792.  
  3793. !ParseTreeBuilder methodsFor: 'accessing'!
  3794. pushStack: anObject 
  3795.  
  3796.     ^self stack push: anObject! !
  3797.  
  3798. !ParseTreeBuilder methodsFor: 'accessing'!
  3799. result
  3800.     "Answer the root of the tree build by this tree builder."
  3801.  
  3802.     self stack size = 1 ifFalse: [self error: 'incorrectly built tree'].
  3803.     ^self popStack! !
  3804.  
  3805. !ParseTreeBuilder methodsFor: 'production processing'!
  3806. addChildrenFirst: children to: aNode 
  3807.     "Add children, as the new first children, to aNode and answer aNode."
  3808.  
  3809.     aNode addChildrenFirst: children.
  3810.     ^aNode! !
  3811.  
  3812. !ParseTreeBuilder methodsFor: 'production processing'!
  3813. addChildrenLast: children to: aNode 
  3814.     "Add children, as the new last children, to aNode and answer aNode."
  3815.  
  3816.     aNode addChildrenLast: children.
  3817.     ^aNode! !
  3818.  
  3819. !ParseTreeBuilder methodsFor: 'production processing'!
  3820. answerArgument: arg 
  3821.  
  3822.     ^arg! !
  3823.  
  3824. !ParseTreeBuilder methodsFor: 'production processing'!
  3825. answerNil
  3826.  
  3827.     ^nil! !
  3828.  
  3829. !ParseTreeBuilder methodsFor: 'production processing'!
  3830. makeNewNode: stringOrSymbol 
  3831.     "Answer a new parse tree node representing the argument."
  3832.  
  3833.     self subclassResponsibility! !
  3834.  
  3835. !ParseTreeBuilder methodsFor: 'production processing'!
  3836. makeNewNode: stringOrSymbol withAttribute: value 
  3837.     "Answer a new parse tree node and initialize its attribute value using the 
  3838.     setAttribute: message."
  3839.  
  3840.     | newNode |
  3841.     newNode := self makeNewNode: stringOrSymbol.
  3842.     newNode setAttribute: value.
  3843.     ^newNode! !
  3844.  
  3845. !ParseTreeBuilder methodsFor: 'production processing'!
  3846. makeNewNode: stringOrSymbol withChildren: children 
  3847.     "Answer a new parse tree node and initialize its children using the 
  3848.     addChildrenInitial: message."
  3849.  
  3850.     | newNode |
  3851.     newNode := self makeNewNode: stringOrSymbol.
  3852.     newNode addChildrenInitial: children.
  3853.     ^newNode! !
  3854.  
  3855. !ParseTreeBuilder methodsFor: 'tree building'!
  3856. popArgNodesForProduction: grammarProd fromParser: parser 
  3857.     "Answer a collection of nodes from my stack required for processing 
  3858.     grammarProd. The order for collecting nodes is parser dependent."
  3859.  
  3860.     | nodes |
  3861.     nodes := OrderedCollection new.
  3862.     grammarProd numberOfRhsNonterminals timesRepeat: (parser performsLeftmostDerivation
  3863.             ifTrue: [[nodes add: self popStack]]
  3864.             ifFalse: [[nodes addFirst: self popStack]]).
  3865.     ^nodes! !
  3866.  
  3867. !ParseTreeBuilder methodsFor: 'tree building'!
  3868. processProduction: grammarProd forParser: parser 
  3869.     "This is the main driver for production processing. The actual production 
  3870.     processing messages are sent indirectly by grammarProd."
  3871.  
  3872.     self pushStack: (grammarProd hasSingleTokenClassRhs
  3873.             ifTrue: [grammarProd computeResultNodeFor: self withTokenClassValue: parser prevToken]
  3874.             ifFalse: [grammarProd computeResultNodeFor: self withArgNodes: (self popArgNodesForProduction: grammarProd fromParser: parser)])! !
  3875.  
  3876. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3877.  
  3878. ParseTreeBuilder class
  3879.     instanceVariableNames: ''!
  3880.  
  3881. !ParseTreeBuilder class methodsFor: 'instance creation'!
  3882. new
  3883.  
  3884.     ^super new init! !
  3885.  
  3886. ParseTreeBuilder subclass: #AbstractSyntaxTreeBuilder
  3887.     instanceVariableNames: 'shamMode '
  3888.     classVariableNames: ''
  3889.     poolDictionaries: ''
  3890.     category: 'T-gen-Parse Trees'!
  3891. AbstractSyntaxTreeBuilder comment:
  3892. '=================================================
  3893.     Copyright (c) 1992 by Justin O. Graver.
  3894.     All rights reserved (with exceptions).
  3895.     For complete information evaluate "Object tgenCopyright."
  3896. =================================================
  3897.  
  3898. I build parse trees by creating specific objects for each kind of node as indicated by the parser directives in grammar productions.  Parser directives currently fall into one of three groups: node (class) names, special directives, and arbitrary message selectors. For a node name, a new instance of the specified node is created and given the values associated with the right-hand side nonterminals, if any, as its children. The special directive ''nil'' simply returns nil. The directive liftRightChild adds any nodes preceeding the right-most node as children to the right-most node, and returns the right-most node. The directive liftLeftChild works in an analogous fashion. Arbitrary message selectors must take the same number of arguments as there are right-hand-side nodes and are invoked as a builder message, thus allowing users to define their own tree-building messages.
  3899.  
  3900. Productions of the form ''A -> <tc> => symbol'' are treated specially. The symbol can be either a node name or a one-argument message selector. If it is a node name then create a new instance of that node with the specified attribute value. If it is a message selector then invoke the corresponding operation on the builder with the specified value.
  3901.  
  3902. Instance Variables:
  3903.     shamMode    <Boolean> - If true DerivationTreeNode-based ASTs are built, otherwise specific ParseTreeNode-based ASTs are built.'!
  3904.  
  3905. AbstractSyntaxTreeBuilder comment:
  3906. '=================================================
  3907.     Copyright (c) 1992 by Justin O. Graver.
  3908.     All rights reserved (with exceptions).
  3909.     For complete information evaluate "Object tgenCopyright."
  3910. =================================================
  3911.  
  3912. I build parse trees by creating specific objects for each kind of node as indicated by the parser directives in grammar productions.  Parser directives currently fall into one of three groups: node (class) names, special directives, and arbitrary message selectors. For a node name, a new instance of the specified node is created and given the values associated with the right-hand side nonterminals, if any, as its children. The special directive ''nil'' simply returns nil. The directive liftRightChild adds any nodes preceeding the right-most node as children to the right-most node, and returns the right-most node. The directive liftLeftChild works in an analogous fashion. Arbitrary message selectors must take the same number of arguments as there are right-hand-side nodes and are invoked as a builder message, thus allowing users to define their own tree-building messages.
  3913.  
  3914. Productions of the form ''A -> <tc> => symbol'' are treated specially. The symbol can be either a node name or a one-argument message selector. If it is a node name then create a new instance of that node with the specified attribute value. If it is a message selector then invoke the corresponding operation on the builder with the specified value.
  3915.  
  3916. Instance Variables:
  3917.     shamMode    <Boolean> - If true DerivationTreeNode-based ASTs are built, otherwise specific ParseTreeNode-based ASTs are built.'!
  3918.  
  3919. !AbstractSyntaxTreeBuilder methodsFor: 'tree building'!
  3920. makeNewNode: stringOrSymbol 
  3921.     "The argument represents the name of a node class. If in sham mode answer a 
  3922.     new derivation tree node for the argument, otherwise answer a new instance of 
  3923.     that class."
  3924.  
  3925.     ^self shamMode
  3926.         ifTrue: [DerivationTreeNode symbol: stringOrSymbol]
  3927.         ifFalse: [(Smalltalk at: stringOrSymbol asSymbol ifAbsent: [self error: 'no class named ' , stringOrSymbol]) new]! !
  3928.  
  3929. !AbstractSyntaxTreeBuilder methodsFor: 'accessing'!
  3930. setNormalMode
  3931.  
  3932.     self shamMode: false! !
  3933.  
  3934. !AbstractSyntaxTreeBuilder methodsFor: 'accessing'!
  3935. setShamMode
  3936.  
  3937.     self shamMode: true! !
  3938.  
  3939. !AbstractSyntaxTreeBuilder methodsFor: 'state accessing'!
  3940. shamMode
  3941.  
  3942.     ^shamMode! !
  3943.  
  3944. !AbstractSyntaxTreeBuilder methodsFor: 'state accessing'!
  3945. shamMode: argument 
  3946.  
  3947.     shamMode := argument! !
  3948.  
  3949. !AbstractSyntaxTreeBuilder methodsFor: 'initialization'!
  3950. init
  3951.  
  3952.     super init.
  3953.     self setNormalMode! !
  3954.  
  3955. !AbstractSyntaxTreeBuilder methodsFor: 'initialization'!
  3956. reset
  3957.     "Empty the node stack and set to normal mode."
  3958.  
  3959.     self init! !
  3960.  
  3961. ParseTreeBuilder subclass: #DerivationTreeBuilder
  3962.     instanceVariableNames: ''
  3963.     classVariableNames: ''
  3964.     poolDictionaries: ''
  3965.     category: 'T-gen-Parse Trees'!
  3966. DerivationTreeBuilder comment:
  3967. '=================================================
  3968.     Copyright (c) 1992 by Justin O. Graver.
  3969.     All rights reserved (with exceptions).
  3970.     For complete information evaluate "Object tgenCopyright."
  3971. =================================================
  3972.  
  3973. This concrete class is used for building derivation trees for a parse.  It uses homogeneous DerivationTreeNodes for all nodes and a specialized production processor.'!
  3974.  
  3975. DerivationTreeBuilder comment:
  3976. '=================================================
  3977.     Copyright (c) 1992 by Justin O. Graver.
  3978.     All rights reserved (with exceptions).
  3979.     For complete information evaluate "Object tgenCopyright."
  3980. =================================================
  3981.  
  3982. This concrete class is used for building derivation trees for a parse.  It uses homogeneous DerivationTreeNodes for all nodes and a specialized production processor.'!
  3983.  
  3984. !DerivationTreeBuilder methodsFor: 'tree building'!
  3985. epsilon
  3986.     "Answer an object used to represent the empty string (epsilon)."
  3987.  
  3988.     ^'<epsilon>'! !
  3989.  
  3990. !DerivationTreeBuilder methodsFor: 'tree building'!
  3991. processProduction: grammarProd forParser: parser 
  3992.     "This is simple and straightforward to implement, so do it all here."
  3993.  
  3994.     | parent child |
  3995.     parent := DerivationTreeNode symbol: grammarProd leftHandSide.
  3996.     grammarProd rightHandSide isEmpty
  3997.         ifTrue: 
  3998.             [child := DerivationTreeNode symbol: self epsilon.
  3999.             parent addChild: child]
  4000.         ifFalse: [parser performsLeftmostDerivation
  4001.                 ifTrue: [grammarProd rightHandSide do: 
  4002.                         [:sym | 
  4003.                         child := sym isTerminal
  4004.                                     ifTrue: [DerivationTreeNode symbol: sym]
  4005.                                     ifFalse: [self popStack].
  4006.                         parent addChild: child]]
  4007.                 ifFalse: [grammarProd rightHandSide
  4008.                         reverseDo: 
  4009.                             [:sym | 
  4010.                             child := sym isTerminal
  4011.                                         ifTrue: [DerivationTreeNode symbol: sym]
  4012.                                         ifFalse: [self popStack].
  4013.                             parent addFirstChild: child]]].
  4014.     self pushStack: parent! !
  4015.  
  4016. TreeNode subclass: #ParseTreeNode
  4017.     instanceVariableNames: ''
  4018.     classVariableNames: ''
  4019.     poolDictionaries: ''
  4020.     category: 'T-gen-Parse Trees'!
  4021. ParseTreeNode comment:
  4022. '=================================================
  4023.     Copyright (c) 1992 by Justin O. Graver.
  4024.     All rights reserved (with exceptions).
  4025.     For complete information evaluate "Object tgenCopyright."
  4026. =================================================
  4027.  
  4028. I am an abstract class that provides the framework for parse tree nodes, basically just a reminder that the following messages may need to be implemented by concrete subclasses:
  4029.  
  4030.     addChildrenFirst:
  4031.     addChildrenInitial:
  4032.     addChildrenLast:
  4033.     setAttribute:'!
  4034.  
  4035. ParseTreeNode comment:
  4036. '=================================================
  4037.     Copyright (c) 1992 by Justin O. Graver.
  4038.     All rights reserved (with exceptions).
  4039.     For complete information evaluate "Object tgenCopyright."
  4040. =================================================
  4041.  
  4042. I am an abstract class that provides the framework for parse tree nodes, basically just a reminder that the following messages may need to be implemented by concrete subclasses:
  4043.  
  4044.     addChildrenFirst:
  4045.     addChildrenInitial:
  4046.     addChildrenLast:
  4047.     setAttribute:'!
  4048.  
  4049. !ParseTreeNode methodsFor: 'building parse trees'!
  4050. addChildrenFirst: anOrderedCollection 
  4051.     "Subclasses should implement this message."
  4052.  
  4053.     self shouldNotImplement! !
  4054.  
  4055. !ParseTreeNode methodsFor: 'building parse trees'!
  4056. addChildrenInitial: anOrderedCollection 
  4057.     "Subclasses should implement this message."
  4058.  
  4059.     self shouldNotImplement! !
  4060.  
  4061. !ParseTreeNode methodsFor: 'building parse trees'!
  4062. addChildrenLast: anOrderedCollection 
  4063.     "Subclasses should implement this message."
  4064.  
  4065.     self shouldNotImplement! !
  4066.  
  4067. !ParseTreeNode methodsFor: 'building parse trees'!
  4068. setAttribute: value 
  4069.     "Subclasses should implement this message."
  4070.  
  4071.     self shouldNotImplement! !
  4072.  
  4073. ParseTreeNode subclass: #DerivationTreeNode
  4074.     instanceVariableNames: 'symbol children '
  4075.     classVariableNames: ''
  4076.     poolDictionaries: ''
  4077.     category: 'T-gen-Parse Trees'!
  4078. DerivationTreeNode comment:
  4079. '=================================================
  4080.     Copyright (c) 1992 by Justin O. Graver.
  4081.     All rights reserved (with exceptions).
  4082.     For complete information evaluate "Object tgenCopyright."
  4083. =================================================
  4084.  
  4085. I represent an arbitrary node in a derivation or abstract tree.  (It would be nice to expand this concept so that heterogeneous parse trees could be built.)
  4086.  
  4087. Instance Variables:
  4088.     symbol    <String> - node attribute.
  4089.     children    <OrderedCollection of: DerivationTreeNode>'!
  4090.  
  4091. DerivationTreeNode comment:
  4092. '=================================================
  4093.     Copyright (c) 1992 by Justin O. Graver.
  4094.     All rights reserved (with exceptions).
  4095.     For complete information evaluate "Object tgenCopyright."
  4096. =================================================
  4097.  
  4098. I represent an arbitrary node in a derivation or abstract tree.  (It would be nice to expand this concept so that heterogeneous parse trees could be built.)
  4099.  
  4100. Instance Variables:
  4101.     symbol    <String> - node attribute.
  4102.     children    <OrderedCollection of: DerivationTreeNode>'!
  4103.  
  4104. !DerivationTreeNode methodsFor: 'state accessing'!
  4105. children
  4106.  
  4107.     ^children! !
  4108.  
  4109. !DerivationTreeNode methodsFor: 'state accessing'!
  4110. children: argument 
  4111.  
  4112.     children := argument! !
  4113.  
  4114. !DerivationTreeNode methodsFor: 'state accessing'!
  4115. symbol
  4116.  
  4117.     ^symbol! !
  4118.  
  4119. !DerivationTreeNode methodsFor: 'state accessing'!
  4120. symbol: argument 
  4121.  
  4122.     symbol := argument! !
  4123.  
  4124. !DerivationTreeNode methodsFor: 'printing'!
  4125. printOn: aStream 
  4126.  
  4127.     self printOn: aStream level: 0! !
  4128.  
  4129. !DerivationTreeNode methodsFor: 'printing'!
  4130. printOn: aStream dots: anInteger 
  4131.  
  4132.     anInteger timesRepeat: [aStream nextPutAll: ' . ']! !
  4133.  
  4134. !DerivationTreeNode methodsFor: 'printing'!
  4135. printOn: aStream level: level 
  4136.  
  4137.     self printOn: aStream dots: level.
  4138.     self symbol printOn: aStream.
  4139.     aStream cr.
  4140.     self childrenDo: [:child | child printOn: aStream level: level + 1]! !
  4141.  
  4142. !DerivationTreeNode methodsFor: 'initialization'!
  4143. init
  4144.  
  4145.     self children: OrderedCollection new! !
  4146.  
  4147. !DerivationTreeNode methodsFor: 'traversing'!
  4148. childrenDo: aBlock 
  4149.  
  4150.     self children do: aBlock! !
  4151.  
  4152. !DerivationTreeNode methodsFor: 'traversing'!
  4153. updateChildrenUsing: aBlock 
  4154.     "Replace my children according to the value of aBlock."
  4155.  
  4156.     self children: (self children collect: [:child | aBlock value: child])! !
  4157.  
  4158. !DerivationTreeNode methodsFor: 'testing'!
  4159. isNonterminal
  4160.  
  4161.     ^self symbol isNonterminal! !
  4162.  
  4163. !DerivationTreeNode methodsFor: 'testing'!
  4164. isTerminal
  4165.  
  4166.     ^self symbol isTerminal! !
  4167.  
  4168. !DerivationTreeNode methodsFor: 'manipulating children'!
  4169. addChild: aNode 
  4170.  
  4171.     self addLastChild: aNode! !
  4172.  
  4173. !DerivationTreeNode methodsFor: 'manipulating children'!
  4174. addFirstChild: aNode 
  4175.  
  4176.     self children addFirst: aNode! !
  4177.  
  4178. !DerivationTreeNode methodsFor: 'manipulating children'!
  4179. addLastChild: aNode 
  4180.  
  4181.     self children addLast: aNode! !
  4182.  
  4183. !DerivationTreeNode methodsFor: 'building parse trees'!
  4184. addChildrenFirst: anOrderedCollection 
  4185.  
  4186.     anOrderedCollection reverseDo: [:child | self addFirstChild: child]! !
  4187.  
  4188. !DerivationTreeNode methodsFor: 'building parse trees'!
  4189. addChildrenInitial: anOrderedCollection 
  4190.  
  4191.     self children: anOrderedCollection copy! !
  4192.  
  4193. !DerivationTreeNode methodsFor: 'building parse trees'!
  4194. addChildrenLast: anOrderedCollection 
  4195.  
  4196.     anOrderedCollection reverseDo: [:child | self addLastChild: child]! !
  4197.  
  4198. !DerivationTreeNode methodsFor: 'building parse trees'!
  4199. setAttribute: value 
  4200.  
  4201.     self symbol: value! !
  4202.  
  4203. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4204.  
  4205. DerivationTreeNode class
  4206.     instanceVariableNames: ''!
  4207.  
  4208. !DerivationTreeNode class methodsFor: 'instance creation'!
  4209. symbol: aSymbol 
  4210.  
  4211.     | newNode |
  4212.     newNode := self new init.
  4213.     newNode symbol: aSymbol.
  4214.     ^newNode! !
  4215.  
  4216. Object subclass: #TokenTypeActionHolder
  4217.     instanceVariableNames: 'type action '
  4218.     classVariableNames: ''
  4219.     poolDictionaries: ''
  4220.     category: 'T-gen-Scanning/Parsing'!
  4221. TokenTypeActionHolder comment:
  4222. '=================================================
  4223.     Copyright (c) 1992 by Justin O. Graver.
  4224.     All rights reserved (with exceptions).
  4225.     For complete information evaluate "Object tgenCopyright."
  4226. =================================================
  4227.  
  4228. I am used to package token type and actions together for transport between FSAFinalStates and the scanner.
  4229.  
  4230. Instance Variables:
  4231.     type        <String> - token type.
  4232.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  4233.  
  4234. TokenTypeActionHolder comment:
  4235. '=================================================
  4236.     Copyright (c) 1992 by Justin O. Graver.
  4237.     All rights reserved (with exceptions).
  4238.     For complete information evaluate "Object tgenCopyright."
  4239. =================================================
  4240.  
  4241. I am used to package token type and actions together for transport between FSAFinalStates and the scanner.
  4242.  
  4243. Instance Variables:
  4244.     type        <String> - token type.
  4245.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  4246.  
  4247. !TokenTypeActionHolder methodsFor: 'state accessing'!
  4248. action
  4249.  
  4250.     ^action! !
  4251.  
  4252. !TokenTypeActionHolder methodsFor: 'state accessing'!
  4253. action: argument 
  4254.  
  4255.     action := argument! !
  4256.  
  4257. !TokenTypeActionHolder methodsFor: 'state accessing'!
  4258. type
  4259.  
  4260.     ^type! !
  4261.  
  4262. !TokenTypeActionHolder methodsFor: 'state accessing'!
  4263. type: argument 
  4264.  
  4265.     type := argument! !
  4266.  
  4267. !TokenTypeActionHolder methodsFor: 'printing'!
  4268. printOn: aStream
  4269.  
  4270.     aStream nextPutAll: self type.
  4271.     aStream nextPutAll: ' : {'.
  4272.     aStream nextPutAll: self action.
  4273.     aStream nextPutAll: '} ;'! !
  4274.  
  4275. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4276.  
  4277. TokenTypeActionHolder class
  4278.     instanceVariableNames: ''!
  4279.  
  4280. !TokenTypeActionHolder class methodsFor: 'instance creation'!
  4281. type: arg1 action: arg2 
  4282.  
  4283.     | newMe |
  4284.     newMe := self new.
  4285.     newMe type: arg1.
  4286.     newMe action: arg2.
  4287.     ^newMe! !
  4288.  
  4289. Object variableSubclass: #GrammarProduction
  4290.     instanceVariableNames: 'leftHandSide rightHandSide '
  4291.     classVariableNames: ''
  4292.     poolDictionaries: ''
  4293.     category: 'T-gen-Scanning/Parsing'!
  4294. GrammarProduction comment:
  4295. '=================================================
  4296.     Copyright (c) 1992 by Justin O. Graver.
  4297.     All rights reserved (with exceptions).
  4298.     For complete information evaluate "Object tgenCopyright."
  4299. =================================================
  4300.  
  4301. I represent one production of a context-free grammar.  I am responsible for some parts of the first/follow set computation algorithm and for converting myself between various related representations (e.g. LR(0) items).
  4302.  
  4303. Instance Variables:
  4304.     leftHandSide        <Symbol>
  4305.     rightHandSide     <OrderedCollection of: (String + Symbol)>'!
  4306.  
  4307. GrammarProduction comment:
  4308. '=================================================
  4309.     Copyright (c) 1992 by Justin O. Graver.
  4310.     All rights reserved (with exceptions).
  4311.     For complete information evaluate "Object tgenCopyright."
  4312. =================================================
  4313.  
  4314. I represent one production of a context-free grammar.  I am responsible for some parts of the first/follow set computation algorithm and for converting myself between various related representations (e.g. LR(0) items).
  4315.  
  4316. Instance Variables:
  4317.     leftHandSide        <Symbol>
  4318.     rightHandSide     <OrderedCollection of: (String + Symbol)>'!
  4319.  
  4320. !GrammarProduction methodsFor: 'state accessing'!
  4321. leftHandSide
  4322.  
  4323.     ^leftHandSide! !
  4324.  
  4325. !GrammarProduction methodsFor: 'state accessing'!
  4326. leftHandSide: argument 
  4327.  
  4328.     leftHandSide := argument! !
  4329.  
  4330. !GrammarProduction methodsFor: 'state accessing'!
  4331. rightHandSide
  4332.  
  4333.     ^rightHandSide! !
  4334.  
  4335. !GrammarProduction methodsFor: 'state accessing'!
  4336. rightHandSide: argument 
  4337.  
  4338.     rightHandSide := argument! !
  4339.  
  4340. !GrammarProduction methodsFor: 'copying'!
  4341. postCopy
  4342.  
  4343.     super postCopy.
  4344.     self rightHandSide: self rightHandSide copy.
  4345.     ^self! !
  4346.  
  4347. !GrammarProduction methodsFor: 'parse tree building'!
  4348. computeResultNodeFor: builder withArgNodes: nodes 
  4349.     "Productions without translation symbols can only pass on a single argument 
  4350.     node."
  4351.  
  4352.     nodes size = 1 ifFalse: [self error: 'Productions without translation symbols can only
  4353. pass on results from a single right-hand side nonterminal'].
  4354.     ^builder answerArgument: nodes first! !
  4355.  
  4356. !GrammarProduction methodsFor: 'parse tree building'!
  4357. computeResultNodeFor: builder withTokenClassValue: value 
  4358.     "See this method in class TransductionGrammarProduction."
  4359.  
  4360.     self error: 'No translation has been specified that would
  4361. create a place to store the token class value.'! !
  4362.  
  4363. !GrammarProduction methodsFor: 'parse tree building'!
  4364. numberOfRhsNonterminals
  4365.     "Answer the number of nonterminals in my right-hand side."
  4366.  
  4367.     ^(self rightHandSide select: [:sym | sym isNonterminal]) size! !
  4368.  
  4369. !GrammarProduction methodsFor: 'testing'!
  4370. hasSingleTokenClassRhs
  4371.     "Answer true if my right hand side consists solely of 
  4372.     a single token class terminal symbol and false otherwise."
  4373.  
  4374.     ^self rightHandSide size = 1 and: [self rightHandSide first isTokenClassTerminal]! !
  4375.  
  4376. !GrammarProduction methodsFor: 'testing'!
  4377. hasTranslation
  4378.     "See class TransductionGrammarProduction."
  4379.  
  4380.     ^false! !
  4381.  
  4382. !GrammarProduction methodsFor: 'testing'!
  4383. isEpsilonProduction
  4384.     "Answer true if I am a production of the form S -> <epsilon> (i.e. if my right hand 
  4385.     side is empty) and false otherwise."
  4386.  
  4387.     ^self rightHandSide isEmpty! !
  4388.  
  4389. !GrammarProduction methodsFor: 'testing'!
  4390. isGrammarProduction
  4391.  
  4392.     ^true! !
  4393.  
  4394. !GrammarProduction methodsFor: 'testing'!
  4395. rightHandSideComprisedOf: aSet 
  4396.     "Answer true if all symbols in my right-hand side 
  4397.     are included in aSet and false otherwise."
  4398.  
  4399.     self rightHandSide detect: [:sym | (aSet includes: sym) not]
  4400.         ifNone: [^true].
  4401.     ^false! !
  4402.  
  4403. !GrammarProduction methodsFor: 'testing'!
  4404. rightHandSideHasAllNontermsIn: aSet 
  4405.     "Answer true if all nonterminals in my right-hand side 
  4406.     are included in aSet and false otherwise."
  4407.  
  4408.     self rightHandSide detect: [:sym | sym isNonterminal and: [(aSet includes: sym) not]]
  4409.         ifNone: [^true].
  4410.     ^false! !
  4411.  
  4412. !GrammarProduction methodsFor: 'printing'!
  4413. printOn: aStream 
  4414.  
  4415.     self printSymbol: self leftHandSide on: aStream.
  4416.     aStream
  4417.          tab;
  4418.          nextPut: $:;
  4419.          space.
  4420.     self rightHandSide do: 
  4421.         [:sym | 
  4422.         self printSymbol: sym on: aStream.
  4423.         aStream space]! !
  4424.  
  4425. !GrammarProduction methodsFor: 'private'!
  4426. lr0ItemClass
  4427.  
  4428.     ^LR0Item! !
  4429.  
  4430. !GrammarProduction methodsFor: 'private'!
  4431. lr1ItemClass
  4432.  
  4433.     ^LR1Item! !
  4434.  
  4435. !GrammarProduction methodsFor: 'private'!
  4436. lrParserStateClass
  4437.  
  4438.     ^LRParserState! !
  4439.  
  4440. !GrammarProduction methodsFor: 'private'!
  4441. printSymbol: sym on: aStream 
  4442.     "Render the given grammar symbol (terminal or nonterminal) on aStream. 
  4443.     This is provided so that grammars are printed in T-gen specification form.
  4444.     Nonterminals and token class terminals are printed without #s or 's and
  4445.     terminals are printed as strings."
  4446.  
  4447.     (sym isNonterminal or: [sym isTokenClassTerminal])
  4448.         ifTrue: [sym do: [:ch | aStream nextPut: ch]]
  4449.         ifFalse: [sym printOn: aStream]! !
  4450.  
  4451. !GrammarProduction methodsFor: 'private'!
  4452. symbolSuffixSeparatorChar
  4453.  
  4454.     ^self lrParserStateClass symbolSuffixSeparatorChar! !
  4455.  
  4456. !GrammarProduction methodsFor: 'conversion'!
  4457. asInitialLR0Item
  4458.  
  4459.     ^self lr0ItemClass
  4460.         leftHandSide: self leftHandSide
  4461.         preDotSymbols: OrderedCollection new
  4462.         postDotSymbols: self rightHandSide copy! !
  4463.  
  4464. !GrammarProduction methodsFor: 'conversion'!
  4465. asInitialLR1ItemWithLookahead: terminal 
  4466.  
  4467.     ^self lr1ItemClass
  4468.         leftHandSide: self leftHandSide
  4469.         preDotSymbols: OrderedCollection new
  4470.         postDotSymbols: self rightHandSide copy
  4471.         lookahead: terminal! !
  4472.  
  4473. !GrammarProduction methodsFor: 'conversion'!
  4474. asNonLalrSuffixedProduction
  4475.     "Assuming I am of the form 'A.<stuff1>* -> B.<stuff2>* C.<stuff3>*', 
  4476.     answer the prefix production 'A -> B C'."
  4477.  
  4478.     | separator lhs rhs |
  4479.     separator := self symbolSuffixSeparatorChar.
  4480.     lhs := self leftHandSide copyUpTo: separator.
  4481.     rhs := self rightHandSide collect: [:sym | sym copyUpTo: separator].
  4482.     ^self species leftHandSide: lhs rightHandSide: rhs! !
  4483.  
  4484. !GrammarProduction methodsFor: 'first/follow sets'!
  4485. computeFirstIn: grammar using: graph 
  4486.     "Build dependency graph for first sets and initialize first sets. Starting at the left 
  4487.     end of my right hand side, symbols are processed until a terminal or non-nullable 
  4488.     nonterminal is encountered. Any terminal encountered is added to the first set 
  4489.     associated with my left hand side node in the graph. Any nonterminal 
  4490.     encountered means that I must include its first set in mine. This accomplished 
  4491.     (indirectly) by adding an edge in the graph from the nonterminal's node to my lhs 
  4492.     node. The actual first set unioning will be done after the graph is complete (see 
  4493.     sender)."
  4494.  
  4495.     self rightHandSide do: 
  4496.         [:sym | 
  4497.         sym isTerminal
  4498.             ifTrue: 
  4499.                 [graph addTerminal: sym toNodeLabeled: self leftHandSide.
  4500.                 ^self].
  4501.         graph addEdgeFromNodeLabeled: sym toNodeLabeled: self leftHandSide.
  4502.         (grammar isNullable: sym)
  4503.             ifFalse: [^self]]! !
  4504.  
  4505. !GrammarProduction methodsFor: 'first/follow sets'!
  4506. computeFollowIn: grammar using: graph 
  4507.     "Build dependency graph for follow sets and initialize follow sets. This method 
  4508.     performs two distinct parts of the algorithm. First, each nonterminal in my right 
  4509.     hand side is checked to what symbols can follow it. Those symbols are added to 
  4510.     the follow set for the nonterminal's graph node. Second, starting at the right end 
  4511.     of my right hand side, symbols are processed until a terminal or non-nullable 
  4512.     nonterminal is encountered. Any nonterminal encountered means that my follow 
  4513.     set should also be included in its follow set. This accomplished (indirectly) by 
  4514.     adding an edge in the graph from my lhs node to the nonterminal's node. The 
  4515.     actual follow set unioning will be done after the graph is complete (see sender)."
  4516.  
  4517.     | n currSym more j nextSym |
  4518.     n := self rightHandSide size.
  4519.     1 to: n - 1 do: [:i | (currSym := self rightHandSide at: i) isNonterminal
  4520.             ifTrue: 
  4521.                 [more := true.
  4522.                 j := i + 1.
  4523.                 [j <= n & more]
  4524.                     whileTrue: 
  4525.                         [nextSym := self rightHandSide at: j.
  4526.                         (grammar firstSetOf: nextSym)
  4527.                             do: [:sym | graph addTerminal: sym toNodeLabeled: currSym].
  4528.                         j := j + 1.
  4529.                         more := grammar isNullable: nextSym]]].
  4530.     self rightHandSide
  4531.         reverseDo: 
  4532.             [:sym | 
  4533.             sym isTerminal ifTrue: [^self].
  4534.             graph addEdgeFromNodeLabeled: self leftHandSide toNodeLabeled: sym.
  4535.             (grammar isNullable: sym)
  4536.                 ifFalse: [^self]]! !
  4537.  
  4538. !GrammarProduction methodsFor: 'comparing'!
  4539. = aProd 
  4540.  
  4541.     ^aProd isGrammarProduction
  4542.         ifTrue: [self leftHandSide = aProd leftHandSide and: [self rightHandSide = aProd rightHandSide]]
  4543.         ifFalse: [false]! !
  4544.  
  4545. !GrammarProduction methodsFor: 'comparing'!
  4546. hash
  4547.     "This is redefined because = is redefined."
  4548.  
  4549.     ^self leftHandSide hash bitXor: self rightHandSide hash! !
  4550.  
  4551. !GrammarProduction methodsFor: 'reconstructing'!
  4552. constructItsContentOn: aStream using: tokenTable 
  4553.     "Emit lhs and #( rhs ) on aStream"
  4554.  
  4555.     (tokenTable indexOf: self leftHandSide)
  4556.         reconstructOn: aStream.
  4557.     aStream
  4558.          space;
  4559.          poundSign;
  4560.          leftParenthesis.
  4561.     self rightHandSide do: 
  4562.         [:ea | 
  4563.         (tokenTable indexOf: ea)
  4564.             reconstructOn: aStream.
  4565.         aStream space].
  4566.     aStream rightParenthesis! !
  4567.  
  4568. !GrammarProduction methodsFor: 'reconstructing'!
  4569. reconstructOn: aStream 
  4570.     "Emit #( productions ) on aStream "
  4571.  
  4572.     aStream poundSign; leftParenthesis.
  4573.     (self symbolTable at: self leftHandSide)
  4574.         reconstructOn: aStream.
  4575.     aStream
  4576.          space;
  4577.          poundSign;
  4578.          leftParenthesis.
  4579.     self rightHandSide do: 
  4580.         [:ea | 
  4581.         (self symbolTable at: ea)
  4582.             reconstructOn: aStream.
  4583.         aStream space].
  4584.     aStream
  4585.          rightParenthesis;
  4586.          rightParenthesis;
  4587.          space! !
  4588.  
  4589. !GrammarProduction methodsFor: 'reconstructing'!
  4590. reconstructOn: aStream using: tokenTable 
  4591.  
  4592.     aStream poundSign; leftParenthesis.
  4593.     self constructItsContentOn: aStream using: tokenTable.
  4594.     aStream rightParenthesis; space! !
  4595.  
  4596. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4597.  
  4598. GrammarProduction class
  4599.     instanceVariableNames: ''!
  4600.  
  4601. !GrammarProduction class methodsFor: 'instance creation'!
  4602. leftHandSide: arg1 rightHandSide: arg2 
  4603.  
  4604.     | newMe |
  4605.     newMe := self new.
  4606.     newMe leftHandSide: arg1.
  4607.     newMe rightHandSide: arg2.
  4608.     ^newMe! !
  4609.  
  4610. GrammarProduction variableSubclass: #TransductionGrammarProduction
  4611.     instanceVariableNames: 'translationSymbol '
  4612.     classVariableNames: ''
  4613.     poolDictionaries: ''
  4614.     category: 'T-gen-Scanning/Parsing'!
  4615. TransductionGrammarProduction comment:
  4616. '=================================================
  4617.     Copyright (c) 1992 by Justin O. Graver.
  4618.     All rights reserved (with exceptions).
  4619.     For complete information evaluate "Object tgenCopyright."
  4620. =================================================
  4621.  
  4622. I add a translation attribute to context-free grammar productions so that I can be used to build simple transduction grammars (or syntax-directed translation scheme).  Transduction grammars are used to build abstract syntax trees rather than derivation trees during parsing.  For more information, refer to Chapter 7. ("Syntax-Directed Translation") in {\em Compiler Construction:  Theory and Practice} by Barrett, Bates, Gustafson, and Couch.
  4623.  
  4624. Instance Variables:
  4625.     translationSymbol <String> - used as basis for translation node when parsing.'!
  4626.  
  4627. TransductionGrammarProduction comment:
  4628. '=================================================
  4629.     Copyright (c) 1992 by Justin O. Graver.
  4630.     All rights reserved (with exceptions).
  4631.     For complete information evaluate "Object tgenCopyright."
  4632. =================================================
  4633.  
  4634. I add a translation attribute to context-free grammar productions so that I can be used to build simple transduction grammars (or syntax-directed translation scheme).  Transduction grammars are used to build abstract syntax trees rather than derivation trees during parsing.  For more information, refer to Chapter 7. ("Syntax-Directed Translation") in {\em Compiler Construction:  Theory and Practice} by Barrett, Bates, Gustafson, and Couch.
  4635.  
  4636. Instance Variables:
  4637.     translationSymbol <String> - used as basis for translation node when parsing.'!
  4638.  
  4639. !TransductionGrammarProduction methodsFor: 'state accessing'!
  4640. translationSymbol
  4641.  
  4642.     ^translationSymbol! !
  4643.  
  4644. !TransductionGrammarProduction methodsFor: 'state accessing'!
  4645. translationSymbol: argument 
  4646.  
  4647.     translationSymbol := argument! !
  4648.  
  4649. !TransductionGrammarProduction methodsFor: 'testing'!
  4650. hasTranslation
  4651.  
  4652.     ^true! !
  4653.  
  4654. !TransductionGrammarProduction methodsFor: 'printing'!
  4655. printOn: aStream 
  4656.  
  4657.     super printOn: aStream.
  4658.     aStream nextPutAll: ' {'.
  4659.     self printSymbol: self translationSymbol asSymbol on: aStream.
  4660.     aStream nextPutAll: '} '! !
  4661.  
  4662. !TransductionGrammarProduction methodsFor: 'conversion'!
  4663. asInitialLR0Item
  4664.  
  4665.     ^self lr0ItemClass
  4666.         leftHandSide: self leftHandSide
  4667.         preDotSymbols: OrderedCollection new
  4668.         postDotSymbols: self rightHandSide copy
  4669.         translationSymbol: self translationSymbol! !
  4670.  
  4671. !TransductionGrammarProduction methodsFor: 'conversion'!
  4672. asInitialLR1ItemWithLookahead: terminal 
  4673.  
  4674.     ^self lr1ItemClass
  4675.         leftHandSide: self leftHandSide
  4676.         preDotSymbols: OrderedCollection new
  4677.         postDotSymbols: self rightHandSide copy
  4678.         lookahead: terminal
  4679.         translationSymbol: self translationSymbol! !
  4680.  
  4681. !TransductionGrammarProduction methodsFor: 'conversion'!
  4682. asNonLalrSuffixedProduction
  4683.     "Assuming I am of the form 'A.<stuff1>* -> B.<stuff2>* C.<stuff3>*', 
  4684.     answer the prefix production 'A -> B C'."
  4685.  
  4686.     | separator lhs rhs |
  4687.     separator := self symbolSuffixSeparatorChar.
  4688.     lhs := self leftHandSide copyUpTo: separator.
  4689.     rhs := self rightHandSide collect: [:sym | sym copyUpTo: separator].
  4690.     ^self species
  4691.         leftHandSide: lhs
  4692.         rightHandSide: rhs
  4693.         translationSymbol: self translationSymbol! !
  4694.  
  4695. !TransductionGrammarProduction methodsFor: 'private'!
  4696. epsilonSymbol
  4697.  
  4698.     ^#nil! !
  4699.  
  4700. !TransductionGrammarProduction methodsFor: 'private'!
  4701. leftLiftSymbol
  4702.  
  4703.     ^#liftLeftChild! !
  4704.  
  4705. !TransductionGrammarProduction methodsFor: 'private'!
  4706. rightLiftSymbol
  4707.  
  4708.     ^#liftRightChild! !
  4709.  
  4710. !TransductionGrammarProduction methodsFor: 'parse tree building'!
  4711. computeResultNodeFor: builder withArgNodes: nodes 
  4712.     "Three kinds of translation symbols are currently supported: node names, special 
  4713.     directives, and arbitrary message selectors. For a node name, a new instance of 
  4714.     the specified node is created and given nodes, if any, as its children. The special 
  4715.     directive 'nil' simply returns nil. The directive liftRightChild adds any nodes 
  4716.     preceeding the right-most node as children to the right-most node, and returns 
  4717.     the right-most node. The directive liftLeftChild works in an analogous fashion. 
  4718.     Arbitrary message selectors must take the number of arguments in nodes and 
  4719.     are invoked as a builder message, thus allowing users to define their own 
  4720.     tree-building messages."
  4721.  
  4722.     | symbol node |
  4723.     symbol := self translationSymbol asSymbol.
  4724.     symbol first isUppercase ifTrue: [^nodes isEmpty
  4725.             ifTrue: [builder makeNewNode: symbol]
  4726.             ifFalse: [builder makeNewNode: symbol withChildren: nodes]].
  4727.     symbol = self epsilonSymbol ifTrue: [^builder answerNil].
  4728.     symbol = self rightLiftSymbol
  4729.         ifTrue: 
  4730.             [nodes size < 2 ifTrue: [self error: 'Only use liftRightChild when there are at least two right-hand-side nonterminals.'].
  4731.             "special case for building lists ending with epsilon"
  4732.             (nodes size = 2 and: [nodes last isNil])
  4733.                 ifTrue: [^builder answerArgument: nodes first].
  4734.             node := nodes removeLast.
  4735.             ^builder addChildrenFirst: nodes to: node].
  4736.     symbol = self leftLiftSymbol
  4737.         ifTrue: 
  4738.             [nodes size < 2 ifTrue: [self error: 'Only use liftLeftChild when there are at least two right-hand-side nonterminals.'].
  4739.             "special case for building lists beginning with epsilon"
  4740.             (nodes size = 2 and: [nodes first isNil])
  4741.                 ifTrue: [^builder answerArgument: nodes last].
  4742.             node := nodes removeFirst.
  4743.             ^builder addChildrenLast: nodes to: node].
  4744.     symbol numArgs = nodes size ifFalse: [self error: 'Translation message selectors must have the same number of arguments as right-hand-side nonterminals.'].
  4745.     nodes isEmpty ifTrue: [^builder perform: symbol].
  4746.     "It may be more efficient to check the number of arguments and use 
  4747.     perform:with:, etc., but probably not."
  4748.     ^builder perform: symbol withArguments: nodes asArray! !
  4749.  
  4750. !TransductionGrammarProduction methodsFor: 'parse tree building'!
  4751. computeResultNodeFor: builder withTokenClassValue: value 
  4752.     "I am assumed to be a production of the form 'A -> <tc> => symbol'. 
  4753.     The symbol can be either a node name or a one-argument message selector. 
  4754.     If it is a node name then create a new instance of that node with the specified 
  4755.     attribute value. If it is a message selector then invoke the corresponding 
  4756.     operation on the builder with the specified value."
  4757.  
  4758.     | symbol |
  4759.     symbol := self translationSymbol asSymbol.
  4760.     symbol first isUppercase
  4761.         ifTrue: [^builder makeNewNode: symbol withAttribute: value]
  4762.         ifFalse: [symbol numArgs = 1
  4763.                 ifTrue: [^builder perform: symbol with: value]
  4764.                 ifFalse: [self error: 'Expected either a node name or a one argument
  4765. message selector as a translation symbol.']]! !
  4766.  
  4767. !TransductionGrammarProduction methodsFor: 'reconstructing'!
  4768. constructItsContentOn: aStream using: tokenTable 
  4769.     "Emit  lhs , #( rhs ) and translationSymbol on aStream"
  4770.  
  4771.     super constructItsContentOn: aStream using: tokenTable.
  4772.     (tokenTable indexOf: self translationSymbol)
  4773.         reconstructOn: aStream! !
  4774.  
  4775. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4776.  
  4777. TransductionGrammarProduction class
  4778.     instanceVariableNames: ''!
  4779.  
  4780. !TransductionGrammarProduction class methodsFor: 'instance creation'!
  4781. leftHandSide: arg1 rightHandSide: arg2 translationSymbol: arg3 
  4782.  
  4783.     | newMe |
  4784.     newMe := self new.
  4785.     newMe leftHandSide: arg1.
  4786.     newMe rightHandSide: arg2.
  4787.     newMe translationSymbol: arg3.
  4788.     ^newMe! !
  4789.  
  4790. Object variableSubclass: #TokenClassification
  4791.     instanceVariableNames: 'tokenType action '
  4792.     classVariableNames: ''
  4793.     poolDictionaries: ''
  4794.     category: 'T-gen-Scanning/Parsing'!
  4795. TokenClassification comment:
  4796. '=================================================
  4797.     Copyright (c) 1992 by Justin O. Graver.
  4798.     All rights reserved (with exceptions).
  4799.     For complete information evaluate "Object tgenCopyright."
  4800. =================================================
  4801.  
  4802. I represent a class of tokens. 
  4803.  
  4804. Instance Variables:
  4805.     tokenType    <String> - name of this token class.
  4806.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  4807.  
  4808. TokenClassification comment:
  4809. '=================================================
  4810.     Copyright (c) 1992 by Justin O. Graver.
  4811.     All rights reserved (with exceptions).
  4812.     For complete information evaluate "Object tgenCopyright."
  4813. =================================================
  4814.  
  4815. I represent a class of tokens. 
  4816.  
  4817. Instance Variables:
  4818.     tokenType    <String> - name of this token class.
  4819.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  4820.  
  4821. !TokenClassification methodsFor: 'state accessing'!
  4822. action
  4823.  
  4824.     ^action! !
  4825.  
  4826. !TokenClassification methodsFor: 'state accessing'!
  4827. action: argument 
  4828.  
  4829.     action := argument! !
  4830.  
  4831. !TokenClassification methodsFor: 'state accessing'!
  4832. tokenType
  4833.  
  4834.     ^tokenType! !
  4835.  
  4836. !TokenClassification methodsFor: 'state accessing'!
  4837. tokenType: argument 
  4838.  
  4839.     tokenType := argument! !
  4840.  
  4841. !TokenClassification methodsFor: 'testing'!
  4842. isTokenClassification
  4843.  
  4844.     ^true! !
  4845.  
  4846. !TokenClassification methodsFor: 'printing'!
  4847. printOn: aStream
  4848.  
  4849.     aStream nextPutAll: self tokenType.
  4850.     aStream nextPutAll: ' : {'.
  4851.     aStream nextPutAll: (self action isNil ifTrue: ['nil'] ifFalse: [self action]).
  4852.     aStream nextPutAll: '} ;'! !
  4853.  
  4854. !TokenClassification methodsFor: 'reconstructing'!
  4855. reconstructOn: aStream 
  4856.     "Emit #( tokenType  action ) on aStream"
  4857.  
  4858.     aStream poundSign; leftParenthesis.
  4859.     self tokenType reconstructOn: aStream.
  4860.     aStream space.
  4861.     self action reconstructOn: aStream.
  4862.     aStream rightParenthesis! !
  4863.  
  4864. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4865.  
  4866. TokenClassification class
  4867.     instanceVariableNames: ''!
  4868.  
  4869. !TokenClassification class methodsFor: 'instance creation'!
  4870. tokenType: arg1 action: arg2 
  4871.  
  4872.     | newMe |
  4873.     newMe := self new.
  4874.     newMe tokenType: arg1.
  4875.     newMe action: arg2.
  4876.     ^newMe! !
  4877.  
  4878. Array variableSubclass: #Stack
  4879.     instanceVariableNames: 'topPtr '
  4880.     classVariableNames: ''
  4881.     poolDictionaries: ''
  4882.     category: 'T-gen-Scanning/Parsing'!
  4883. Stack comment:
  4884. '=================================================
  4885.     Copyright (c) 1992 by Justin O. Graver.
  4886.     All rights reserved (with exceptions).
  4887.     For complete information evaluate "Object tgenCopyright."
  4888. =================================================
  4889.  
  4890. This class provides a more traditional push/pop interface for Arrays.'!
  4891.  
  4892. Stack comment:
  4893. '=================================================
  4894.     Copyright (c) 1992 by Justin O. Graver.
  4895.     All rights reserved (with exceptions).
  4896.     For complete information evaluate "Object tgenCopyright."
  4897. =================================================
  4898.  
  4899. This class provides a more traditional push/pop interface for Arrays.'!
  4900.  
  4901. !Stack methodsFor: 'private'!
  4902. copyEmpty: aSize
  4903.     "Answer a copy of the receiver that contains no elements.
  4904.  
  4905.     This method should be redefined in subclasses that add
  4906.     instance variables, so that the state of those variables
  4907.     is preserved"
  4908.  
  4909.     ^(super copyEmpty: aSize) topPtr: self topPtr.! !
  4910.  
  4911. !Stack methodsFor: 'state accessing'!
  4912. topPtr
  4913.     ^topPtr! !
  4914.  
  4915. !Stack methodsFor: 'state accessing'!
  4916. topPtr: arg
  4917.     topPtr := arg! !
  4918.  
  4919. !Stack methodsFor: 'testing'!
  4920. isEmpty
  4921.     ^topPtr = 0! !
  4922.  
  4923. !Stack methodsFor: 'testing'!
  4924. isFull
  4925.     ^ topPtr = self basicSize! !
  4926.  
  4927. !Stack methodsFor: 'accessing'!
  4928. pop
  4929.     "Answer the object on top of the stack."
  4930.  
  4931.     | n |
  4932.     n := self at: topPtr.
  4933.     topPtr := topPtr - 1.
  4934.     ^n! !
  4935.  
  4936. !Stack methodsFor: 'accessing'!
  4937. pop: numElem 
  4938.     "Pop and discard top numElems and answer receiver"
  4939.  
  4940.     topPtr := topPtr - numElem! !
  4941.  
  4942. !Stack methodsFor: 'accessing'!
  4943. push: anObject 
  4944.     "Push anObject onto the top of the stack."
  4945.  
  4946.     self isFull ifTrue: [self grow].
  4947.     topPtr := topPtr + 1.
  4948.     ^self at: topPtr put: anObject! !
  4949.  
  4950. !Stack methodsFor: 'accessing'!
  4951. size
  4952.     "Answer the number of objects on the stack."
  4953.  
  4954.     ^topPtr! !
  4955.  
  4956. !Stack methodsFor: 'accessing'!
  4957. top
  4958.     "Answer (without removing) the object on top of the stack."
  4959.  
  4960.     ^self at: topPtr! !
  4961.  
  4962. !Stack methodsFor: 'initialization'!
  4963. init
  4964.  
  4965.     self topPtr: 0! !
  4966.  
  4967. !Stack methodsFor: 'enumerating'!
  4968. do: aBlock
  4969.     "Evaluate aBlock for each object on the stack, from top to bottom."
  4970.  
  4971.     ^super reverseDo: aBlock! !
  4972.  
  4973. !Stack methodsFor: 'enumerating'!
  4974. reverseDo: aBlock
  4975.     "Evaluate aBlock for each object on the stack, from bottom to top."
  4976.  
  4977.     ^super do: aBlock! !
  4978.  
  4979. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4980.  
  4981. Stack class
  4982.     instanceVariableNames: ''!
  4983.  
  4984. !Stack class methodsFor: 'instance creation'!
  4985. new
  4986.  
  4987.     ^self new: 100! !
  4988.  
  4989. !Stack class methodsFor: 'instance creation'!
  4990. new: arg
  4991.  
  4992.     ^( super new: arg ) init! !
  4993.  
  4994. BidirectionalEdgeLabeledDigraphNode variableSubclass: #LRParserState
  4995.     instanceVariableNames: 'reduceMap '
  4996.     classVariableNames: ''
  4997.     poolDictionaries: ''
  4998.     category: 'T-gen-Scanning/Parsing'!
  4999. LRParserState comment:
  5000. '=================================================
  5001.     Copyright (c) 1992 by Justin O. Graver.
  5002.     All rights reserved (with exceptions).
  5003.     For complete information evaluate "Object tgenCopyright."
  5004. =================================================
  5005.  
  5006. I represent a node in an LR parser characteristic finite state machine.
  5007.  
  5008. Instance Variables:
  5009.  
  5010.     edgeLabelMap        <Dictionary from: symbols to: successors> - overridden from EdgeLabeledDigraphNode for efficiency since only deterministic FSAs are constructed.
  5011.     reduceMap        <SetDictionary from: symbols to: productions>'!
  5012.  
  5013. LRParserState comment:
  5014. '=================================================
  5015.     Copyright (c) 1992 by Justin O. Graver.
  5016.     All rights reserved (with exceptions).
  5017.     For complete information evaluate "Object tgenCopyright."
  5018. =================================================
  5019.  
  5020. I represent a node in an LR parser characteristic finite state machine.
  5021.  
  5022. Instance Variables:
  5023.  
  5024.     edgeLabelMap        <Dictionary from: symbols to: successors> - overridden from EdgeLabeledDigraphNode for efficiency since only deterministic FSAs are constructed.
  5025.     reduceMap        <SetDictionary from: symbols to: productions>'!
  5026.  
  5027. !LRParserState methodsFor: 'initialization'!
  5028. init
  5029.  
  5030.     super init.
  5031.     self edgeLabelMap: Dictionary new.        "overrides use of SetDictionary in superclass"
  5032.     self reduceMap: SetDictionary new! !
  5033.  
  5034. !LRParserState methodsFor: 'state accessing'!
  5035. reduceMap
  5036.  
  5037.     ^reduceMap! !
  5038.  
  5039. !LRParserState methodsFor: 'state accessing'!
  5040. reduceMap: argument 
  5041.  
  5042.     reduceMap := argument! !
  5043.  
  5044. !LRParserState methodsFor: 'exception handling'!
  5045. standardErrorString
  5046.  
  5047.     ^'unexpected token encountered:  '! !
  5048.  
  5049. !LRParserState methodsFor: 'printing'!
  5050. printOn: aStream 
  5051.  
  5052.     super printOn: aStream.
  5053.     aStream cr.
  5054.     self reduceMap printOn: aStream! !
  5055.  
  5056. !LRParserState methodsFor: 'lalr analysis'!
  5057. appendHashTo: sym 
  5058.     "Answer a new nonterminal or terminal with my hash value appended."
  5059.  
  5060.     | newSym |
  5061.     newSym := sym , self symbolSuffixSeparatorString , self hash printString.
  5062.     ^sym isNonterminal
  5063.         ifTrue: [newSym asNonterminal]
  5064.         ifFalse: [newSym]! !
  5065.  
  5066. !LRParserState methodsFor: 'lalr analysis'!
  5067. buildLalrGrammarWith: stateDict originalGrammar: aGrammar 
  5068.     "Answer my corresponding LALR(1) grammar. The new productions will not be in any 
  5069.     particular order so we must be sure to locate and explicitly specify the new start symbol."
  5070.  
  5071.     | productions startSymbol pattern startSyms |
  5072.     productions := OrderedCollection new.
  5073.     self
  5074.         collectLalrProductionsIn: productions
  5075.         andProdMapsIn: stateDict
  5076.         traversedStates: Set new.
  5077.     pattern := aGrammar startSymbol , self symbolSuffixSeparatorString , '*'.
  5078.     startSyms := Set new.
  5079.     productions do: [:prod | (pattern match: prod leftHandSide) ifTrue: [startSyms add: prod leftHandSide]].
  5080.     startSyms size = 1
  5081.         ifTrue: [startSymbol := startSyms first]
  5082.         ifFalse: [self error: 'multiple start symbols in LALR grammar'].
  5083.     ^self buildGrammarWithProductions: productions startSymbol: startSymbol! !
  5084.  
  5085. !LRParserState methodsFor: 'lalr analysis'!
  5086. collectLalrProductionsIn: aCollection andProdMapsIn: stateDict traversedStates: aSet 
  5087.  
  5088.     | newProds |
  5089.     (aSet includes: self)
  5090.         ifFalse: 
  5091.             [aSet add: self.
  5092.             self isReduceState ifTrue: [self
  5093.                     reductionsDo: 
  5094.                         [:prod | 
  5095.                         newProds := self makeLalrProductionFor: prod.
  5096.                         (stateDict includesKey: self)
  5097.                             ifTrue: 
  5098.                                 ["only need to retain data for conflict states"
  5099.                                 newProds do: [:np | (stateDict at: self)
  5100.                                         at: prod add: np leftHandSide]].
  5101.                         aCollection addAll: newProds]].
  5102.             self successorsExceptSelfDo: [:state | state
  5103.                     collectLalrProductionsIn: aCollection
  5104.                     andProdMapsIn: stateDict
  5105.                     traversedStates: aSet]]! !
  5106.  
  5107. !LRParserState methodsFor: 'lalr analysis'!
  5108. lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar 
  5109.  
  5110.     | conflictStateMap newGrammar prodMap prod follows conflictStates |
  5111.     conflictStates := Set new.
  5112.     conflictStateMap := Dictionary new: stateSet size.
  5113.     stateSet do: [:state | conflictStateMap at: state put: SetDictionary new].
  5114.     newGrammar := self buildLalrGrammarWith: conflictStateMap originalGrammar: aGrammar.
  5115.     "rebuild reduce maps for inconsistent states"
  5116.     stateSet do: 
  5117.         [:state | 
  5118.         state reduceMap: SetDictionary new.
  5119.         prodMap := conflictStateMap at: state.
  5120.         prodMap
  5121.             associationsDo: 
  5122.                 [:assoc | 
  5123.                 prod := assoc key.
  5124.                 follows := Set new.
  5125.                 assoc value do: [:nonterm | (newGrammar followSetOf: nonterm)
  5126.                         do: [:term | follows add: (term copyUpToLast: self symbolSuffixSeparatorChar)]].
  5127.                 follows do: [:term | state reduceBy: prod on: term]].
  5128.         state hasReduceReduceConflict | state hasShiftReduceConflict ifTrue: [conflictStates add: state]].
  5129.     ^conflictStates isEmpty! !
  5130.  
  5131. !LRParserState methodsFor: 'lalr analysis'!
  5132. makeLalrProductionFor: prod 
  5133.  
  5134.     | stateSet rhs newProds lhs currState |
  5135.     stateSet := Set with: self.
  5136.     prod rightHandSide reverseDo: [:sym | stateSet := stateSet inject: Set new into: [:set :state | set union: (state predecessorLabelMap at: sym)]].
  5137.     newProds := Set new.
  5138.     stateSet do: 
  5139.         [:state | 
  5140.         lhs := state appendHashTo: prod leftHandSide.
  5141.         currState := state.
  5142.         rhs := OrderedCollection new.
  5143.         prod rightHandSide do: 
  5144.             [:sym | 
  5145.             rhs add: (currState appendHashTo: sym).
  5146.             currState := currState transitionFor: sym].
  5147.         newProds add: (self makeProductionWithLeftHandSide: lhs rightHandSide: rhs)].
  5148.     ^newProds! !
  5149.  
  5150. !LRParserState methodsFor: 'building'!
  5151. goto: aState on: transitionSymbol 
  5152.  
  5153.     self addSuccessor: aState withEdgeLabeled: transitionSymbol.
  5154.     aState addPredecessor: self withEdgeLabeled: transitionSymbol! !
  5155.  
  5156. !LRParserState methodsFor: 'state transitions'!
  5157. actionFor: aTerminal 
  5158.  
  5159.     | action |
  5160.     (action := self reductionFor: aTerminal) isNil ifTrue: [(action := self transitionFor: aTerminal) isNil ifTrue: [action := self acceptSymbol]].
  5161.     ^action! !
  5162.  
  5163. !LRParserState methodsFor: 'modifying'!
  5164. addSuccessor: node withEdgeLabeled: label 
  5165.     "overridden for Dictionary edgeLabelMap"
  5166.  
  5167.     (self edgeLabelMap includesKey: label)
  5168.         ifTrue: [self error: 'check it out'].
  5169.     self edgeLabelMap at: label put: node! !
  5170.  
  5171. !LRParserState methodsFor: 'accessing'!
  5172. successors
  5173.     "overriden for Dictionary edgeLabelMap"
  5174.  
  5175.     ^self edgeLabelMap values! !
  5176.  
  5177. !LRParserState methodsFor: 'private'!
  5178. acceptSymbol
  5179.  
  5180.     ^self class acceptSymbol! !
  5181.  
  5182. !LRParserState methodsFor: 'private'!
  5183. buildGrammarWithProductions: prods startSymbol: aSymbol 
  5184.  
  5185.     ^self grammarClass buildGrammarWithProductions: prods startSymbol: aSymbol! !
  5186.  
  5187. !LRParserState methodsFor: 'private'!
  5188. grammarClass
  5189.  
  5190.     ^Grammar! !
  5191.  
  5192. !LRParserState methodsFor: 'private'!
  5193. grammarProductionClass
  5194.  
  5195.     ^GrammarProduction! !
  5196.  
  5197. !LRParserState methodsFor: 'private'!
  5198. makeProductionWithLeftHandSide: lhs rightHandSide: rhs 
  5199.  
  5200.     ^self grammarProductionClass leftHandSide: lhs rightHandSide: rhs! !
  5201.  
  5202. !LRParserState methodsFor: 'private'!
  5203. symbolSuffixSeparatorChar
  5204.  
  5205.     ^self class symbolSuffixSeparatorChar! !
  5206.  
  5207. !LRParserState methodsFor: 'private'!
  5208. symbolSuffixSeparatorString
  5209.  
  5210.     ^String with: self symbolSuffixSeparatorChar! !
  5211.  
  5212. !LRParserState methodsFor: 'accessing reductions'!
  5213. reduceBy: aProduction on: aTerminal 
  5214.  
  5215.     self reduceMap at: aTerminal add: aProduction! !
  5216.  
  5217. !LRParserState methodsFor: 'accessing reductions'!
  5218. reductionFor: aSymbol 
  5219.  
  5220.     ^self reduceMap
  5221.         at: aSymbol
  5222.         ifAbsent: [nil]
  5223.         ifNotUnique: [self error: 'reduce/reduce conflict in parser']! !
  5224.  
  5225. !LRParserState methodsFor: 'testing'!
  5226. hasReduceReduceConflict
  5227.     "Answer true if there is a reduce/reduce conflict in this state, and false 
  5228.     otherwise."
  5229.  
  5230.     ^self reduceMap isDeterministic not! !
  5231.  
  5232. !LRParserState methodsFor: 'testing'!
  5233. hasShiftReduceConflict
  5234.     "Answer true if there is a shift/reduce conflict in this state, and false 
  5235.     otherwise."
  5236.  
  5237.     | reduceSyms shiftSyms |
  5238.     reduceSyms := self reduceMap keys.
  5239.     shiftSyms := self edgeLabelMap keys.
  5240.     ^reduceSyms size + shiftSyms size ~= (reduceSyms union: shiftSyms) size! !
  5241.  
  5242. !LRParserState methodsFor: 'testing'!
  5243. isReduceState
  5244.  
  5245.     ^self reduceMap isEmpty not! !
  5246.  
  5247. !LRParserState methodsFor: 'enumerating'!
  5248. reductionsDo: aBlock 
  5249.     "Evaluate aBlock for each of my reduce productions."
  5250.  
  5251.     self reduceMap elementsDo: aBlock! !
  5252.  
  5253. !LRParserState methodsFor: 'converting'!
  5254. spaceOptimizeMap
  5255.     "Predecessors are only needed for LALR(1) analysis."
  5256.  
  5257.     super spaceOptimizeMap.
  5258.     self predecessorLabelMap: nil! !
  5259.  
  5260. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  5261.  
  5262. LRParserState class
  5263.     instanceVariableNames: ''!
  5264.  
  5265. !LRParserState class methodsFor: 'constants'!
  5266. acceptSymbol
  5267.  
  5268.     ^#accept! !
  5269.  
  5270. !LRParserState class methodsFor: 'constants'!
  5271. symbolSuffixSeparatorChar
  5272.  
  5273.     ^$.! !
  5274.  
  5275. !LRParserState class methodsFor: 'class initialization'!
  5276. initialize
  5277.     "LRParserState initialize"
  5278.  
  5279.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  5280.  
  5281. Dictionary variableSubclass: #LLParserTable
  5282.     instanceVariableNames: ''
  5283.     classVariableNames: ''
  5284.     poolDictionaries: ''
  5285.     category: 'T-gen-Scanning/Parsing'!
  5286. LLParserTable comment:
  5287. '=================================================
  5288.     Copyright (c) 1992 by Justin O. Graver.
  5289.     All rights reserved (with exceptions).
  5290.     For complete information evaluate "Object tgenCopyright."
  5291. =================================================
  5292.  
  5293. I implement a two dimensional LL(1) parser table with rows indexed by nonterminals, columns indexed by terminals, and with production table entries.  At the top level I''m a Dictionary from nonterminals to rows; each row is a SetDictionary from terminals to productions.  In deterministic tables (tables without multiple entries) the SetDictionaries can be (and are) converted into simple Dictionaries.'!
  5294.  
  5295. LLParserTable comment:
  5296. '=================================================
  5297.     Copyright (c) 1992 by Justin O. Graver.
  5298.     All rights reserved (with exceptions).
  5299.     For complete information evaluate "Object tgenCopyright."
  5300. =================================================
  5301.  
  5302. I implement a two dimensional LL(1) parser table with rows indexed by nonterminals, columns indexed by terminals, and with production table entries.  At the top level I''m a Dictionary from nonterminals to rows; each row is a SetDictionary from terminals to productions.  In deterministic tables (tables without multiple entries) the SetDictionaries can be (and are) converted into simple Dictionaries.'!
  5303.  
  5304. !LLParserTable methodsFor: 'testing'!
  5305. isDeterministic
  5306.  
  5307.     self detect: [:row | row isDeterministic not]
  5308.         ifNone: [^true].
  5309.     ^false! !
  5310.  
  5311. !LLParserTable methodsFor: 'private'!
  5312. newRow
  5313.  
  5314.     ^self rowClass new! !
  5315.  
  5316. !LLParserTable methodsFor: 'private'!
  5317. rowClass
  5318.  
  5319.     ^SetDictionary! !
  5320.  
  5321. !LLParserTable methodsFor: 'accessing'!
  5322. atNonterminal: nont andTerminal: term addProduction: prod 
  5323.  
  5324.     | row |
  5325.     row := self at: nont ifAbsent: [self at: nont put: self newRow].
  5326.     ^row at: term add: prod! !
  5327.  
  5328. !LLParserTable methodsFor: 'accessing'!
  5329. productionAtNonterminal: nont andTerminal: term 
  5330.  
  5331.     | row |
  5332.     row := self at: nont ifAbsent: [self raiseNoTransitionExceptionErrorString: 'illegal nonterminal symbol encountered:  ' , nont].
  5333.     ^row at: term ifAbsent: [self raiseNoTransitionExceptionErrorString: 'expecting one of ' , row keys printString , ' but encountered:  ''' , term , '''']! !
  5334.  
  5335. !LLParserTable methodsFor: 'converting'!
  5336. spaceOptimize
  5337.     "Assumes self isDeterministic."
  5338.  
  5339.     self associationsDo: [:assoc | self at: assoc key put: assoc value asDictionary]! !
  5340.  
  5341. !LLParserTable methodsFor: 'exception handling'!
  5342. raiseNoTransitionExceptionErrorString: aString 
  5343.  
  5344.     self class noTransitionSignal raiseErrorString: aString! !
  5345.  
  5346. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  5347.  
  5348. LLParserTable class
  5349.     instanceVariableNames: 'noTransitionSignal '!
  5350.  
  5351. !LLParserTable class methodsFor: 'state accessing'!
  5352. noTransitionSignal
  5353.  
  5354.     ^noTransitionSignal! !
  5355.  
  5356. !LLParserTable class methodsFor: 'state accessing'!
  5357. noTransitionSignal: argument 
  5358.  
  5359.     noTransitionSignal := argument! !
  5360.  
  5361. !LLParserTable class methodsFor: 'class initialization'!
  5362. initialize
  5363.     "LLParserTable initialize"
  5364.  
  5365.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  5366.  
  5367. EdgeLabeledDigraphNode subclass: #FSAState
  5368.     instanceVariableNames: 'stateID '
  5369.     classVariableNames: ''
  5370.     poolDictionaries: ''
  5371.     category: 'T-gen-Scanning/Parsing'!
  5372. FSAState comment:
  5373. '=================================================
  5374.     Copyright (c) 1992 by Justin O. Graver.
  5375.     All rights reserved (with exceptions).
  5376.     For complete information evaluate "Object tgenCopyright."
  5377. =================================================
  5378.  
  5379. I am a general state in a finite state automata.'!
  5380.  
  5381. FSAState comment:
  5382. '=================================================
  5383.     Copyright (c) 1992 by Justin O. Graver.
  5384.     All rights reserved (with exceptions).
  5385.     For complete information evaluate "Object tgenCopyright."
  5386. =================================================
  5387.  
  5388. I am a general state in a finite state automata.'!
  5389.  
  5390. !FSAState methodsFor: 'state accessing'!
  5391. stateID
  5392.  
  5393.     ^stateID! !
  5394.  
  5395. !FSAState methodsFor: 'state accessing'!
  5396. stateID: id 
  5397.  
  5398.     stateID := id! !
  5399.  
  5400. !FSAState methodsFor: 'testing'!
  5401. hasStateID
  5402.  
  5403.     ^self stateID notNil! !
  5404.  
  5405. !FSAState methodsFor: 'building'!
  5406. goto: aState on: transitionSymbol 
  5407.  
  5408.     self addSuccessor: aState withEdgeLabeled: transitionSymbol! !
  5409.  
  5410. !FSAState methodsFor: 'private'!
  5411. collectStatesIn: stateSet 
  5412.     "Add myself and all states reachable from me to stateSet. 
  5413.     If I'm the start state of an fsa then all my states are added."
  5414.  
  5415.     (stateSet includes: self)
  5416.         ifFalse: 
  5417.             [stateSet add: self.
  5418.             self successorsExceptSelfDo: [:succ | succ collectStatesIn: stateSet]]! !
  5419.  
  5420. !FSAState methodsFor: 'private'!
  5421. dfsaFinalStateClass
  5422.  
  5423.     ^FSAFinalState! !
  5424.  
  5425. !FSAState methodsFor: 'private'!
  5426. dfsaStateClass
  5427.  
  5428.     ^FSAState! !
  5429.  
  5430. !FSAState methodsFor: 'private'!
  5431. endOfInputToken
  5432.     "Answer a token representing the end of the input."
  5433.  
  5434.     ^Character endOfInput! !
  5435.  
  5436. !FSAState methodsFor: 'private'!
  5437. epsilon
  5438.     "Answer an object used to represent the empty string (epsilon)."
  5439.  
  5440.     ^EpsilonNode epsilon! !
  5441.  
  5442. !FSAState methodsFor: 'private'!
  5443. newDFSAStateFor: multiState 
  5444.     "Answer a new dfsa state that will represent the argument, a collection of states. 
  5445.     Make sure to transfer any final state information to the new state."
  5446.  
  5447.     | newFinalState finalStates |
  5448.     (finalStates := multiState select: [:state | state isFSAFinalState]) isEmpty
  5449.         ifTrue: [^self dfsaStateClass new]
  5450.         ifFalse: 
  5451.             [newFinalState := self dfsaFinalStateClass new.
  5452.             finalStates do: 
  5453.                 [:fs | 
  5454.                 fs literalTokens do: [:lit | newFinalState addLiteralToken: lit].
  5455.                 fs tokenClasses do: [:tc | newFinalState addTokenClass: tc]].
  5456.             ^newFinalState]! !
  5457.  
  5458. !FSAState methodsFor: 'private'!
  5459. nilOutStateIDs
  5460.     "Set my stateID to nil, likewise with all my successors."
  5461.  
  5462.     self stateID notNil
  5463.         ifTrue:
  5464.             [self stateID: nil.
  5465.             self successorsDo: [:succ | succ nilOutStateIDs]]! !
  5466.  
  5467. !FSAState methodsFor: 'private'!
  5468. partitionTransitionMapClass
  5469.  
  5470.     ^PartitionTransitionMap! !
  5471.  
  5472. !FSAState methodsFor: 'private'!
  5473. stateSetClass
  5474.  
  5475.     ^ItemSet! !
  5476.  
  5477. !FSAState methodsFor: 'removing nondeterminism'!
  5478. asDeterministicFSA
  5479.     "Answer a new deterministic version of myself. 
  5480.     
  5481.     Based on Algorithm 3.1 from 'Principles of Compiler Design', 
  5482.     by Aho and Ullman, 1977."
  5483.  
  5484.     | multiStateMap unprocessedStates newStartState currState ch transitStates multiState epsilonClosures newMultiState newState |
  5485.     epsilonClosures := self computeEpsilonClosures.
  5486.     multiStateMap := Dictionary new.
  5487.     unprocessedStates := Set new.
  5488.     newStartState := self newDFSAStateFor: (epsilonClosures at: self).
  5489.     multiStateMap at: (epsilonClosures at: self)
  5490.         put: newStartState.
  5491.     unprocessedStates add: newStartState.
  5492.     [unprocessedStates isEmpty]
  5493.         whileFalse: 
  5494.             [currState := unprocessedStates removeFirst.
  5495.             multiState := multiStateMap keyAtValue: currState.
  5496.             (self computeTransitionMapFor: multiState)
  5497.                 associationsDo: 
  5498.                     [:assoc | 
  5499.                     ch := assoc key.
  5500.                     transitStates := assoc value.
  5501.                     newMultiState := self stateSetClass new.
  5502.                     transitStates do: [:ts | newMultiState addAll: (epsilonClosures at: ts)].
  5503.                     (multiStateMap includesKey: newMultiState)
  5504.                         ifTrue: 
  5505.                             ["previously encountered state"
  5506.                             newState := multiStateMap at: newMultiState]
  5507.                         ifFalse: 
  5508.                             ["make a new state"
  5509.                             newState := self newDFSAStateFor: newMultiState.
  5510.                             multiStateMap at: newMultiState put: newState.
  5511.                             unprocessedStates add: newState].
  5512.                     currState goto: newState on: ch]].
  5513.     ^newStartState spaceOptimize! !
  5514.  
  5515. !FSAState methodsFor: 'removing nondeterminism'!
  5516. computeEpsilonClosureOf: stateSet 
  5517.     "Answer the set of states that can be reached from those in stateSet by epsilon 
  5518.     transitions alone."
  5519.  
  5520.     (stateSet includes: self)
  5521.         ifFalse: 
  5522.             [stateSet add: self.
  5523.             (self edgeLabelMap at: self epsilon ifAbsent: [^self])
  5524.                 do: [:state | state computeEpsilonClosureOf: stateSet]]! !
  5525.  
  5526. !FSAState methodsFor: 'removing nondeterminism'!
  5527. computeEpsilonClosures
  5528.     "Answer a Dictionary from states to their corresponding closures."
  5529.  
  5530.     | closures |
  5531.     closures := Dictionary new.
  5532.     self states do: [:state | closures at: state put: state epsilonClosure].
  5533.     ^closures! !
  5534.  
  5535. !FSAState methodsFor: 'removing nondeterminism'!
  5536. computeTransitionMapFor: multiState 
  5537.     "Answer a transition map (minus any epsilon transitons) for multiState, 
  5538.     a collection of states."
  5539.  
  5540.     | newMap |
  5541.     newMap := SetDictionary new.
  5542.     multiState do: [:state | state copyTransitionsTo: newMap].
  5543.     newMap removeKey: self epsilon ifAbsent: [].
  5544.     ^newMap! !
  5545.  
  5546. !FSAState methodsFor: 'removing nondeterminism'!
  5547. epsilonClosure
  5548.     "Answer the set of states that can be reached from me by epsilon transitions 
  5549.     alone."
  5550.  
  5551.     | states |
  5552.     states := self stateSetClass new.
  5553.     self computeEpsilonClosureOf: states.
  5554.     ^states! !
  5555.  
  5556. !FSAState methodsFor: 'minimizing'!
  5557. asMinimalDFSA
  5558.     "Answer a new minimal deterministic version of myself. 
  5559.     NOTE: the recipient of the DFSA should send the spaceOptimize 
  5560.     message to the DFSA.
  5561.     
  5562.     Based on Algorithm 3.3 from 'Principles of Compiler Design', 
  5563.     by Aho and Ullman, 1977."
  5564.  
  5565.     | dfsa states statePartitionMap oldPartition newPartition |
  5566.     dfsa := self asDeterministicFSA.
  5567.     states := dfsa states.
  5568.     newPartition := self computeInitialPartitionFor: states.
  5569.     oldPartition := Set new.
  5570.     [newPartition size = oldPartition size]
  5571.         whileFalse: 
  5572.             [oldPartition := newPartition.
  5573.             statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
  5574.             self computePartitionTransitionsFor: states using: statePartitionMap.
  5575.             newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
  5576.     ^self
  5577.         computeNewDFSAFor: oldPartition
  5578.         using: statePartitionMap
  5579.         startState: dfsa! !
  5580.  
  5581. !FSAState methodsFor: 'minimizing'!
  5582. asNearMinimalDFSAWithUniqueTokenClasses
  5583.     "Answer a new almost minimal deterministic version of myself. The result is not always 
  5584.     minimal due to the extra constraint that final state partitions containing final states for two 
  5585.     different token classes must be split. This allows the DFSA to properly handle overlapping 
  5586.     token classes.  NOTE: the recipient of the DFSA should send the spaceOptimize 
  5587.     message to the DFSA.
  5588.     
  5589.     Based on Algorithm 3.3 from 'Principles of Compiler Design', 
  5590.     by Aho and Ullman, 1977."
  5591.  
  5592.     | dfsa states statePartitionMap oldPartition newPartition |
  5593.     dfsa := self asDeterministicFSA.
  5594.     states := dfsa states.
  5595.     newPartition := self computeNearMinimalInitialPartitionFor: states.
  5596.     oldPartition := Set new.
  5597.     [newPartition size = oldPartition size]
  5598.         whileFalse: 
  5599.             [oldPartition := newPartition.
  5600.             statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
  5601.             self computePartitionTransitionsFor: states using: statePartitionMap.
  5602.             newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
  5603.     ^self
  5604.         computeNewDFSAFor: oldPartition
  5605.         using: statePartitionMap
  5606.         startState: dfsa! !
  5607.  
  5608. !FSAState methodsFor: 'minimizing'!
  5609. computeNearMinimalInitialPartitionFor: states 
  5610.     "Partition states into nonfinal, literal final, and common token class final state partitions."
  5611.  
  5612.     | finalStates nonFinalStates partition tokenClasses literalTokens tc |
  5613.     finalStates := states select: [:state | state isFSAFinalState].
  5614.     nonFinalStates := states reject: [:state | state isFSAFinalState].
  5615.     partition := nonFinalStates isEmpty
  5616.                 ifTrue: [Set new]
  5617.                 ifFalse: [Set with: nonFinalStates].
  5618.     tokenClasses := SetDictionary new.
  5619.     literalTokens := Set new.
  5620.     finalStates do: 
  5621.         [:finalState | 
  5622.         (tc := finalState tokenClasses) size > 1 ifTrue: [self error: 'multiple token class states are not currently supported'].
  5623.         tc size = 0
  5624.             ifTrue: [literalTokens add: finalState]
  5625.             ifFalse: [tokenClasses at: tc first tokenType add: finalState]].
  5626.     literalTokens isEmpty ifFalse: [partition add: literalTokens].
  5627.     tokenClasses isEmpty ifFalse: [partition addAll: tokenClasses].
  5628.     ^partition! !
  5629.  
  5630. !FSAState methodsFor: 'minimizing'!
  5631. computeInitialPartitionFor: states 
  5632.     "Partition states into final and nonfinal states."
  5633.  
  5634.     | finalStates nonFinalStates |
  5635.     finalStates := states select: [:state | state isFSAFinalState].
  5636.     nonFinalStates := states reject: [:state | state isFSAFinalState].
  5637.     ^nonFinalStates isEmpty
  5638.         ifTrue: [Set with: finalStates]
  5639.         ifFalse: [Set with: nonFinalStates with: finalStates]! !
  5640.  
  5641. !FSAState methodsFor: 'minimizing'!
  5642. computeNewDFSAFor: partition using: statePartitionMap startState: startState 
  5643.     "Answer a new dfsa whose states represent partitions and whose transitions are 
  5644.     computed from the statePartitionMap. The state for the partition containing 
  5645.     startState is the new start state.  NOTE: the recipient of the DFSA should send
  5646.     the spaceOptimize message to the DFSA."
  5647.  
  5648.     | newStateMap partitionRepresentativeState newState ch st newStartState |
  5649.     newStateMap := IdentityDictionary new.
  5650.     partition do: [:part | newStateMap at: part put: (self newDFSAStateFor: part)].
  5651.     partition do: 
  5652.         [:part | 
  5653.         partitionRepresentativeState := part first.
  5654.         newState := newStateMap at: part.
  5655.         (statePartitionMap at: partitionRepresentativeState) transitionMap
  5656.             associationsDo: 
  5657.                 [:assoc | 
  5658.                 ch := assoc key.
  5659.                 st := newStateMap at: assoc value.
  5660.                 newState goto: st on: ch]].
  5661.     newStartState := newStateMap at: (statePartitionMap at: startState) partition.
  5662.     ^newStartState! !
  5663.  
  5664. !FSAState methodsFor: 'minimizing'!
  5665. computeNewPartitionFor: oldPartition using: statePartitionMap 
  5666.     "Answer a new state partition that is a refinement of oldPartition based on 
  5667.     partition transitions. An old partition is split into partitions of states with 
  5668.     equivalent partition transition maps."
  5669.  
  5670.     | newPartition partCopy initialState newPart |
  5671.     newPartition := Set new.
  5672.     oldPartition do: 
  5673.         [:part | 
  5674.         partCopy := part copy.
  5675.         [partCopy isEmpty]
  5676.             whileFalse: 
  5677.                 [initialState := partCopy removeFirst.
  5678.                 newPart := self stateSetClass with: initialState.
  5679.                 partCopy copy do: [:state | ((statePartitionMap at: initialState)
  5680.                         hasSameTransitionMapAs: (statePartitionMap at: state))
  5681.                         ifTrue: 
  5682.                             [partCopy remove: state.
  5683.                             newPart add: state]].
  5684.                 newPartition add: newPart]].
  5685.     ^newPartition! !
  5686.  
  5687. !FSAState methodsFor: 'minimizing'!
  5688. computePartitionTransitionsFor: states using: statePartitionMap 
  5689.     "For each state in states compute its partition-based transition map, 
  5690.     i.e. a transition map from characters to partitions."
  5691.  
  5692.     | char targetPartition |
  5693.     states do: [:state | state edgeLabelMap
  5694.             associationsDo: 
  5695.                 [:assoc | 
  5696.                 char := assoc key.
  5697.                 targetPartition := (statePartitionMap at: (state transitionFor: char)) partition.
  5698.                 (statePartitionMap at: state)
  5699.                     goto: targetPartition on: char]]! !
  5700.  
  5701. !FSAState methodsFor: 'minimizing'!
  5702. computeStatePartitionMapFor: states using: partition 
  5703.     "Answer a Dictionary mapping each state to an object containing its 
  5704.     corresponding partition and a partition-based transition map for the state."
  5705.  
  5706.     | statePartitionMap |
  5707.     statePartitionMap := Dictionary new.
  5708.     states do: [:state | statePartitionMap at: state put: (self partitionTransitionMapClass forPartition: (partition detect: [:par | par includes: state]))].
  5709.     ^statePartitionMap! !
  5710.  
  5711. !FSAState methodsFor: 'exception handling'!
  5712. endOfInputErrorString
  5713.  
  5714.     ^'end of input encountered'! !
  5715.  
  5716. !FSAState methodsFor: 'exception handling'!
  5717. raiseNoTransitionExceptionErrorString: aString 
  5718.  
  5719.     self class noTransitionSignal raiseErrorString: aString! !
  5720.  
  5721. !FSAState methodsFor: 'exception handling'!
  5722. standardErrorString
  5723.  
  5724.     ^'illegal character encountered:  '! !
  5725.  
  5726. !FSAState methodsFor: 'state transitions'!
  5727. copyTransitionsTo: transitionMap 
  5728.  
  5729.     self edgeLabelMap associationsDo: [:assoc | transitionMap at: assoc key addAll: assoc value]! !
  5730.  
  5731. !FSAState methodsFor: 'state transitions'!
  5732. transitionFor: aSymbol 
  5733.  
  5734.     ^self transitionFor: aSymbol ifNone: [self raiseNoTransitionExceptionErrorString: (aSymbol = self endOfInputToken
  5735.                 ifTrue: [self endOfInputErrorString]
  5736.                 ifFalse: [self standardErrorString , '''' , aSymbol printString , ''''])]! !
  5737.  
  5738. !FSAState methodsFor: 'state transitions'!
  5739. transitionFor: aSymbol ifNone: aBlock 
  5740.  
  5741.     ^self edgeLabelMap at: aSymbol ifAbsent: [^aBlock value]! !
  5742.  
  5743. !FSAState methodsFor: 'converting'!
  5744. spaceOptimize
  5745.  
  5746.     self states do: [:state | state spaceOptimizeMap]! !
  5747.  
  5748. !FSAState methodsFor: 'accessing'!
  5749. states
  5750.     "Answer the Set states reachable from here. 
  5751.     If I am the start state this is all my states."
  5752.  
  5753.     | states |
  5754.     states := self stateSetClass new.
  5755.     self collectStatesIn: states.
  5756.     ^states! !
  5757.  
  5758. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  5759.  
  5760. FSAState class
  5761.     instanceVariableNames: 'noTransitionSignal '!
  5762.  
  5763. !FSAState class methodsFor: 'instance creation'!
  5764. new
  5765.  
  5766.     ^super new init! !
  5767.  
  5768. !FSAState class methodsFor: 'class initialization'!
  5769. initialize
  5770.     "FSAState initialize"
  5771.  
  5772.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  5773.  
  5774. !FSAState class methodsFor: 'state accessing'!
  5775. noTransitionSignal
  5776.  
  5777.     ^noTransitionSignal! !
  5778.  
  5779. !FSAState class methodsFor: 'state accessing'!
  5780. noTransitionSignal: argument 
  5781.  
  5782.     noTransitionSignal := argument! !
  5783.  
  5784. FSAState subclass: #FSAFinalState
  5785.     instanceVariableNames: 'literalTokens tokenClasses '
  5786.     classVariableNames: ''
  5787.     poolDictionaries: ''
  5788.     category: 'T-gen-Scanning/Parsing'!
  5789. FSAFinalState comment:
  5790. '=================================================
  5791.     Copyright (c) 1992 by Justin O. Graver.
  5792.     All rights reserved (with exceptions).
  5793.     For complete information evaluate "Object tgenCopyright."
  5794. =================================================
  5795.  
  5796. I am a final state of a finite state automata.  If I''m part of a minimal deterministic fsa then it is possible that I represent several final states of some original non-deterministic fsa.  My instance variables are used to distinguish between these various different final states.  Final states for literal tokens (keywords) are represented by name in literalTokens.  Final states for larger token classes are represented by TokenClassifications.  When a token is recognized by this final state, it is first checked against the list of literal tokens.  If not found, it is then classified as belonging to the one token class of which it is a member.  The current implementation does not support overlapping token classes, hence, there can only really be one element in the OrderedCollection.  However, in the future we hope to be able to support overlapping token classes.
  5797.  
  5798. Instance Variables:
  5799.     literalTokens        <Set of: String> - the literal tokens I recognize.
  5800.     tokenClasses     <OrderedCollection of: TokenClassification> - the token classes I recognize.'!
  5801.  
  5802. FSAFinalState comment:
  5803. '=================================================
  5804.     Copyright (c) 1992 by Justin O. Graver.
  5805.     All rights reserved (with exceptions).
  5806.     For complete information evaluate "Object tgenCopyright."
  5807. =================================================
  5808.  
  5809. I am a final state of a finite state automata.  If I''m part of a minimal deterministic fsa then it is possible that I represent several final states of some original non-deterministic fsa.  My instance variables are used to distinguish between these various different final states.  Final states for literal tokens (keywords) are represented by name in literalTokens.  Final states for larger token classes are represented by TokenClassifications.  When a token is recognized by this final state, it is first checked against the list of literal tokens.  If not found, it is then classified as belonging to the one token class of which it is a member.  The current implementation does not support overlapping token classes, hence, there can only really be one element in the OrderedCollection.  However, in the future we hope to be able to support overlapping token classes.
  5810.  
  5811. Instance Variables:
  5812.     literalTokens        <Set of: String> - the literal tokens I recognize.
  5813.     tokenClasses     <OrderedCollection of: TokenClassification> - the token classes I recognize.'!
  5814.  
  5815. !FSAFinalState methodsFor: 'initialization'!
  5816. init
  5817.  
  5818.     super init.
  5819.     self literalTokens: Set new.
  5820.     self tokenClasses: OrderedCollection new! !
  5821.  
  5822. !FSAFinalState methodsFor: 'state accessing'!
  5823. literalTokens
  5824.  
  5825.     ^literalTokens! !
  5826.  
  5827. !FSAFinalState methodsFor: 'state accessing'!
  5828. literalTokens: argument 
  5829.  
  5830.     literalTokens := argument! !
  5831.  
  5832. !FSAFinalState methodsFor: 'state accessing'!
  5833. tokenClasses
  5834.  
  5835.     ^tokenClasses! !
  5836.  
  5837. !FSAFinalState methodsFor: 'state accessing'!
  5838. tokenClasses: argument 
  5839.  
  5840.     tokenClasses := argument! !
  5841.  
  5842. !FSAFinalState methodsFor: 'state transitions'!
  5843. transitionFor: aSymbol 
  5844.     "The default for final states is to not raise an exception 
  5845.     if no transitions are possible, rather, they answer nil."
  5846.  
  5847.     ^self transitionFor: aSymbol ifNone: [nil]! !
  5848.  
  5849. !FSAFinalState methodsFor: 'testing'!
  5850. isFSAFinalState
  5851.  
  5852.     ^true! !
  5853.  
  5854. !FSAFinalState methodsFor: 'token classifying'!
  5855. addLiteralToken: literal 
  5856.  
  5857.     self literalTokens add: literal! !
  5858.  
  5859. !FSAFinalState methodsFor: 'token classifying'!
  5860. addTokenClass: tokenClass 
  5861.     "Don't add the same tokenClass twice."
  5862.  
  5863.     self tokenClasses detect: [:tc | tc tokenType = tokenClass tokenType]
  5864.         ifNone: [self tokenClasses size ~~ 0
  5865.                 ifTrue: [self error: 'Current implementation only handles non-overlapping token classes.']
  5866.                 ifFalse: [self tokenClasses add: tokenClass]]! !
  5867.  
  5868. !FSAFinalState methodsFor: 'token classifying'!
  5869. tokenTypeAndActionFor: aString 
  5870.     "The current implementation does not handle overlapping token classes. Hence, a final state 
  5871.     can only represent a literal or a single token class. Therefore, if not a literal then it must be 
  5872.     the token class."
  5873.  
  5874.     | tc |
  5875.     ((self literalTokens includes: aString)
  5876.         or: [aString size = 0])
  5877.         ifTrue: [^self typeActionHolderClass type: aString action: nil].
  5878.     tc := self tokenClasses first.
  5879.     ^self typeActionHolderClass type: tc tokenType action: tc action! !
  5880.  
  5881. !FSAFinalState methodsFor: 'private'!
  5882. typeActionHolderClass
  5883.  
  5884.     ^TokenTypeActionHolder! !
  5885.  
  5886. LRParserState initialize!
  5887.  
  5888. LLParserTable initialize!
  5889.  
  5890. FSAState initialize!
  5891.  
  5892. !NoController methodsFor: 'accessing'!
  5893. textHasChanged
  5894.  
  5895.     ^false! !
  5896.  
  5897. !Character methodsFor: 'copying'!
  5898. copyUpToLast: char 
  5899.  
  5900.     ^self! !
  5901.  
  5902. !Character methodsFor: 'converting'!
  5903. asString
  5904.     "Answer the receiver converted into a String."
  5905.  
  5906.     ^String with: self! !
  5907.  
  5908. !Character class methodsFor: 'accessing untypeable characters'!
  5909. endOfInput
  5910.     "Answer the Character representing ctrl-d ."
  5911.  
  5912.     ^self value: 4! !
  5913.  
  5914. !Character class methodsFor: 'accessing untypeable characters'!
  5915. leftParenthesis
  5916.     "Answer the Character representing a left parenthesis."
  5917.  
  5918.     ^self value: 40! !
  5919.  
  5920. !Character class methodsFor: 'accessing untypeable characters'!
  5921. period
  5922.     "Answer the Character representing a carriage period."
  5923.  
  5924.     ^self value: 46! !
  5925.  
  5926. !Character class methodsFor: 'accessing untypeable characters'!
  5927. poundSign
  5928.     "Answer the Character representing a pound sign."
  5929.  
  5930.     ^self value: 35! !
  5931.  
  5932. !Character class methodsFor: 'accessing untypeable characters'!
  5933. rightParenthesis
  5934.     "Answer the Character representing a right parenthesis."
  5935.  
  5936.     ^self value: 41! !
  5937.  
  5938. !Stream methodsFor: 'character writing'!
  5939. leftParenthesis
  5940.     "Append a left parenthesis character to the receiver."
  5941.  
  5942.     self nextPut: Character leftParenthesis! !
  5943.  
  5944. !Stream methodsFor: 'character writing'!
  5945. period
  5946.     "Append a period character to the receiver."
  5947.  
  5948.     self nextPut: Character period! !
  5949.  
  5950. !Stream methodsFor: 'character writing'!
  5951. poundSign
  5952.     "Append a # character to the receiver."
  5953.  
  5954.     self nextPut: Character poundSign! !
  5955.  
  5956. !Stream methodsFor: 'character writing'!
  5957. rightParenthesis
  5958.     "Append a right parenthesis character to the receiver."
  5959.  
  5960.     self nextPut: Character rightParenthesis! !
  5961.  
  5962. WriteStream subclass: #RetractableWriteStream
  5963.     instanceVariableNames: ''
  5964.     classVariableNames: ''
  5965.     poolDictionaries: ''
  5966.     category: 'Collections-Streams'!
  5967. RetractableWriteStream comment:
  5968. '=================================================
  5969.     Copyright (c) 1992 by Justin O. Graver.
  5970.     All rights reserved (with exceptions).
  5971.     For complete information evaluate "Object tgenCopyright."
  5972. =================================================
  5973.  
  5974. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  5975.  
  5976. RetractableWriteStream comment:
  5977. '=================================================
  5978.     Copyright (c) 1992 by Justin O. Graver.
  5979.     All rights reserved (with exceptions).
  5980.     For complete information evaluate "Object tgenCopyright."
  5981. =================================================
  5982.  
  5983. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  5984.  
  5985. !RetractableWriteStream methodsFor: 'positioning'!
  5986. backspace
  5987.     "Backup one position, if possible. It may be best to signal an error when attempting to backup 
  5988.     past the beginning of the stream, but for now just do nothing."
  5989.  
  5990.     self atBeginning ifFalse: [self skip: -1]! !
  5991.  
  5992. !RetractableWriteStream methodsFor: 'accessing'!
  5993. size
  5994.     "Answer how many elements the receiver contains."
  5995.  
  5996.     ^position! !
  5997.  
  5998. !RetractableWriteStream methodsFor: 'testing'!
  5999. atBeginning
  6000.  
  6001.     ^position = 0! !
  6002.  
  6003. ReadStream subclass: #RetractableReadStream
  6004.     instanceVariableNames: ''
  6005.     classVariableNames: ''
  6006.     poolDictionaries: ''
  6007.     category: 'Collections-Streams'!
  6008. RetractableReadStream comment:
  6009. '=================================================
  6010.     Copyright (c) 1992 by Justin O. Graver.
  6011.     All rights reserved (with exceptions).
  6012.     For complete information evaluate "Object tgenCopyright."
  6013. =================================================
  6014.  
  6015. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  6016.  
  6017. RetractableReadStream comment:
  6018. '=================================================
  6019.     Copyright (c) 1992 by Justin O. Graver.
  6020.     All rights reserved (with exceptions).
  6021.     For complete information evaluate "Object tgenCopyright."
  6022. =================================================
  6023.  
  6024. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  6025.  
  6026. !RetractableReadStream methodsFor: 'positioning'!
  6027. backspace
  6028.     "Backup one position, if possible. It may be best to signal an error when attempting to backup 
  6029.     past the beginning of the stream, but for now just do nothing."
  6030.  
  6031.     self atBeginning ifFalse: [self skip: -1]! !
  6032.  
  6033. !RetractableReadStream methodsFor: 'testing'!
  6034. atBeginning
  6035.  
  6036.     ^position = 0! !
  6037.  
  6038. !RetractableReadStream methodsFor: 'accessing'!
  6039. current
  6040.     "Answer the element at the current position or nil if at the beginning. This is useful for 
  6041.     rereading the stream after backspacing."
  6042.  
  6043.     ^self atBeginning
  6044.         ifTrue: [nil]
  6045.         ifFalse: [collection at: position]! !
  6046.  
  6047. !RetractableReadStream methodsFor: 'private'!
  6048. pastEnd
  6049.     "The receiver has attempted to read past the end, answer an EOF indicator."
  6050.     "NOTE: currently, this class is used only by T-gen so it is acceptable to use the end-of-input character
  6051.     rather than nil to denote the end of the stream. However, in a more general context, it may 
  6052.     be desirable to change this back to nil. If this is done then either the transitionFor:ifNone: 
  6053.     method in class FSAState must be changed to check for nil as a transition symbol 
  6054.     (Dictionaries do not allow nil keys), or scanners must be changed to translate a nil character 
  6055.     to the end-of-input character. These changes affect what happens when a scanner runs out of
  6056.       input in the middle of a token."
  6057.  
  6058.     ^Signal noHandlerSignal handle: [:ex | ex parameter proceedWith: (Character endOfInput)]
  6059.         do: [self class endOfStreamSignal raiseRequestFrom: self]! !
  6060.  
  6061. TextView subclass: #NonrelianceTextView
  6062.     instanceVariableNames: ''
  6063.     classVariableNames: ''
  6064.     poolDictionaries: ''
  6065.     category: 'Interface-Text'!
  6066. NonrelianceTextView comment:
  6067. '=================================================
  6068.     Copyright (c) 1992 by Justin O. Graver.
  6069.     All rights reserved (with exceptions).
  6070.     For complete information evaluate "Object tgenCopyright."
  6071. =================================================
  6072.  
  6073. This class represents text views upon which no other view depends.  Hence, another view will never be prevented from changing because of the status of a NonrelianceTextView.'!
  6074.  
  6075. NonrelianceTextView comment:
  6076. '=================================================
  6077.     Copyright (c) 1992 by Justin O. Graver.
  6078.     All rights reserved (with exceptions).
  6079.     For complete information evaluate "Object tgenCopyright."
  6080. =================================================
  6081.  
  6082. This class represents text views upon which no other view depends.  Hence, another view will never be prevented from changing because of the status of a NonrelianceTextView.'!
  6083.  
  6084. !NonrelianceTextView methodsFor: 'updating'!
  6085. updateRequest
  6086.     "Answer regarding whether the receiver may change."
  6087.  
  6088.     ^true! !
  6089.  
  6090. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6091.  
  6092. NonrelianceTextView class
  6093.     instanceVariableNames: ''!
  6094.  
  6095. !Object methodsFor: 'reconstructing'!
  6096. reconstructOn: aStream 
  6097.  
  6098.     self printOn: aStream! !
  6099.  
  6100. !Object methodsFor: 'reconstructing'!
  6101. reconstructOn: aStream using: dummy 
  6102.  
  6103.     self printOn: aStream! !
  6104.  
  6105. !Object methodsFor: 'testing'!
  6106. isAlternationNode
  6107.  
  6108.     ^false! !
  6109.  
  6110. !Object methodsFor: 'testing'!
  6111. isConcatenationNode
  6112.  
  6113.     ^false! !
  6114.  
  6115. !Object methodsFor: 'testing'!
  6116. isEpsilonNode
  6117.  
  6118.     ^false! !
  6119.  
  6120. !Object methodsFor: 'testing'!
  6121. isTerminalNode
  6122.  
  6123.     ^false! !
  6124.  
  6125. !Object methodsFor: 'testing'!
  6126. isFSAFinalState
  6127.  
  6128.     ^false! !
  6129.  
  6130. !Object methodsFor: 'testing'!
  6131. isGrammarProduction
  6132.  
  6133.     ^false! !
  6134.  
  6135. !Object methodsFor: 'testing'!
  6136. isItemSet
  6137.  
  6138.     ^false! !
  6139.  
  6140. !Object methodsFor: 'testing'!
  6141. isLR0Item
  6142.  
  6143.     ^false! !
  6144.  
  6145. !Object methodsFor: 'testing'!
  6146. isLR1Item
  6147.  
  6148.     ^false! !
  6149.  
  6150. !Object methodsFor: 'testing'!
  6151. isNonterminal
  6152.  
  6153.     ^false! !
  6154.  
  6155. !Object methodsFor: 'testing'!
  6156. isPartitionTransitionMap
  6157.  
  6158.     ^false! !
  6159.  
  6160. !Object methodsFor: 'testing'!
  6161. isTerminal
  6162.  
  6163.     ^false! !
  6164.  
  6165. !Object methodsFor: 'testing'!
  6166. isTokenClassification
  6167.  
  6168.     ^false! !
  6169.  
  6170. !Collection methodsFor: 'reconstructing'!
  6171. reconstructOn: aStream 
  6172.     "Emit #( elements ) on aStream "
  6173.  
  6174.     aStream poundSign; leftParenthesis.
  6175.     self do: 
  6176.         [:ea | 
  6177.         ea reconstructOn: aStream.
  6178.         aStream space].
  6179.     aStream rightParenthesis! !
  6180.  
  6181. !Array methodsFor: 'reconstructing'!
  6182. reconstructOn: aStream 
  6183.     "Emit #( elements) on aStream ."
  6184.  
  6185.     aStream
  6186.          poundSign;
  6187.          leftParenthesis;
  6188.          space.
  6189.     1 to: self size do: 
  6190.         [:index | 
  6191.         (self at: index)
  6192.             reconstructOn: aStream.
  6193.         aStream space].
  6194.     aStream rightParenthesis! !
  6195.  
  6196. !Array methodsFor: 'reconstructing'!
  6197. reconstructOn: aStream using: tokenTable 
  6198.  
  6199.     aStream
  6200.          poundSign;
  6201.          leftParenthesis;
  6202.          space.
  6203.     1 to: self size do: 
  6204.         [:index | 
  6205.         (self at: index)
  6206.             reconstructOn: aStream using: tokenTable.
  6207.         aStream space].
  6208.     aStream rightParenthesis! !
  6209.  
  6210. !CharacterArray methodsFor: 'copying'!
  6211. copyUpToLast: aCharacter 
  6212.     "Answer a copy of the receiver from index 1 to the last occurrence of 
  6213.     aCharacter, non-inclusive."
  6214.  
  6215.     | index |
  6216.     (index := self
  6217.                 prevIndexOf: aCharacter
  6218.                 from: self size
  6219.                 to: 1) isNil ifTrue: [^self].
  6220.     ^self copyFrom: 1 to: index - 1! !
  6221.  
  6222. !String methodsFor: 'converting'!
  6223. asNonterminal
  6224.  
  6225.     ^self asSymbol! !
  6226.  
  6227. !String methodsFor: 'testing'!
  6228. isTerminal
  6229.  
  6230.     ^true! !
  6231.  
  6232. !String methodsFor: 'testing'!
  6233. isTokenClassTerminal
  6234.  
  6235.     ^'<*>' match: self! !
  6236.  
  6237. !String methodsFor: 'reconstructing'!
  6238. reconstructOn: aStream 
  6239.  
  6240.     self printOn: aStream! !
  6241.  
  6242. !Symbol methodsFor: 'testing'!
  6243. isNonterminal
  6244.  
  6245.     ^true! !
  6246.  
  6247. !Symbol methodsFor: 'testing'!
  6248. isTerminal
  6249.  
  6250.     ^false! !
  6251.  
  6252. !Symbol methodsFor: 'testing'!
  6253. isTokenClassTerminal
  6254.  
  6255.     ^false! !
  6256.  
  6257. !SequenceableCollection methodsFor: 'enumerating'!
  6258. reverseDetect: aBlock ifNone: exceptionBlock 
  6259.     "Evaluate aBlock with each of the receiver's elements as the argument.
  6260.     Answer the last element for which aBlock evaluates to true."
  6261.  
  6262.     self reverseDo: [:each | (aBlock value: each) ifTrue: [^each]].
  6263.     ^exceptionBlock value! !
  6264.  
  6265. !Set methodsFor: 'accessing'!
  6266. first
  6267.     "Answer an arbitrary element. If the receiver is empty, provide an error 
  6268.     notification. The selector 'first' is used for compatibility with 
  6269.     SequenceableCollections."
  6270.  
  6271.     self emptyCheck.
  6272.     self do: [:each | ^each]! !
  6273.  
  6274. !Set methodsFor: 'removing'!
  6275. removeFirst
  6276.     "Answer (and remove) an arbitrary element. The selector 'removeFirst' is used for 
  6277.     compatibility with SequenceableCollections."
  6278.  
  6279.     | element |
  6280.     element := self first.
  6281.     self remove: element.
  6282.     ^element! !
  6283.  
  6284. !Set methodsFor: 'set operations'!
  6285. intersect: aSet 
  6286.     "Answer a new set which is the intersection of myself and aSet."
  6287.  
  6288.     ^self size < aSet size
  6289.         ifTrue: [self select: [:each | aSet includes: each]]
  6290.         ifFalse: [aSet select: [:each | self includes: each]]! !
  6291.  
  6292. !Set methodsFor: 'set operations'!
  6293. union: aSet 
  6294.     "Answer a new set which is the union of myself and aSet."
  6295.  
  6296.     | newSet |
  6297.     newSet := self species new.
  6298.     newSet addAll: self; addAll: aSet.
  6299.     ^newSet! !
  6300.  
  6301. !Dictionary methodsFor: 'accessing'!
  6302. elements
  6303.  
  6304.     ^self values! !
  6305.  
  6306. !Dictionary methodsFor: 'accessing'!
  6307. valuesAsSet
  6308.     "Answer a set containing the receiver's values."
  6309.  
  6310.     | aSet |
  6311.     aSet := Set new: self size.
  6312.     self do: [:each | aSet add: each].
  6313.     ^aSet! !
  6314.  
  6315. !Dictionary methodsFor: 'converting'!
  6316. asDictionary
  6317.  
  6318.     ^self! !
  6319.  
  6320. !Dictionary methodsFor: 'reconstructing'!
  6321. reconstructOn: aStream 
  6322.     "Emit #( keys ) and #( values ) on aSteam"
  6323.  
  6324.     aStream
  6325.          poundSign;
  6326.          leftParenthesis;
  6327.          space.
  6328.     self
  6329.         associationsDo: 
  6330.             [:assoc | 
  6331.             assoc key reconstructOn: aStream.
  6332.             aStream space].
  6333.     aStream
  6334.          rightParenthesis;
  6335.          space;
  6336.          poundSign;
  6337.          leftParenthesis.
  6338.     self
  6339.         associationsDo: 
  6340.             [:assoc | 
  6341.             assoc value reconstructOn: aStream.
  6342.             aStream space].
  6343.     aStream rightParenthesis; space! !
  6344.  
  6345. Dictionary variableSubclass: #SetDictionary
  6346.     instanceVariableNames: ''
  6347.     classVariableNames: ''
  6348.     poolDictionaries: ''
  6349.     category: 'Collections-Unordered'!
  6350. SetDictionary comment:
  6351. '=================================================
  6352.     Copyright (c) 1992 by Justin O. Graver.
  6353.     All rights reserved (with exceptions).
  6354.     For complete information evaluate "Object tgenCopyright."
  6355. =================================================
  6356.  
  6357. This class represents a Dictionary of Sets.'!
  6358.  
  6359. SetDictionary comment:
  6360. '=================================================
  6361.     Copyright (c) 1992 by Justin O. Graver.
  6362.     All rights reserved (with exceptions).
  6363.     For complete information evaluate "Object tgenCopyright."
  6364. =================================================
  6365.  
  6366. This class represents a Dictionary of Sets.'!
  6367.  
  6368. !SetDictionary methodsFor: 'removing'!
  6369. at: key remove: anObject 
  6370.  
  6371.     ^(self at: key)
  6372.         remove: anObject! !
  6373.  
  6374. !SetDictionary methodsFor: 'removing'!
  6375. at: key remove: anObject ifAbsent: aBlock 
  6376.  
  6377.     ^(self at: key)
  6378.         remove: anObject ifAbsent: aBlock! !
  6379.  
  6380. !SetDictionary methodsFor: 'accessing'!
  6381. at: key ifAbsent: absentBlock ifNotUnique: notUniqueBlock 
  6382.  
  6383.     | elementSet |
  6384.     elementSet := self at: key ifAbsent: [^absentBlock value].
  6385.     ^elementSet size > 1
  6386.         ifTrue: [notUniqueBlock value]
  6387.         ifFalse: [elementSet first]! !
  6388.  
  6389. !SetDictionary methodsFor: 'accessing'!
  6390. at: key ifNotUnique: aBlock 
  6391.  
  6392.     | elementSet |
  6393.     elementSet := self at: key.
  6394.     ^elementSet size > 1
  6395.         ifTrue: [aBlock value]
  6396.         ifFalse: [elementSet first]! !
  6397.  
  6398. !SetDictionary methodsFor: 'accessing'!
  6399. elements
  6400.  
  6401.     | elements |
  6402.     elements := Set new.
  6403.     self do: [:set | elements addAll: set].
  6404.     ^elements! !
  6405.  
  6406. !SetDictionary methodsFor: 'adding'!
  6407. at: key add: anObject 
  6408.  
  6409.     (self at: key ifAbsent: [self at: key put: Set new])
  6410.         add: anObject! !
  6411.  
  6412. !SetDictionary methodsFor: 'adding'!
  6413. at: key addAll: aSet 
  6414.  
  6415.     (self at: key ifAbsent: [self at: key put: Set new])
  6416.         addAll: aSet! !
  6417.  
  6418. !SetDictionary methodsFor: 'testing'!
  6419. isDeterministic
  6420.  
  6421.     self associationsDo: [:assoc | assoc value size > 1 ifTrue: [^false]].
  6422.     ^true! !
  6423.  
  6424. !SetDictionary methodsFor: 'converting'!
  6425. asDictionary
  6426.  
  6427.     | newDict |
  6428.     self isDeterministic
  6429.         ifTrue: 
  6430.             [newDict := Dictionary new: self size.
  6431.             self associationsDo: [:assoc | newDict at: assoc key put: assoc value first].
  6432.             ^newDict]
  6433.         ifFalse: [self error: 'SetDictionary cannot be converted to a Dictionary']! !
  6434.  
  6435. !SetDictionary methodsFor: 'dictionary enumerating'!
  6436. elementsDo: aBlock 
  6437.     "Evaluate aBlock with each element of each of the receiver's set elements as the 
  6438.     argument."
  6439.  
  6440.     self elements do: [:element | aBlock value: element]! !
  6441.  
  6442. Object subclass: #OrderedPair
  6443.     instanceVariableNames: 'x y'
  6444.     classVariableNames: ''
  6445.     poolDictionaries: ''
  6446.     category: 'Kernel-Objects'!
  6447. OrderedPair comment:
  6448. '=================================================
  6449.     Copyright (c) 1992 by Justin O. Graver.
  6450.     All rights reserved (with exceptions).
  6451.     For complete information evaluate "Object tgenCopyright."
  6452. =================================================
  6453.  
  6454. An OrderedPair extends the concept of a Point from Numbers to Objects. It is often
  6455. convenient to associate two objects together or to return a pair of objects from a
  6456. method.  OrderedPair provides the mechanism to do this without the inconvenience
  6457. of verbose syntax (as would be required if an Array or OrderedCollection were used).
  6458. The main instance creation method for OrderedPairs is the binary operator @.  This
  6459. operator is defined in Object and (now) overridden in Number so that numerical
  6460. points are treated and created in the traditional manner.
  6461.  
  6462. instance variables:
  6463.     x    <Object>    the first component of the pair
  6464.     y    <Object>    the second component of the pair
  6465. '!
  6466.  
  6467. OrderedPair comment:
  6468. '=================================================
  6469.     Copyright (c) 1992 by Justin O. Graver.
  6470.     All rights reserved (with exceptions).
  6471.     For complete information evaluate "Object tgenCopyright."
  6472. =================================================
  6473.  
  6474. An OrderedPair extends the concept of a Point from Numbers to Objects. It is often
  6475. convenient to associate two objects together or to return a pair of objects from a
  6476. method.  OrderedPair provides the mechanism to do this without the inconvenience
  6477. of verbose syntax (as would be required if an Array or OrderedCollection were used).
  6478. The main instance creation method for OrderedPairs is the binary operator @.  This
  6479. operator is defined in Object and (now) overridden in Number so that numerical
  6480. points are treated and created in the traditional manner.
  6481.  
  6482. instance variables:
  6483.     x    <Object>    the first component of the pair
  6484.     y    <Object>    the second component of the pair
  6485. '!
  6486.  
  6487. !OrderedPair methodsFor: 'initialization'!
  6488. x: anObject y: anotherObject
  6489.     "initializes an OrderedPair"
  6490.  
  6491.     x := anObject.
  6492.     y := anotherObject.! !
  6493.  
  6494. !OrderedPair methodsFor: 'accessing'!
  6495. x
  6496.     "answer the first element of the pair"
  6497.  
  6498.     ^x! !
  6499.  
  6500. !OrderedPair methodsFor: 'accessing'!
  6501. y
  6502.     "answer the second element of the pair"
  6503.  
  6504.     ^y! !
  6505.  
  6506. !OrderedPair methodsFor: 'comparing'!
  6507. = anOrderedPair
  6508.     "answers whether two OrderedPairs are equal"
  6509.  
  6510.     ^self species = anOrderedPair species
  6511.         and: [(x = anOrderedPair x) & (y = anOrderedPair y)]! !
  6512.  
  6513. !OrderedPair methodsFor: 'comparing'!
  6514. hash
  6515.     "answer the receiver's hash value"
  6516.  
  6517.     ^(x hash bitShift: -1) + (y hash bitShift: -2)! !
  6518.  
  6519. !OrderedPair methodsFor: 'printing'!
  6520. printOn: aStream 
  6521.     "Append to the argument aStream a sequence of characters that identifies the receiver."
  6522.  
  6523.     x printOn: aStream.
  6524.     aStream nextPutAll: ' @ '.
  6525.     y printString printOn: aStream.! !
  6526.  
  6527. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6528.  
  6529. OrderedPair class
  6530.     instanceVariableNames: ''!
  6531.  
  6532. !OrderedPair class methodsFor: 'instance creation'!
  6533. x: anObject y: anotherObject
  6534.     "Answer a new OrderedPair whose x element is anObject and whose y element is anotherObject."
  6535.  
  6536.     ^self new x: anObject y: anotherObject! !
  6537.  
  6538. !Object methodsFor: 'converting'!
  6539. @ anObject
  6540.     "Answer an OrderedPair with the receiver as the x element and anObject as the y element."
  6541.  
  6542.     ^OrderedPair x: self y: anObject! !
  6543.  
  6544. !Object methodsFor: 'converting'!
  6545. reversePairWith: x
  6546.     "Answer a new OrderedPair whose x value is the argument and whose y value is the receiver."
  6547.  
  6548.     ^OrderedPair x: x y: self! !
  6549.  
  6550. !Number methodsFor: 'converting'!
  6551. @ y 
  6552.     "Answer a new pair (Point or OrderedPair or ...) whose x value is the receiver
  6553.     and whose y value is the argument.  Optional.  No Lookup.  See Object 
  6554.     documentation whatIsAPrimitive."
  6555.  
  6556.     <primitive: 18>
  6557.     ^y reversePairWith: self! !
  6558.  
  6559. !Number methodsFor: 'converting'!
  6560. reversePairWith: x
  6561.     "Answer a new Point whose x value is the argument and whose y value is the receiver."
  6562.  
  6563.     ^Point x: x y: self! !
  6564.  
  6565. OptimizedLR1Parser subclass: #BuildAEParser
  6566.     instanceVariableNames: ''
  6567.     classVariableNames: ''
  6568.     poolDictionaries: ''
  6569.     category: 'Build-Parsers'!
  6570. BuildAEParser comment:
  6571. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6572.  
  6573. BuildAEParser comment:
  6574. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6575.  
  6576. !BuildAEParser methodsFor: 'private'!
  6577. scannerClass
  6578.     ^BuildAEScanner! !
  6579.  
  6580. !BuildAEParser methodsFor: 'private'!
  6581. treeBuilderClass
  6582.     ^AbstractSyntaxTreeBuilder! !
  6583.  
  6584. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6585.  
  6586. BuildAEParser class
  6587.     instanceVariableNames: ''!
  6588.  
  6589. !BuildAEParser class methodsFor: 'class initialization'!
  6590. initialize
  6591.     "BuildAEParser initialize"
  6592.     "ArithmeticExpr    :  Expr ;
  6593.  
  6594. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  6595. STerm : PTerm | Term;
  6596.  
  6597. ModExpr : STerm;
  6598. ModExpr : STerm '%' STerm {BuildPTNMod };
  6599.  
  6600. MulExpr : ModExpr;
  6601. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  6602. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  6603.  
  6604. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  6605.       |  Expr '-' MulExpr {BuildPTNSub}
  6606.       | MulExpr;
  6607. ""Simple Terms""
  6608.  
  6609. Num : <number> {BuildPTNArgNum};
  6610. Term    : Num   ;
  6611. Term    : NegNum ;
  6612. Term : AlphaTerm;
  6613. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  6614. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  6615. Term    : PosNum ;
  6616. PosNum    : '+' Num ;
  6617. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  6618. NegNum    : '-' Num  {BuildPTNUSub};"
  6619.  
  6620.     | table prodTable |
  6621.     prodTable := #( #Num '+' $ '<ident>' '<number>' #Term #ModExpr '<variables>' '-' #PosNum #PTerm '(' #Expr #NegNum #ArithmeticExpr ')' #MulExpr '/' '*' '%' #AlphaTerm #STerm 'BuildPTNArgNum' 'BuildPTNDiv' 'BuildPTNMod' 'BuildPTNSub' 'BuildPTNAdd' 'BuildPTNArgVar' 'BuildPTNArgTerm' 'BuildPTNParenthesis' 'BuildPTNMul' 'BuildPTNUSub' ).
  6622.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  22).
  6623.     table := #( #( 2 3 nil 6 5 7 8 10 12 11 15 16 32 19 33 nil 28 nil nil nil 21 22 ) #( nil #(6 #(1 ))  #(6 #(1 ))  nil nil nil nil nil #(6 #(1 ))  nil nil nil nil nil nil #(6 #(1 ))  nil #(6 #(1 ))  #(6 #(1 ))  #(6 #(1 ))  nil nil ) #( 4 nil nil nil 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil #(10 #(2 1 ))  #(10 #(2 1 ))  nil nil nil nil nil #(10 #(2 1 ))  nil nil nil nil nil nil #(10 #(2 1 ))  nil #(10 #(2 1 ))  #(10 #(2 1 ))  #(10 #(2 1 ))  nil nil ) #( nil #(1 #(5 )23)  #(1 #(5 )23)  nil nil nil nil nil #(1 #(5 )23)  nil nil nil nil nil nil #(1 #(5 )23)  nil #(1 #(5 )23)  #(1 #(5 )23)  #(1 #(5 )23)  nil nil ) #( nil #(21 #(4 )29)  #(21 #(4 )29)  nil nil nil nil nil #(21 #(4 )29)  nil nil nil nil nil nil #(21 #(4 )29)  nil #(21 #(4 )29)  #(21 #(4 )29)  #(21 #(4 )29)  nil nil ) #( nil #(22 #(6 ))  #(22 #(6 ))  nil nil nil nil nil #(22 #(6 ))  nil nil nil nil nil nil #(22 #(6 ))  nil #(22 #(6 ))  #(22 #(6 ))  #(22 #(6 ))  nil nil ) #( nil #(17 #(7 ))  #(17 #(7 ))  nil nil nil nil nil #(17 #(7 ))  nil nil nil nil nil nil #(17 #(7 ))  nil 9 30 nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 29 nil nil nil 21 22 ) #( nil #(21 #(8 )28)  #(21 #(8 )28)  nil nil nil nil nil #(21 #(8 )28)  nil nil nil nil nil nil #(21 #(8 )28)  nil #(21 #(8 )28)  #(21 #(8 )28)  #(21 #(8 )28)  nil nil ) #( nil #(6 #(10 ))  #(6 #(10 ))  nil nil nil nil nil #(6 #(10 ))  nil nil nil nil nil nil #(6 #(10 ))  nil #(6 #(10 ))  #(6 #(10 ))  #(6 #(10 ))  nil nil ) #( 13 nil nil 6 5 nil nil 10 nil nil nil nil nil nil nil nil nil nil nil nil 14 nil ) #( nil #(14 #(9 1 )32)  #(14 #(9 1 )32)  nil nil nil nil nil #(14 #(9 1 )32)  nil nil nil nil nil nil #(14 #(9 1 )32)  nil #(14 #(9 1 )32)  #(14 #(9 1 )32)  #(14 #(9 1 )32)  nil nil ) #( nil #(14 #(9 21 )32)  #(14 #(9 21 )32)  nil nil nil nil nil #(14 #(9 21 )32)  nil nil nil nil nil nil #(14 #(9 21 )32)  nil #(14 #(9 21 )32)  #(14 #(9 21 )32)  #(14 #(9 21 )32)  nil nil ) #( nil #(22 #(11 ))  #(22 #(11 ))  nil nil nil nil nil #(22 #(11 ))  nil nil nil nil nil nil #(22 #(11 ))  nil #(22 #(11 ))  #(22 #(11 ))  #(22 #(11 ))  nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 17 19 nil nil 28 nil nil nil 21 22 ) #( nil 26 nil nil nil nil nil nil 18 nil nil nil nil nil nil 25 nil nil nil nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 20 nil nil nil 21 22 ) #( nil #(6 #(14 ))  #(6 #(14 ))  nil nil nil nil nil #(6 #(14 ))  nil nil nil nil nil nil #(6 #(14 ))  nil #(6 #(14 ))  #(6 #(14 ))  #(6 #(14 ))  nil nil ) #( nil #(13 #(13 9 17 )26)  #(13 #(13 9 17 )26)  nil nil nil nil nil #(13 #(13 9 17 )26)  nil nil nil nil nil nil #(13 #(13 9 17 )26)  nil nil nil nil nil nil ) #( nil #(6 #(21 ))  #(6 #(21 ))  nil nil nil nil nil #(6 #(21 ))  nil nil nil nil nil nil #(6 #(21 ))  nil #(6 #(21 ))  #(6 #(21 ))  #(6 #(21 ))  nil nil ) #( nil #(7 #(22 ))  #(7 #(22 ))  nil nil nil nil nil #(7 #(22 ))  nil nil nil nil nil nil #(7 #(22 ))  nil #(7 #(22 ))  #(7 #(22 ))  23 nil nil ) #( 2 3 nil 6 5 7 nil 10 12 11 15 16 nil 19 nil nil nil nil nil nil 21 24 ) #( nil #(7 #(22 20 22 )25)  #(7 #(22 20 22 )25)  nil nil nil nil nil #(7 #(22 20 22 )25)  nil nil nil nil nil nil #(7 #(22 20 22 )25)  nil #(7 #(22 20 22 )25)  #(7 #(22 20 22 )25)  nil nil nil ) #( nil #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  nil nil nil nil nil #(11 #(12 13 16 )30)  nil nil nil nil nil nil #(11 #(12 13 16 )30)  nil #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 27 nil nil nil 21 22 ) #( nil #(13 #(13 2 17 )27)  #(13 #(13 2 17 )27)  nil nil nil nil nil #(13 #(13 2 17 )27)  nil nil nil nil nil nil #(13 #(13 2 17 )27)  nil nil nil nil nil nil ) #( nil #(13 #(17 ))  #(13 #(17 ))  nil nil nil nil nil #(13 #(17 ))  nil nil nil nil nil nil #(13 #(17 ))  nil nil nil nil nil nil ) #( nil #(17 #(7 18 17 )24)  #(17 #(7 18 17 )24)  nil nil nil nil nil #(17 #(7 18 17 )24)  nil nil nil nil nil nil #(17 #(7 18 17 )24)  nil nil nil nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 31 nil nil nil 21 22 ) #( nil #(17 #(7 19 17 )31)  #(17 #(7 19 17 )31)  nil nil nil nil nil #(17 #(7 19 17 )31)  nil nil nil nil nil nil #(17 #(7 19 17 )31)  nil nil nil nil nil nil ) #( nil 26 #(15 #(13 ))  nil nil nil nil nil 18 nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil 34 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) ).
  6624.     self constructParseTable: table  with: prodTable.
  6625.     self finalState: 34! !
  6626.  
  6627. Object subclass: #BuildTFExpr
  6628.     instanceVariableNames: 'expression ast result currentValue currentArg stack lastResult avDictionary dvDictionary simulateWindow '
  6629.     classVariableNames: ''
  6630.     poolDictionaries: ''
  6631.     category: 'Build-Parsers'!
  6632.  
  6633. !BuildTFExpr methodsFor: 'evaluating'!
  6634. bottomUpTraverse
  6635.     ast isNil ifFalse: [self bottomUpTraverse: ast]! !
  6636.  
  6637. !BuildTFExpr methodsFor: 'evaluating'!
  6638. bottomUpTraverse: aNode 
  6639.     aNode isNil
  6640.         ifFalse: 
  6641.             [aNode left isNil ifFalse: [self bottomUpTraverse: aNode left].
  6642.             aNode right isNil ifFalse: [self bottomUpTraverse: aNode right]].
  6643.     aNode doOperation: self! !
  6644.  
  6645. !BuildTFExpr methodsFor: 'evaluating'!
  6646. evaluate
  6647.     self bottomUpTraverse.
  6648.     ^ast result! !
  6649.  
  6650. !BuildTFExpr methodsFor: 'initialization'!
  6651. initialize
  6652.     currentValue := 0.
  6653.     stack := OrderedCollection new! !
  6654.  
  6655. !BuildTFExpr methodsFor: 'variable access'!
  6656. ast: anAst 
  6657.     ast := anAst! !
  6658.  
  6659. !BuildTFExpr methodsFor: 'variable access'!
  6660. avDictionary
  6661.     ^avDictionary! !
  6662.  
  6663. !BuildTFExpr methodsFor: 'variable access'!
  6664. avDictionary: aDictionary 
  6665.     avDictionary := aDictionary! !
  6666.  
  6667. !BuildTFExpr methodsFor: 'variable access'!
  6668. currentArg: aValue 
  6669.     currentArg := aValue! !
  6670.  
  6671. !BuildTFExpr methodsFor: 'variable access'!
  6672. dvDictionary
  6673.     ^dvDictionary! !
  6674.  
  6675. !BuildTFExpr methodsFor: 'variable access'!
  6676. dvDictionary: aDictionary 
  6677.     dvDictionary := aDictionary! !
  6678.  
  6679. !BuildTFExpr methodsFor: 'variable access'!
  6680. expression
  6681.     ^expression! !
  6682.  
  6683. !BuildTFExpr methodsFor: 'variable access'!
  6684. expression: aString 
  6685.     expression := aString.! !
  6686.  
  6687. !BuildTFExpr methodsFor: 'variable access'!
  6688. getValueOfVariableNamed: aString 
  6689.     | temp |
  6690.     temp := simulateWindow valueOf: aString.
  6691.     temp isInteger
  6692.         ifTrue: [^temp]
  6693.         ifFalse: [(temp at: 1) isDigit
  6694.                 ifTrue: [^temp asNumber]
  6695.                 ifFalse: [^temp]]! !
  6696.  
  6697. !BuildTFExpr methodsFor: 'variable access'!
  6698. getValueOfVariableNamedOld: aString 
  6699.     | temp |
  6700.     (temp := dvDictionary at: aString ifAbsent: [^nil]) isNil
  6701.         ifTrue: [^temp := avDictionary at: aString ifAbsent: [^nil]]
  6702.         ifFalse: [^temp asNumber]! !
  6703.  
  6704. !BuildTFExpr methodsFor: 'variable access'!
  6705. lastResult
  6706.     ^lastResult! !
  6707.  
  6708. !BuildTFExpr methodsFor: 'variable access'!
  6709. lastResult: aValue 
  6710.     lastResult := aValue! !
  6711.  
  6712. !BuildTFExpr methodsFor: 'variable access'!
  6713. result
  6714.     ^result! !
  6715.  
  6716. !BuildTFExpr methodsFor: 'variable access'!
  6717. simulateWindow
  6718.     ^simulateWindow! !
  6719.  
  6720. !BuildTFExpr methodsFor: 'variable access'!
  6721. simulateWindow: aSimulateWindow 
  6722.     simulateWindow := aSimulateWindow! !
  6723.  
  6724. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6725.  
  6726. BuildTFExpr class
  6727.     instanceVariableNames: ''!
  6728.  
  6729. !BuildTFExpr class methodsFor: 'instance creation'!
  6730. new
  6731.     ^super new initialize! !
  6732.  
  6733. !BuildTFExpr class methodsFor: 'instance creation'!
  6734. valueWithAST: anAST withAVs: dict1 withDVs: dict2 
  6735.     ^(self new) ast: anAST; avDictionary: dict1; dvDictionary: dict2; evaluate! !
  6736.  
  6737. !BuildTFExpr class methodsFor: 'instance creation'!
  6738. valueWithAST: anAST withSw: aSimulateWindow 
  6739.     ^(self new) ast: anAST; simulateWindow: aSimulateWindow; evaluate! !
  6740.  
  6741. OptimizedLR1Parser subclass: #BuildTFParser
  6742.     instanceVariableNames: ''
  6743.     classVariableNames: ''
  6744.     poolDictionaries: ''
  6745.     category: 'Build-Parsers'!
  6746. BuildTFParser comment:
  6747. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6748.  
  6749. BuildTFParser comment:
  6750. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6751.  
  6752. !BuildTFParser methodsFor: 'private'!
  6753. scannerClass
  6754.     ^BuildTFScanner! !
  6755.  
  6756. !BuildTFParser methodsFor: 'private'!
  6757. treeBuilderClass
  6758.     ^AbstractSyntaxTreeBuilder! !
  6759.  
  6760. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6761.  
  6762. BuildTFParser class
  6763.     instanceVariableNames: ''!
  6764.  
  6765. !BuildTFParser class methodsFor: 'class initialization'!
  6766. initialize
  6767.     "BuildTFParser initialize"
  6768.     "ArithmeticExpr    :  Ass ;
  6769.  
  6770. Ass :  T;
  6771. Ass : Ass ',' T{BuildPTNSeq};
  6772. T : AlphaTerm ':' Expr {BuildPTNAss};
  6773. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  6774. STerm : PTerm | Term;
  6775.  
  6776. ModExpr : STerm;
  6777. ModExpr : STerm '%' STerm {BuildPTNMod };
  6778.  
  6779. MulExpr : ModExpr;
  6780. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  6781. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  6782.  
  6783. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  6784.       |  Expr '-' MulExpr {BuildPTNSub}
  6785.       | MulExpr;
  6786.  
  6787.  
  6788. ""Simple Terms""
  6789.  
  6790. Num : <number> {BuildPTNArgNum};
  6791. Term    : Num   ;
  6792. Term    : NegNum ;
  6793. Term : AlphaTerm;
  6794. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  6795. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  6796. Term    : PosNum ;
  6797. PosNum    : '+' Num ;
  6798. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  6799. NegNum    : '-' Num  {BuildPTNUSub};"
  6800.  
  6801.     | table prodTable |
  6802.     prodTable := #( #Num '+' $ '<ident>' '<number>' ',' #Term #ModExpr '<variables>' '-' #PosNum #PTerm '(' #Expr #T #NegNum #ArithmeticExpr #Ass ')' #MulExpr '/' '*' ':' '%' #AlphaTerm #STerm 'BuildPTNArgNum' 'BuildPTNAss' 'BuildPTNDiv' 'BuildPTNMod' 'BuildPTNSub' 'BuildPTNAdd' 'BuildPTNArgVar' 'BuildPTNArgTerm' 'BuildPTNParenthesis' 'BuildPTNMul' 'BuildPTNSeq' 'BuildPTNUSub' ).
  6803.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  26).
  6804.     table := #( #( nil nil nil 10 nil nil nil nil 14 nil nil nil nil nil 37 nil 2 38 nil nil nil nil nil nil 4 nil ) #( nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 36 nil 23 nil nil nil 32 nil nil nil nil 25 26 ) #( nil #(7 #(1 ))  #(7 #(1 ))  nil nil #(7 #(1 ))  nil nil nil #(7 #(1 ))  nil nil nil nil nil nil nil nil #(7 #(1 ))  nil #(7 #(1 ))  #(7 #(1 ))  nil #(7 #(1 ))  nil nil ) #( 8 nil nil nil 9 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil #(11 #(2 1 ))  #(11 #(2 1 ))  nil nil #(11 #(2 1 ))  nil nil nil #(11 #(2 1 ))  nil nil nil nil nil nil nil nil #(11 #(2 1 ))  nil #(11 #(2 1 ))  #(11 #(2 1 ))  nil #(11 #(2 1 ))  nil nil ) #( nil #(1 #(5 )27)  #(1 #(5 )27)  nil nil #(1 #(5 )27)  nil nil nil #(1 #(5 )27)  nil nil nil nil nil nil nil nil #(1 #(5 )27)  nil #(1 #(5 )27)  #(1 #(5 )27)  nil #(1 #(5 )27)  nil nil ) #( nil #(25 #(4 )34)  #(25 #(4 )34)  nil nil #(25 #(4 )34)  nil nil nil #(25 #(4 )34)  nil nil nil nil nil nil nil nil #(25 #(4 )34)  nil #(25 #(4 )34)  #(25 #(4 )34)  #(25 #(4 )34)  #(25 #(4 )34)  nil nil ) #( nil #(26 #(7 ))  #(26 #(7 ))  nil nil #(26 #(7 ))  nil nil nil #(26 #(7 ))  nil nil nil nil nil nil nil nil #(26 #(7 ))  nil #(26 #(7 ))  #(26 #(7 ))  nil #(26 #(7 ))  nil nil ) #( nil #(20 #(8 ))  #(20 #(8 ))  nil nil #(20 #(8 ))  nil nil nil #(20 #(8 ))  nil nil nil nil nil nil nil nil #(20 #(8 ))  nil 13 34 nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 33 nil nil nil nil 25 26 ) #( nil #(25 #(9 )33)  #(25 #(9 )33)  nil nil #(25 #(9 )33)  nil nil nil #(25 #(9 )33)  nil nil nil nil nil nil nil nil #(25 #(9 )33)  nil #(25 #(9 )33)  #(25 #(9 )33)  #(25 #(9 )33)  #(25 #(9 )33)  nil nil ) #( nil #(7 #(11 ))  #(7 #(11 ))  nil nil #(7 #(11 ))  nil nil nil #(7 #(11 ))  nil nil nil nil nil nil nil nil #(7 #(11 ))  nil #(7 #(11 ))  #(7 #(11 ))  nil #(7 #(11 ))  nil nil ) #( 17 nil nil 10 9 nil nil nil 14 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 18 nil ) #( nil #(16 #(10 1 )38)  #(16 #(10 1 )38)  nil nil #(16 #(10 1 )38)  nil nil nil #(16 #(10 1 )38)  nil nil nil nil nil nil nil nil #(16 #(10 1 )38)  nil #(16 #(10 1 )38)  #(16 #(10 1 )38)  nil #(16 #(10 1 )38)  nil nil ) #( nil #(16 #(10 25 )38)  #(16 #(10 25 )38)  nil nil #(16 #(10 25 )38)  nil nil nil #(16 #(10 25 )38)  nil nil nil nil nil nil nil nil #(16 #(10 25 )38)  nil #(16 #(10 25 )38)  #(16 #(10 25 )38)  nil #(16 #(10 25 )38)  nil nil ) #( nil #(26 #(12 ))  #(26 #(12 ))  nil nil #(26 #(12 ))  nil nil nil #(26 #(12 ))  nil nil nil nil nil nil nil nil #(26 #(12 ))  nil #(26 #(12 ))  #(26 #(12 ))  nil #(26 #(12 ))  nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 21 nil 23 nil nil nil 32 nil nil nil nil 25 26 ) #( nil 30 nil nil nil nil nil nil nil 22 nil nil nil nil nil nil nil nil 29 nil nil nil nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 24 nil nil nil nil 25 26 ) #( nil #(7 #(16 ))  #(7 #(16 ))  nil nil #(7 #(16 ))  nil nil nil #(7 #(16 ))  nil nil nil nil nil nil nil nil #(7 #(16 ))  nil #(7 #(16 ))  #(7 #(16 ))  nil #(7 #(16 ))  nil nil ) #( nil #(14 #(14 10 20 )31)  #(14 #(14 10 20 )31)  nil nil #(14 #(14 10 20 )31)  nil nil nil #(14 #(14 10 20 )31)  nil nil nil nil nil nil nil nil #(14 #(14 10 20 )31)  nil nil nil nil nil nil nil ) #( nil #(7 #(25 ))  #(7 #(25 ))  nil nil #(7 #(25 ))  nil nil nil #(7 #(25 ))  nil nil nil nil nil nil nil nil #(7 #(25 ))  nil #(7 #(25 ))  #(7 #(25 ))  nil #(7 #(25 ))  nil nil ) #( nil #(8 #(26 ))  #(8 #(26 ))  nil nil #(8 #(26 ))  nil nil nil #(8 #(26 ))  nil nil nil nil nil nil nil nil #(8 #(26 ))  nil #(8 #(26 ))  #(8 #(26 ))  nil 27 nil nil ) #( 6 7 nil 10 9 nil 11 nil 14 16 15 19 20 nil nil 23 nil nil nil nil nil nil nil nil 25 28 ) #( nil #(8 #(26 24 26 )30)  #(8 #(26 24 26 )30)  nil nil #(8 #(26 24 26 )30)  nil nil nil #(8 #(26 24 26 )30)  nil nil nil nil nil nil nil nil #(8 #(26 24 26 )30)  nil #(8 #(26 24 26 )30)  #(8 #(26 24 26 )30)  nil nil nil nil ) #( nil #(12 #(13 14 19 )35)  #(12 #(13 14 19 )35)  nil nil #(12 #(13 14 19 )35)  nil nil nil #(12 #(13 14 19 )35)  nil nil nil nil nil nil nil nil #(12 #(13 14 19 )35)  nil #(12 #(13 14 19 )35)  #(12 #(13 14 19 )35)  nil #(12 #(13 14 19 )35)  nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 31 nil nil nil nil 25 26 ) #( nil #(14 #(14 2 20 )32)  #(14 #(14 2 20 )32)  nil nil #(14 #(14 2 20 )32)  nil nil nil #(14 #(14 2 20 )32)  nil nil nil nil nil nil nil nil #(14 #(14 2 20 )32)  nil nil nil nil nil nil nil ) #( nil #(14 #(20 ))  #(14 #(20 ))  nil nil #(14 #(20 ))  nil nil nil #(14 #(20 ))  nil nil nil nil nil nil nil nil #(14 #(20 ))  nil nil nil nil nil nil nil ) #( nil #(20 #(8 21 20 )29)  #(20 #(8 21 20 )29)  nil nil #(20 #(8 21 20 )29)  nil nil nil #(20 #(8 21 20 )29)  nil nil nil nil nil nil nil nil #(20 #(8 21 20 )29)  nil nil nil nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 35 nil nil nil nil 25 26 ) #( nil #(20 #(8 22 20 )36)  #(20 #(8 22 20 )36)  nil nil #(20 #(8 22 20 )36)  nil nil nil #(20 #(8 22 20 )36)  nil nil nil nil nil nil nil nil #(20 #(8 22 20 )36)  nil nil nil nil nil nil nil ) #( nil 30 #(15 #(25 23 14 )28)  nil nil #(15 #(25 23 14 )28)  nil nil nil 22 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil #(18 #(15 ))  nil nil #(18 #(15 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil #(17 #(18 ))  nil nil 39 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil 10 nil nil nil nil 14 nil nil nil nil nil 40 nil nil nil nil nil nil nil nil nil 4 nil ) #( nil nil #(18 #(18 6 15 )37)  nil nil #(18 #(18 6 15 )37)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) ).
  6805.     self constructParseTable: table  with: prodTable.
  6806.     self finalState: 3! !
  6807.  
  6808. OptimizedLR1Parser subclass: #BuildBoolParser
  6809.     instanceVariableNames: ''
  6810.     classVariableNames: ''
  6811.     poolDictionaries: ''
  6812.     category: 'Build-Parsers'!
  6813. BuildBoolParser comment:
  6814. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6815.  
  6816. BuildBoolParser comment:
  6817. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  6818.  
  6819. !BuildBoolParser methodsFor: 'private'!
  6820. scannerClass
  6821.     ^BuildBoolScanner! !
  6822.  
  6823. !BuildBoolParser methodsFor: 'private'!
  6824. treeBuilderClass
  6825.     ^AbstractSyntaxTreeBuilder! !
  6826.  
  6827. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6828.  
  6829. BuildBoolParser class
  6830.     instanceVariableNames: ''!
  6831.  
  6832. !BuildBoolParser class methodsFor: 'class initialization'!
  6833. initialize
  6834.     "BuildBoolParser initialize"
  6835.     "    ""Boolean Expressions""
  6836. S : BExpr;
  6837. BExpr : BTerm ;
  6838. BExpr : BExpr ',' BTerm{BuildPTNAND };
  6839. ""BExpr : '(' BExpr ')'{BuildPTNParenthesis};""
  6840. BExpr : BExpr ';' BTerm{BuildPTNOR };
  6841.  
  6842. ""PBTerm2 : '(' BTerm ')'{BuildPTNParenthesis};""
  6843. PBTerm2 : '(' BExpr ')'{BuildPTNParenthesis};
  6844. BTerm :  ABExpr  | 'true' | 'false' | PBTerm2 ;
  6845.  
  6846. ""Arithmetic relational operators""
  6847. ABExpr :  ANEQ | AGT | ALT | AGTE | ALTE | ANNEQ;
  6848. ANNEQ : ArithmeticExpr '#' ArithmeticExpr{BuildPTNNEQ };
  6849. ANEQ : ArithmeticExpr '=' ArithmeticExpr {BuildPTNEQ };
  6850. AGT : ArithmeticExpr '>' ArithmeticExpr  {BuildPTNGT };
  6851. ALT : ArithmeticExpr '<' ArithmeticExpr{BuildPTNLT };
  6852. AGTE : ArithmeticExpr '>=' ArithmeticExpr{BuildPTNGTE };
  6853. ALTE : ArithmeticExpr '=<' ArithmeticExpr{BuildPTNLTE };
  6854.  
  6855.  
  6856. ArithmeticExpr    :  Expr ;
  6857. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  6858. STerm : PTerm | Term;
  6859.  
  6860. ModExpr : STerm;
  6861. ModExpr : STerm '%' STerm {BuildPTNMod };
  6862.  
  6863. MulExpr : ModExpr;
  6864. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  6865. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  6866.  
  6867. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  6868.       |  Expr '-' MulExpr {BuildPTNSub}
  6869.       | MulExpr;
  6870.  
  6871.  
  6872. ""Simple Terms""
  6873.  
  6874. Num : <number> {BuildPTNArgNum};
  6875. Term    : Num   ;
  6876. Term    : NegNum ;
  6877. Term : AlphaTerm;
  6878. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  6879. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  6880. Term    : PosNum ;
  6881. PosNum    : '+' Num ;
  6882. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  6883. NegNum    : '-' Num  {BuildPTNUSub};
  6884. "
  6885.  
  6886.     | table prodTable |
  6887.     prodTable := #( #ModExpr #PosNum #PBTerm2 $ '=' ')' #ALTE #ABExpr '<' '>=' '(' #STerm #PTerm #NegNum ';' '=<' #AGTE #BTerm #S '/' '<variables>' '%' #Term #AlphaTerm #ALT #Num #ANEQ #BExpr '-' '#' 'false' #Expr ',' #AGT '<ident>' '<number>' #MulExpr #ArithmeticExpr #ANNEQ '+' 'true' '>' '*' 'BuildPTNAND' 'BuildPTNUSub' 'BuildPTNGT' 'BuildPTNArgNum' 'BuildPTNLT' 'BuildPTNOR' 'BuildPTNMod' 'BuildPTNArgVar' 'BuildPTNAdd' 'BuildPTNNEQ' 'BuildPTNGTE' 'BuildPTNLTE' 'BuildPTNEQ' 'BuildPTNParenthesis' 'BuildPTNDiv' 'BuildPTNMul' 'BuildPTNArgTerm' 'BuildPTNSub' ).
  6888.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  43).
  6889.     table := #( #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 37 65 nil 10 nil 9 21 38 4 39 67 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(37 #(1 ))  #(37 #(1 ))  #(37 #(1 ))  nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil nil 3 nil nil nil nil nil nil nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil #(37 #(1 ))  nil nil nil nil nil nil #(37 #(1 ))  nil #(37 #(1 ))  30 ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 29 nil nil 5 nil nil nil ) #( nil nil nil #(23 #(26 ))  #(23 #(26 ))  #(23 #(26 ))  nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil nil #(23 #(26 ))  nil #(23 #(26 ))  nil nil nil nil nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil #(23 #(26 ))  nil nil nil nil nil nil #(23 #(26 ))  nil #(23 #(26 ))  #(23 #(26 ))  ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 nil nil nil nil nil nil nil nil nil 7 nil nil nil nil nil nil nil ) #( nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil nil #(2 #(40 26 ))  nil #(2 #(40 26 ))  nil nil nil nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil #(2 #(40 26 ))  nil nil nil nil nil nil #(2 #(40 26 ))  nil #(2 #(40 26 ))  #(2 #(40 26 ))  ) #( nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  #(26 #(36 )47)  nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil nil #(26 #(36 )47)  nil #(26 #(36 )47)  nil nil nil nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil #(26 #(36 )47)  nil nil nil nil nil nil #(26 #(36 )47)  nil #(26 #(36 )47)  #(26 #(36 )47)  ) #( nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  #(24 #(35 )60)  nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil nil #(24 #(35 )60)  nil #(24 #(35 )60)  nil nil nil nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil #(24 #(35 )60)  nil nil nil nil nil nil #(24 #(35 )60)  nil #(24 #(35 )60)  #(24 #(35 )60)  ) #( nil nil nil #(12 #(23 ))  #(12 #(23 ))  #(12 #(23 ))  nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil nil #(12 #(23 ))  nil #(12 #(23 ))  nil nil nil nil nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil #(12 #(23 ))  nil nil nil nil nil nil #(12 #(23 ))  nil #(12 #(23 ))  #(12 #(23 ))  ) #( nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  #(24 #(21 )51)  nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil nil #(24 #(21 )51)  nil #(24 #(21 )51)  nil nil nil nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil #(24 #(21 )51)  nil nil nil nil nil nil #(24 #(21 )51)  nil #(24 #(21 )51)  #(24 #(21 )51)  ) #( nil nil nil #(23 #(2 ))  #(23 #(2 ))  #(23 #(2 ))  nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil nil #(23 #(2 ))  nil #(23 #(2 ))  nil nil nil nil nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil #(23 #(2 ))  nil nil nil nil nil nil #(23 #(2 ))  nil #(23 #(2 ))  #(23 #(2 ))  ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 10 nil nil 14 nil 13 nil nil nil nil nil nil nil nil 8 7 nil nil nil nil nil nil nil ) #( nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil nil #(14 #(29 26 )45)  nil #(14 #(29 26 )45)  nil nil nil nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil #(14 #(29 26 )45)  nil nil nil nil nil nil #(14 #(29 26 )45)  nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  ) #( nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil nil #(14 #(29 24 )45)  nil #(14 #(29 24 )45)  nil nil nil nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil #(14 #(29 24 )45)  nil nil nil nil nil nil #(14 #(29 24 )45)  nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  ) #( nil nil nil #(12 #(13 ))  #(12 #(13 ))  #(12 #(13 ))  nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil nil #(12 #(13 ))  nil #(12 #(13 ))  nil nil nil nil nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil #(12 #(13 ))  nil nil nil nil nil nil #(12 #(13 ))  nil #(12 #(13 ))  #(12 #(13 ))  ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 17 nil nil 8 7 28 nil nil 5 nil nil nil ) #( nil nil nil nil nil 25 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 18 nil nil nil nil nil nil nil nil nil nil 26 nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 20 nil nil 5 nil nil nil ) #( nil nil nil #(23 #(14 ))  #(23 #(14 ))  #(23 #(14 ))  nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil nil #(23 #(14 ))  nil #(23 #(14 ))  nil nil nil nil nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil #(23 #(14 ))  nil nil nil nil nil nil #(23 #(14 ))  nil #(23 #(14 ))  #(23 #(14 ))  ) #( nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil #(32 #(32 29 37 )61)  nil nil nil nil nil nil #(32 #(32 29 37 )61)  nil #(32 #(32 29 37 )61)  nil ) #( nil nil nil #(23 #(24 ))  #(23 #(24 ))  #(23 #(24 ))  nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil nil #(23 #(24 ))  nil #(23 #(24 ))  nil nil nil nil nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil #(23 #(24 ))  nil nil nil nil nil nil #(23 #(24 ))  nil #(23 #(24 ))  #(23 #(24 ))  ) #( nil nil nil #(1 #(12 ))  #(1 #(12 ))  #(1 #(12 ))  nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil nil #(1 #(12 ))  nil 23 nil nil nil nil nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil #(1 #(12 ))  nil nil nil nil nil nil #(1 #(12 ))  nil #(1 #(12 ))  #(1 #(12 ))  ) #( nil 11 nil nil nil nil nil nil nil nil 16 24 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 nil nil nil 5 nil nil nil ) #( nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil nil #(1 #(12 22 12 )50)  nil nil nil nil nil nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil #(1 #(12 22 12 )50)  nil nil nil nil nil nil #(1 #(12 22 12 )50)  nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  ) #( nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil nil #(13 #(11 32 6 )57)  nil #(13 #(11 32 6 )57)  nil nil nil nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil #(13 #(11 32 6 )57)  nil nil nil nil nil nil #(13 #(11 32 6 )57)  nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 27 nil nil 5 nil nil nil ) #( nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil #(32 #(32 40 37 )52)  nil nil nil nil nil nil #(32 #(32 40 37 )52)  nil #(32 #(32 40 37 )52)  nil ) #( nil nil nil #(32 #(37 ))  #(32 #(37 ))  #(32 #(37 ))  nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil #(32 #(37 ))  nil nil nil nil nil nil #(32 #(37 ))  nil #(32 #(37 ))  nil ) #( nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil nil nil nil nil nil nil nil nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil #(37 #(1 20 37 )58)  nil nil nil nil nil nil #(37 #(1 20 37 )58)  nil #(37 #(1 20 37 )58)  nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 31 nil nil 5 nil nil nil ) #( nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil nil nil nil nil nil nil nil nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil #(37 #(1 43 37 )59)  nil nil nil nil nil nil #(37 #(1 43 37 )59)  nil #(37 #(1 43 37 )59)  nil ) #( nil nil nil #(18 #(3 ))  nil #(18 #(3 ))  nil nil nil nil nil nil nil nil #(18 #(3 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(3 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(7 ))  nil #(8 #(7 ))  nil nil nil nil nil nil nil nil #(8 #(7 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(7 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(8 ))  nil #(18 #(8 ))  nil nil nil nil nil nil nil nil #(18 #(8 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(8 ))  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 37 nil nil 10 nil 9 21 38 4 39 40 12 nil 43 64 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(8 #(17 ))  nil #(8 #(17 ))  nil nil nil nil nil nil nil nil #(8 #(17 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(17 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(28 #(18 ))  nil #(28 #(18 ))  nil nil nil nil nil nil nil nil #(28 #(18 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(18 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(25 ))  nil #(8 #(25 ))  nil nil nil nil nil nil nil nil #(8 #(25 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(25 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(27 ))  nil #(8 #(27 ))  nil nil nil nil nil nil nil nil #(8 #(27 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(27 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil 61 nil nil nil nil nil nil nil nil 41 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 42 nil nil 10 nil 9 21 38 4 39 nil 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(28 #(28 15 18 )49)  nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(31 ))  nil #(18 #(31 ))  nil nil nil nil nil nil nil nil #(18 #(31 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(31 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(38 #(32 ))  #(38 #(32 ))  #(38 #(32 ))  nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil nil nil nil nil nil nil nil nil 18 #(38 #(32 ))  nil nil #(38 #(32 ))  nil nil nil nil nil nil 26 nil #(38 #(32 ))  nil ) #( nil nil nil #(8 #(34 ))  nil #(8 #(34 ))  nil nil nil nil nil nil nil nil #(8 #(34 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(34 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil 55 nil nil nil 47 49 nil nil nil nil nil 53 nil nil nil nil nil nil nil nil nil nil nil nil nil 57 nil nil nil nil nil nil nil nil nil nil nil 51 nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 48 nil 5 nil nil nil ) #( nil nil nil #(25 #(38 9 38 )48)  nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 50 nil 5 nil nil nil ) #( nil nil nil #(17 #(38 10 38 )54)  nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 52 nil 5 nil nil nil ) #( nil nil nil #(34 #(38 42 38 )46)  nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 54 nil 5 nil nil nil ) #( nil nil nil #(7 #(38 16 38 )55)  nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 56 nil 5 nil nil nil ) #( nil nil nil #(27 #(38 5 38 )56)  nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 58 nil 5 nil nil nil ) #( nil nil nil #(39 #(38 30 38 )53)  nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(39 ))  nil #(8 #(39 ))  nil nil nil nil nil nil nil nil #(8 #(39 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(39 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(41 ))  nil #(18 #(41 ))  nil nil nil nil nil nil nil nil #(18 #(41 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(41 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(3 #(11 28 6 )57)  nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 63 nil nil 10 nil 9 21 38 4 39 nil 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(28 #(28 33 18 )44)  nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil #(38 #(32 ))  25 nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil nil #(38 #(32 ))  nil nil nil nil nil nil nil nil nil nil nil nil 18 #(38 #(32 ))  nil nil nil nil nil nil nil nil nil 26 nil #(38 #(32 ))  nil ) #( nil nil nil 66 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(19 #(28 ))  nil nil nil nil nil nil nil nil nil nil 41 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil nil nil nil nil nil nil nil ) ).
  6890.     self constructParseTable: table  with: prodTable.
  6891.     self finalState: 66! !
  6892.  
  6893. OptimizedScanner subclass: #BuildAEScanner
  6894.     instanceVariableNames: ''
  6895.     classVariableNames: ''
  6896.     poolDictionaries: ''
  6897.     category: 'Build-Parsers'!
  6898. BuildAEScanner comment:
  6899. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6900.  
  6901. BuildAEScanner comment:
  6902. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6903.  
  6904. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6905.  
  6906. BuildAEScanner class
  6907.     instanceVariableNames: ''!
  6908.  
  6909. !BuildAEScanner class methodsFor: 'class initialization'!
  6910. initialize
  6911.     "BuildAEScanner initialize"
  6912.     " <ident> : [a-z][a-zA-Z0-9_]*;
  6913.  <variables> : [A-Z][a-zA-Z0-9_]*;
  6914. <number> : [1-9][0-9]* | [0];
  6915. <space> : [\s\t\r]+ {ignoreDelimiter};"
  6916.  
  6917.     | table |
  6918.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 3 nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil 6 nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil 7 nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) ).
  6919.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' '*' ')' ':' '(' '/' '%' '-' ',' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( ) #( #('<ident>' nil) ) ) ).
  6920.     self constructFinalStateTable: table! !
  6921.  
  6922. OptimizedScanner subclass: #BuildBoolScanner
  6923.     instanceVariableNames: ''
  6924.     classVariableNames: ''
  6925.     poolDictionaries: ''
  6926.     category: 'Build-Parsers'!
  6927. BuildBoolScanner comment:
  6928. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6929.  
  6930. BuildBoolScanner comment:
  6931. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6932.  
  6933. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6934.  
  6935. BuildBoolScanner class
  6936.     instanceVariableNames: ''!
  6937.  
  6938. !BuildBoolScanner class methodsFor: 'class initialization'!
  6939. initialize
  6940.     "BuildBoolScanner initialize"
  6941.     " <ident> : [a-z][a-zA-Z0-9_]*;
  6942.  <variables> : [A-Z][a-zA-Z0-9_]*;
  6943. <number> : [1-9][0-9]* | [0];
  6944. <space> : [\s\t\r]+ {ignoreDelimiter};"
  6945.  
  6946.     | table |
  6947.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil 3 nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 nil 3 3 6 7 nil nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil nil nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil 8 nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil 9 nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil ) ).
  6948.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' ';' ',' '<' '-' '(' '#' ')' '=<' '/' '*' '%' '>=' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( '=' ) #( ) ) #( #( '>' ) #( ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( 'true' 'false' ) #( #('<ident>' nil) ) ) ).
  6949.     self constructFinalStateTable: table! !
  6950.  
  6951. OptimizedScanner subclass: #BuildTFScanner
  6952.     instanceVariableNames: ''
  6953.     classVariableNames: ''
  6954.     poolDictionaries: ''
  6955.     category: 'Build-Parsers'!
  6956. BuildTFScanner comment:
  6957. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6958.  
  6959. BuildTFScanner comment:
  6960. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  6961.  
  6962. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  6963.  
  6964. BuildTFScanner class
  6965.     instanceVariableNames: ''!
  6966.  
  6967. !BuildTFScanner class methodsFor: 'class initialization'!
  6968. initialize
  6969.     "BuildTFScanner initialize"
  6970.     " <ident> : [a-z][a-zA-Z0-9_]*;
  6971.  <variables> : [A-Z][a-zA-Z0-9_]*;
  6972. <number> : [1-9][0-9]* | [0];
  6973. <space> : [\s\t\r]+ {ignoreDelimiter};"
  6974.  
  6975.     | table |
  6976.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 3 nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil 6 nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil 7 nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) ).
  6977.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' '*' ')' ':' '(' '/' '%' '-' ',' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( ) #( #('<ident>' nil) ) ) ).
  6978.     self constructFinalStateTable: table! !
  6979.  
  6980. ParseTreeNode subclass: #BuildParseTreeNode
  6981.     instanceVariableNames: 'left right children result error rhsVars '
  6982.     classVariableNames: ''
  6983.     poolDictionaries: ''
  6984.     category: 'Build-Parsers'!
  6985.  
  6986. !BuildParseTreeNode methodsFor: 'evaluating'!
  6987. evaluateFromExpr: aBuildTFExpr! !
  6988.  
  6989. !BuildParseTreeNode methodsFor: 'variable access'!
  6990. left
  6991.     children isNil
  6992.         ifTrue: [^nil]
  6993.         ifFalse: [children size = 0 ifFalse: [^children at: 1]
  6994.                 ifTrue: [^nil]]! !
  6995.  
  6996. !BuildParseTreeNode methodsFor: 'variable access'!
  6997. result
  6998.     ^result! !
  6999.  
  7000. !BuildParseTreeNode methodsFor: 'variable access'!
  7001. rhsVars
  7002.     "This variable passes the names of the variables appearing in the 
  7003.     sub-tree"
  7004.  
  7005.     ^rhsVars! !
  7006.  
  7007. !BuildParseTreeNode methodsFor: 'variable access'!
  7008. right
  7009.     children isNil
  7010.         ifTrue: [^nil]
  7011.         ifFalse: [children size < 2 ifFalse: [^children at: 2]
  7012.                 ifTrue: [^nil]]! !
  7013.  
  7014. !BuildParseTreeNode methodsFor: 'access'!
  7015. addChildrenFirst: anOrderedCollection 
  7016.     anOrderedCollection do: [:x | children addFirst: x].
  7017.     rhsVars := OrderedCollection new.
  7018.     children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]! !
  7019.  
  7020. !BuildParseTreeNode methodsFor: 'access'!
  7021. addChildrenInitial: anOrderedCollection 
  7022.     children := anOrderedCollection.
  7023.     rhsVars := OrderedCollection new.
  7024.     children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]! !
  7025.  
  7026. !BuildParseTreeNode methodsFor: 'access'!
  7027. addChildrenLast: anOrderedCollection 
  7028.     children notNil
  7029.         ifTrue: [anOrderedCollection do: [:x | children addLast: x]]
  7030.         ifFalse: 
  7031.             [children := anOrderedCollection.
  7032.             rhsVars := OrderedCollection new.
  7033.             children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]]! !
  7034.  
  7035. BuildParseTreeNode subclass: #BuildPTNArg
  7036.     instanceVariableNames: 'value expr '
  7037.     classVariableNames: ''
  7038.     poolDictionaries: ''
  7039.     category: 'Build-Parsers'!
  7040.  
  7041. !BuildPTNArg methodsFor: 'evaluating'!
  7042. doOperation: e 
  7043.     expr := e.
  7044.     ^result := self actualValue! !
  7045.  
  7046. !BuildPTNArg methodsFor: 'access'!
  7047. actualValue
  7048.     "Sub-Class Responsibility"
  7049.  
  7050.     ^self! !
  7051.  
  7052. !BuildPTNArg methodsFor: 'access'!
  7053. expr
  7054.     ^expr! !
  7055.  
  7056. !BuildPTNArg methodsFor: 'access'!
  7057. expr: anExpr 
  7058.     expr := anExpr! !
  7059.  
  7060. !BuildPTNArg methodsFor: 'access'!
  7061. setAttribute: aValue 
  7062.     value := aValue! !
  7063.  
  7064. !BuildPTNArg methodsFor: 'access'!
  7065. value
  7066.     ^value! !
  7067.  
  7068. BuildPTNArg subclass: #BuildPTNArgVar
  7069.     instanceVariableNames: ''
  7070.     classVariableNames: ''
  7071.     poolDictionaries: ''
  7072.     category: 'Build-Parsers'!
  7073.  
  7074. !BuildPTNArgVar methodsFor: 'access'!
  7075. actualValue
  7076.     ^result := expr getValueOfVariableNamed: value! !
  7077.  
  7078. !BuildPTNArgVar methodsFor: 'access'!
  7079. addChildrenInitial: anOrderedCollection 
  7080.     super addChildrenInitial: anOrderedCollection.
  7081.     "value := OrderedCollection with: (children at: 1) value"! !
  7082.  
  7083. !BuildPTNArgVar methodsFor: 'access'!
  7084. setAttribute: aValue 
  7085.     super setAttribute: aValue.
  7086.     rhsVars := OrderedCollection with: aValue.! !
  7087.  
  7088. !BuildPTNArgVar methodsFor: 'evaluation'!
  7089. doOperation: e 
  7090.     expr := e.
  7091.     result := self actualValue.
  7092.     rhsVars add: result.
  7093.     ^result! !
  7094.  
  7095. !BuildPTNArgVar methodsFor: 'evaluation'!
  7096. handleVisitation: aBuildTFExpr 
  7097.     ^result := self actualValue.! !
  7098.  
  7099. BuildPTNArg subclass: #BuildPTNParenthesis
  7100.     instanceVariableNames: ''
  7101.     classVariableNames: ''
  7102.     poolDictionaries: ''
  7103.     category: 'Build-Parsers'!
  7104.  
  7105. !BuildPTNParenthesis methodsFor: 'access'!
  7106. actualValue
  7107.     ^BuildTFExpr valueWithAST: (children at: 1)
  7108.         withSw: expr simulateWindow! !
  7109.  
  7110. !BuildPTNParenthesis methodsFor: 'access'!
  7111. left
  7112.     ^nil! !
  7113.  
  7114. !BuildPTNParenthesis methodsFor: 'access'!
  7115. right
  7116.     ^nil! !
  7117.  
  7118. !BuildPTNParenthesis methodsFor: 'access'!
  7119. setAttribute: aValue 
  7120.     value := '()'! !
  7121.  
  7122. BuildPTNArg subclass: #BuildPTNSeq
  7123.     instanceVariableNames: ''
  7124.     classVariableNames: ''
  7125.     poolDictionaries: ''
  7126.     category: 'Build-Parsers'!
  7127.  
  7128. !BuildPTNSeq methodsFor: 'access'!
  7129. addChildrenInitial: anOrderedCollection 
  7130.     super addChildrenInitial: anOrderedCollection.
  7131.     value := OrderedCollection new "value" addAll: (children at: 1) value.
  7132.     value addAll: (children at: 2) value! !
  7133.  
  7134. BuildPTNArg subclass: #BuildPTNArgNum
  7135.     instanceVariableNames: ''
  7136.     classVariableNames: ''
  7137.     poolDictionaries: ''
  7138.     category: 'Build-Parsers'!
  7139.  
  7140. !BuildPTNArgNum methodsFor: 'evaluation'!
  7141. doOperation: ignore
  7142.     ^result := self actualValue! !
  7143.  
  7144. !BuildPTNArgNum methodsFor: 'evaluation'!
  7145. handleVisitation: aBuildTFExpr 
  7146.     result := self actualValue.! !
  7147.  
  7148. !BuildPTNArgNum methodsFor: 'access'!
  7149. actualValue
  7150.     ^result := value asNumber! !
  7151.  
  7152. BuildPTNArg subclass: #BuildPTNArgTerm
  7153.     instanceVariableNames: ''
  7154.     classVariableNames: ''
  7155.     poolDictionaries: ''
  7156.     category: 'Build-Parsers'!
  7157.  
  7158. !BuildPTNArgTerm methodsFor: 'access'!
  7159. actualValue
  7160.     ^result := value! !
  7161.  
  7162. !BuildPTNArgTerm methodsFor: 'access'!
  7163. setAttribute: aValue 
  7164.     super setAttribute: aValue! !
  7165.  
  7166. !BuildPTNArgTerm methodsFor: 'evaluation'!
  7167. handleVisitation: aBuildTFExpr 
  7168.     result := self actualValue "inspect"! !
  7169.  
  7170. BuildPTNArg subclass: #BuildPTNAss
  7171.     instanceVariableNames: ''
  7172.     classVariableNames: ''
  7173.     poolDictionaries: ''
  7174.     category: 'Build-Parsers'!
  7175.  
  7176. !BuildPTNAss methodsFor: 'access'!
  7177. addChildrenInitial: anOrderedCollection 
  7178.     super addChildrenInitial: anOrderedCollection.
  7179.     value := OrderedCollection with: (children at: 1) value! !
  7180.  
  7181. !BuildPTNAss methodsFor: 'access'!
  7182. setAttribute: aValue 
  7183.     value := children at: 1! !
  7184.  
  7185. BuildParseTreeNode subclass: #BuildPTNOperators
  7186.     instanceVariableNames: 'value leftValue rightValue '
  7187.     classVariableNames: ''
  7188.     poolDictionaries: ''
  7189.     category: 'Build-Parsers'!
  7190.  
  7191. !BuildPTNOperators methodsFor: 'evaluating'!
  7192. doOperation
  7193.     "SubClass responsibility"! !
  7194.  
  7195. !BuildPTNOperators methodsFor: 'evaluating'!
  7196. doOperation: anExpr
  7197.     "SubClass responsibility"! !
  7198.  
  7199. !BuildPTNOperators methodsFor: 'evaluating'!
  7200. evaluateFromExpr: aBuildTFExpr 
  7201.     rightValue := BuildTFExpr lastResult.
  7202.     aBuildTFExpr lastResult: self doOperation! !
  7203.  
  7204. !BuildPTNOperators methodsFor: 'evaluating'!
  7205. handleVisitation: aBuildTFExpr 
  7206.     leftValue := aBuildTFExpr lastResult.! !
  7207.  
  7208. !BuildPTNOperators methodsFor: 'access'!
  7209. addChildrenFirst: anOrderedCollection 
  7210.     anOrderedCollection do: [:x | children addFirst: x]! !
  7211.  
  7212. !BuildPTNOperators methodsFor: 'access'!
  7213. addChildrenInitial: anOrderedCollection 
  7214.     super addChildrenInitial: anOrderedCollection.! !
  7215.  
  7216. !BuildPTNOperators methodsFor: 'access'!
  7217. addChildrenLast: anOrderedCollection 
  7218.     children notNil
  7219.         ifTrue: [anOrderedCollection do: [:x | children addLast: x]]
  7220.         ifFalse: [children := anOrderedCollection]! !
  7221.  
  7222. !BuildPTNOperators methodsFor: 'access'!
  7223. leftValue
  7224.     ^leftValue! !
  7225.  
  7226. !BuildPTNOperators methodsFor: 'access'!
  7227. rightValue
  7228.     ^rightValue! !
  7229.  
  7230. !BuildPTNOperators methodsFor: 'access'!
  7231. rightValue: aValue 
  7232.     rightValue := aValue! !
  7233.  
  7234. !BuildPTNOperators methodsFor: 'access'!
  7235. setAttribute: aValue 
  7236.     value := aValue! !
  7237.  
  7238. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  7239.  
  7240. BuildPTNOperators class
  7241.     instanceVariableNames: ''!
  7242.  
  7243. !BuildPTNOperators class methodsFor: 'instance creation'!
  7244. new
  7245.     ^super new setAttribute: nil! !
  7246.  
  7247. BuildPTNOperators subclass: #BuildPTNOR
  7248.     instanceVariableNames: ''
  7249.     classVariableNames: ''
  7250.     poolDictionaries: ''
  7251.     category: 'Build-Parsers'!
  7252.  
  7253. !BuildPTNOR methodsFor: 'evaluating'!
  7254. doOperation: ignore
  7255.     ^result := self left result | self right result! !
  7256.  
  7257. BuildPTNOperators subclass: #BuildPTNDiv
  7258.     instanceVariableNames: ''
  7259.     classVariableNames: ''
  7260.     poolDictionaries: ''
  7261.     category: 'Build-Parsers'!
  7262.  
  7263. !BuildPTNDiv methodsFor: 'access'!
  7264. setAttribute: aValue 
  7265.     value := '/'! !
  7266.  
  7267. !BuildPTNDiv methodsFor: 'evaluating'!
  7268. doOperation: ignore
  7269.     ^result := self left result // self right result! !
  7270.  
  7271. BuildPTNOperators subclass: #BuildPTNLT
  7272.     instanceVariableNames: ''
  7273.     classVariableNames: ''
  7274.     poolDictionaries: ''
  7275.     category: 'Build-Parsers'!
  7276.  
  7277. !BuildPTNLT methodsFor: 'evaluating'!
  7278. doOperation: ignore
  7279.     ^result := self left result < self right result! !
  7280.  
  7281. BuildPTNOperators subclass: #BuildPTNLTE
  7282.     instanceVariableNames: ''
  7283.     classVariableNames: ''
  7284.     poolDictionaries: ''
  7285.     category: 'Build-Parsers'!
  7286.  
  7287. !BuildPTNLTE methodsFor: 'evaluating'!
  7288. doOperation: ignore
  7289.     ^result := self left result <= self right result! !
  7290.  
  7291. BuildPTNOperators subclass: #BuildPTNAND
  7292.     instanceVariableNames: ''
  7293.     classVariableNames: ''
  7294.     poolDictionaries: ''
  7295.     category: 'Build-Parsers'!
  7296.  
  7297. !BuildPTNAND methodsFor: 'evaluating'!
  7298. doOperation: ignore
  7299.     ^result := self left result & self right result! !
  7300.  
  7301. BuildPTNOperators subclass: #BuildPTNMod
  7302.     instanceVariableNames: ''
  7303.     classVariableNames: ''
  7304.     poolDictionaries: ''
  7305.     category: 'Build-Parsers'!
  7306.  
  7307. !BuildPTNMod methodsFor: 'access'!
  7308. setAttribute: aValue 
  7309.     value := 'mod'! !
  7310.  
  7311. !BuildPTNMod methodsFor: 'evaluating'!
  7312. doOperation: ignore
  7313.     ^result := self left result \\ self right result! !
  7314.  
  7315. BuildPTNOperators subclass: #BuildPTNAdd
  7316.     instanceVariableNames: ''
  7317.     classVariableNames: ''
  7318.     poolDictionaries: ''
  7319.     category: 'Build-Parsers'!
  7320.  
  7321. !BuildPTNAdd methodsFor: 'access'!
  7322. setAttribute: aValue 
  7323.     value := '+'! !
  7324.  
  7325. !BuildPTNAdd methodsFor: 'evaluating'!
  7326. doOperation
  7327.     ^result := leftValue + rightValue! !
  7328.  
  7329. !BuildPTNAdd methodsFor: 'evaluating'!
  7330. doOperation: ignore
  7331.     ^result := self left result + self right result! !
  7332.  
  7333. BuildPTNOperators subclass: #BuildPTNEQ
  7334.     instanceVariableNames: ''
  7335.     classVariableNames: ''
  7336.     poolDictionaries: ''
  7337.     category: 'Build-Parsers'!
  7338.  
  7339. !BuildPTNEQ methodsFor: 'evaluating'!
  7340. doOperation: ignore 
  7341.     ^result := self left result = self right result! !
  7342.  
  7343. BuildPTNOperators subclass: #BuildPTNSub
  7344.     instanceVariableNames: ''
  7345.     classVariableNames: ''
  7346.     poolDictionaries: ''
  7347.     category: 'Build-Parsers'!
  7348.  
  7349. !BuildPTNSub methodsFor: 'access'!
  7350. setAttribute: aValue 
  7351.     value := '-'! !
  7352.  
  7353. !BuildPTNSub methodsFor: 'evaluating'!
  7354. doOperation
  7355.     ^result := leftValue - rightValue! !
  7356.  
  7357. !BuildPTNSub methodsFor: 'evaluating'!
  7358. doOperation: ignore
  7359.     ^result := self left result - self right result! !
  7360.  
  7361. !BuildPTNSub methodsFor: 'evaluating'!
  7362. handleVisitation: aBuildTFExpr 
  7363.     leftValue := self left value.! !
  7364.  
  7365. BuildPTNSub subclass: #BuildPTNUSub
  7366.     instanceVariableNames: ''
  7367.     classVariableNames: ''
  7368.     poolDictionaries: ''
  7369.     category: 'Build-Parsers'!
  7370.  
  7371. !BuildPTNUSub methodsFor: 'access'!
  7372. left
  7373.     ^nil! !
  7374.  
  7375. !BuildPTNUSub methodsFor: 'access'!
  7376. right
  7377.     ^children at: 1! !
  7378.  
  7379. !BuildPTNUSub methodsFor: 'access'!
  7380. setAttribute: aValue 
  7381.     value := '-'! !
  7382.  
  7383. !BuildPTNUSub methodsFor: 'evaluating'!
  7384. doOperation
  7385.     ^-1 * rightValue! !
  7386.  
  7387. !BuildPTNUSub methodsFor: 'evaluating'!
  7388. doOperation: ignore 
  7389.     ^result := -1 * (children at: 1) result! !
  7390.  
  7391. !BuildPTNUSub methodsFor: 'evaluating'!
  7392. handleVisitation: aBuildTFExpr 
  7393.     leftValue := rightValue := aBuildTFExpr lastResult.
  7394.     aBuildTFExpr push; putValue: self! !
  7395.  
  7396. BuildPTNOperators subclass: #BuildPTNGT
  7397.     instanceVariableNames: ''
  7398.     classVariableNames: ''
  7399.     poolDictionaries: ''
  7400.     category: 'Build-Parsers'!
  7401.  
  7402. !BuildPTNGT methodsFor: 'evaluating'!
  7403. doOperation: ignore
  7404.     ^result := self left result > self right result! !
  7405.  
  7406. BuildPTNOperators subclass: #BuildPTNNEQ
  7407.     instanceVariableNames: ''
  7408.     classVariableNames: ''
  7409.     poolDictionaries: ''
  7410.     category: 'Build-Parsers'!
  7411.  
  7412. !BuildPTNNEQ methodsFor: 'evaluating'!
  7413. doOperation: ignore
  7414.     ^result := self left result ~= self right result! !
  7415.  
  7416. BuildPTNOperators subclass: #BuildPTNMul
  7417.     instanceVariableNames: ''
  7418.     classVariableNames: ''
  7419.     poolDictionaries: ''
  7420.     category: 'Build-Parsers'!
  7421.  
  7422. !BuildPTNMul methodsFor: 'access'!
  7423. setAttribute: aValue 
  7424.     value := '*'! !
  7425.  
  7426. !BuildPTNMul methodsFor: 'evaluating'!
  7427. doOperation
  7428.     ^result := leftValue * rightValue! !
  7429.  
  7430. !BuildPTNMul methodsFor: 'evaluating'!
  7431. doOperation: ignore 
  7432.     ^result := self left result * self right result! !
  7433.  
  7434. BuildPTNOperators subclass: #BuildPTNGTE
  7435.     instanceVariableNames: ''
  7436.     classVariableNames: ''
  7437.     poolDictionaries: ''
  7438.     category: 'Build-Parsers'!
  7439.  
  7440. !BuildPTNGTE methodsFor: 'evaluating'!
  7441. doOperation: ignore
  7442.     ^result := self left result >= self right result! !
  7443.  
  7444. BuildBoolParser initialize!
  7445.  
  7446. BuildAEScanner initialize!
  7447.  
  7448. BuildTFParser initialize!
  7449.  
  7450. BuildBoolScanner initialize!
  7451.  
  7452. BuildTFScanner initialize!
  7453.  
  7454. BuildAEParser initialize!
  7455.  
  7456. SortedCollection variableSubclass: #TransitionList
  7457.     instanceVariableNames: ''
  7458.     classVariableNames: ''
  7459.     poolDictionaries: ''
  7460.     category: 'Build'!
  7461.  
  7462. !TransitionList methodsFor: 'removing'!
  7463. reassessDefaultsForDeletedActivity: anActivity 
  7464.     | av |
  7465.     av := anActivity av at: 1.
  7466.     self
  7467.         do: 
  7468.             [:x | 
  7469.             x defaultDestinationAssignments isNil ifFalse: [(x defaultDestinationAssignments includesKey: av) isNil ifFalse: [x defaultDestinationAssignments: nil]].
  7470.             x defaultSourceAssignments isNil ifFalse: [(x defaultSourceAssignments includesKey: av) isNil ifFalse: [x defaultSourceAssignments: nil]]]! !
  7471.  
  7472. !TransitionList methodsFor: 'removing'!
  7473. remove: aTransition
  7474.  
  7475.      "Remove a Transition from the transition list, self, of a
  7476.  
  7477. TTM."
  7478.  
  7479.  
  7480.  
  7481.      | location |
  7482.  
  7483.      location := (self indexOf: aTransition).
  7484.  
  7485.       self removeAtIndex: location.! !
  7486.  
  7487. !TransitionList methodsFor: 'removing'!
  7488. removeMyTransitions: pointed 
  7489.     "Removes all transitions of the activity, pointed."
  7490.  
  7491.     | deleteList supplement count |
  7492.     deleteList := self TransitionsStartingAt: pointed.
  7493.     supplement := self TransitionsEndingAt: pointed.
  7494.     count := 1.
  7495.     [count > supplement size]
  7496.         whileFalse: 
  7497.             [(deleteList includes: (supplement at: count))
  7498.                 ifFalse: [self remove: (supplement at: count)].
  7499.             count := count + 1].
  7500.     count := 1.
  7501.     [count > deleteList size]
  7502.         whileFalse: 
  7503.             [self remove: (deleteList at: count).
  7504.             count := count + 1]! !
  7505.  
  7506. !TransitionList methodsFor: 'removing'!
  7507. removeSubtreeTrsFrom: start 
  7508.  
  7509.     "Remove all transitions from the activity subtree starting 
  7510.  
  7511.     at and including start."
  7512.  
  7513.  
  7514.  
  7515.     start left ~= nil ifTrue: [self removeSubtreeTrsFrom: start left].
  7516.  
  7517.     start right ~= nil ifTrue: [self removeSubtreeTrsFrom: start right].
  7518.  
  7519.     self removeMyTransitions: start! !
  7520.  
  7521. !TransitionList methodsFor: 'accessing'!
  7522. sharedTransitionsNamed: anActivityName 
  7523.     "Returns the set of SHARED transitions (incl. branches 
  7524.  
  7525.  of the same 
  7526.     transition) of the given name. Note that
  7527.  
  7528.  if you remove the last line and 
  7529.     the two double quotes
  7530.  
  7531.  below, this routine will only return non-branch 
  7532.     shared
  7533.  
  7534.  transitions."
  7535.  
  7536.     | sameNames |
  7537.     sameNames := self TransitionsNamed: anActivityName.
  7538.     ^sameNames"set := OrderedCollection new.
  7539.  
  7540.  existingSources := OrderedCollection 
  7541.     new.
  7542.  
  7543.  count := 1.
  7544.  
  7545.  [count > sameNames size]
  7546.  
  7547.  whileFalse: 
  7548.  
  7549.  
  7550.     [current := sameNames at: count.
  7551.  
  7552.  existingSources size ~= 0
  7553.  
  7554.  ifTrue: 
  7555.     [(existingSources includes: current
  7556.  
  7557. startingAt)
  7558.  
  7559.  ifFalse: 
  7560.  
  7561.  
  7562.     [existingSources add: current
  7563.  
  7564. startingAt.
  7565.  
  7566.  set add: current]]
  7567.  
  7568.  
  7569.     ifFalse: 
  7570.  
  7571.  [existingSources add: current
  7572.  
  7573. startingAt.
  7574.  
  7575.  set add: 
  7576.     current].
  7577.  
  7578.  count := count + 1].
  7579.  
  7580.  ^set"! !
  7581.  
  7582. !TransitionList methodsFor: 'accessing'!
  7583. TransitionsEndingAt: anActivity
  7584.  
  7585.      "Return the set of Transitions with anActivity as the ending
  7586.  
  7587. activity"
  7588.  
  7589.  
  7590.  
  7591.       ^self select: [:transition | (transition endingAt) =
  7592.  
  7593. anActivity].! !
  7594.  
  7595. !TransitionList methodsFor: 'accessing'!
  7596. TransitionsNamed: anActivityName 
  7597.     "Return the set of Transitions with anActivityName as the
  7598.  
  7599. name."
  7600.  
  7601.     ^self select: [:transition | transition myName = anActivityName]! !
  7602.  
  7603. !TransitionList methodsFor: 'accessing'!
  7604. TransitionsStartingAt: anActivity
  7605.  
  7606.      "Return the set of Transitions with anActivity as the
  7607.  
  7608. starting activity"
  7609.  
  7610.  
  7611.  
  7612.       ^self select: [:transition | (transition startingAt) =
  7613.  
  7614. anActivity].! !
  7615.  
  7616. !TransitionList methodsFor: 'adding'!
  7617. addTransitionFrom: activity1 to: activity2 withName: transitionName 
  7618.     "Create a new transition"
  7619.  
  7620.     | lowerBound upperBound guard action element |
  7621.     lowerBound := '0'.
  7622.     upperBound := 'infinity'.
  7623.     guard := 'nil'.
  7624.     action := 'nil'.
  7625.     element := Transition
  7626.                 name: transitionName
  7627.                 startAt: activity1
  7628.                 endAt: activity2
  7629.                 upper: upperBound
  7630.                 lower: lowerBound
  7631.                 guard: guard
  7632.                 action: action.
  7633.     self add: element.
  7634.     ^element! !
  7635.  
  7636. !TransitionList methodsFor: 'initialization'!
  7637. initialize
  7638.  
  7639.      self sortBlock: [:a :b | a myName <= b myName]! !
  7640.  
  7641. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  7642.  
  7643. TransitionList class
  7644.     instanceVariableNames: ''!
  7645.  
  7646. !TransitionList class methodsFor: 'instance creation'!
  7647. new
  7648.     ^super new initialize! !
  7649.  
  7650. Object subclass: #Box
  7651.     instanceVariableNames: 'point rectangle hide '
  7652.     classVariableNames: ''
  7653.     poolDictionaries: ''
  7654.     category: 'Build'!
  7655.  
  7656. !Box methodsFor: 'copying'!
  7657. makeCopy
  7658.     | temp |
  7659.     temp := self copy.
  7660.     temp depth: self depth copy.
  7661.     temp dimensions: self dimensions copy.
  7662.     temp location: self location copy.
  7663.     ^temp! !
  7664.  
  7665. !Box methodsFor: 'accessing'!
  7666. depth
  7667.  
  7668.      ^hide! !
  7669.  
  7670. !Box methodsFor: 'accessing'!
  7671. depth: newDepth 
  7672.  
  7673.      hide := newDepth! !
  7674.  
  7675. !Box methodsFor: 'accessing'!
  7676. dimensions
  7677.  
  7678.      ^rectangle! !
  7679.  
  7680. !Box methodsFor: 'accessing'!
  7681. dimensions: newRectangle
  7682.  
  7683.      rectangle := newRectangle! !
  7684.  
  7685. !Box methodsFor: 'accessing'!
  7686. location
  7687.  
  7688.      ^point! !
  7689.  
  7690. !Box methodsFor: 'accessing'!
  7691. location: newLocation 
  7692.  
  7693.      point := newLocation! !
  7694.  
  7695. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  7696.  
  7697. Box class
  7698.     instanceVariableNames: ''!
  7699.  
  7700. !Box class methodsFor: 'instance creation'!
  7701. point: aPoint rectangle: aRectangle 
  7702.  
  7703.      "default values for shade, depth and insides 
  7704.  
  7705.      are supplied automatically."
  7706.  
  7707.  
  7708.  
  7709.      | aBox |
  7710.  
  7711.      aBox := self new.
  7712.  
  7713.      aBox location: aPoint.
  7714.  
  7715.      aBox dimensions: aRectangle.
  7716.  
  7717.      aBox depth: #hidden.
  7718.  
  7719.      ^aBox! !
  7720.  
  7721. Model subclass: #HelpScreens
  7722.     instanceVariableNames: 'currentString currentTitle currentTr '
  7723.     classVariableNames: ''
  7724.     poolDictionaries: ''
  7725.     category: 'Build'!
  7726.  
  7727. !HelpScreens methodsFor: 'help access'!
  7728. editInfo
  7729.     self begin: 'Editing A TTM' withCenter: true.
  7730.     self add: '   In this window the activities and transitions that comprise'.
  7731.     self add: 'a TTM can be added, removed, and edited. The window is'.
  7732.     self add: 'made up of fifteen control buttons and a display view.'.
  7733.     self nextln.
  7734.     self add: 'The Control Buttons:'.
  7735.     self add: '---------------'.
  7736.     self nextln.
  7737.     self add: '"Zoom In"'.
  7738.     self add: 'The display always focuses on a particular activity and'.
  7739.     self add: 'displays what is inside of it. When the window is first'.
  7740.     self add: 'opened, this activity is the TTM itself. The focus can be'.
  7741.     self add: 'changed by using "Zoom in" to zoom in on a particular'.
  7742.     self add: 'child activity of the one currently displayed.'.
  7743.     self nextln.
  7744.     self add: '"Zoom Out"'.
  7745.     self add: 'Changes the focus to the parent of the current activity.'.
  7746.     self nextln.
  7747.     self add: '"Hierarchy"'.
  7748.     self add: 'Provides a way of zooming out of several levels at once.'.
  7749.     self add: 'It displays the ancestors of the current activity, then,'.
  7750.     self add: 'by selecting one of them, the user can immediately'.
  7751.     self add: 'jump to that ancestor.'.
  7752.     self nextln.
  7753.     self add: '"Add Activity"'.
  7754.     self add: 'Adding an activity is done by clicking the corresponding'.
  7755.     self add: 'control button. The window will then prompt the user for'.
  7756.     self add: 'the place to put the activity.'.
  7757.     self nextln.
  7758.     self add: '"Expose Acts."'.
  7759.     self add: 'Expose all existing activities at this level so that their'.
  7760.     self add: 'children can be seen. Note that exposed children are'.
  7761.     self add: 'not editable at this level. This function is only for display.'.
  7762.     self add: 'Also note that no transitions at the children level are'.
  7763.     self add: 'displayed unless they have starting or ending activities'.
  7764.     self add: 'at the current level.'.
  7765.     self nextln.
  7766.     self add: '"Hide Acts."'.
  7767.     self add: 'Hide all existing activities at this level so that their'.
  7768.     self add: 'children cannot be seen.'.
  7769.     self nextln.
  7770.     self add: '"Add Transition"'.
  7771.     self add: 'Adding a transition is done similarly except in this case'.
  7772.     self add: 'the window prompts for the source activity and then the'.
  7773.     self add: 'destination activity for the proposed transition. Selecting'.
  7774.     self add: 'an activity to be a source or destination is done by clicking'.
  7775.     self add: 'it with the left mouse button.'.
  7776.     self nextln.
  7777.     self add: '"Expose Trans."'.
  7778.     self add: 'Expose all existing transitions starting or ending at this'.
  7779.     self add: 'level so that their guards and actions can be seen.'.
  7780.     self nextln.
  7781.     self add: '"Hide Trans."'.
  7782.     self add: 'Hide all existing transitions starting or ending at this'.
  7783.     self add: 'level so that their guards and actions can not be seen.'.
  7784.     self nextln.
  7785.     self add: '"Insert TTM"'.
  7786.     self add: 'To insert another TTM into the current one, click this'.
  7787.     self add: 'button. The user will be presented with a list of the'.
  7788.     self add: 'available TTMs from which to choose and a set of options.'.
  7789.     self add: 'These options allow either concurrent or serial insertion and'.
  7790.     self add: 'allow the user to state if all of the duplicate variables and'.
  7791.     self add: 'transitions should be considered shared. Once a TTM has '.
  7792.     self add: 'been chosen and the appropriate options selected, the user'.
  7793.     self add: 'should then click the "accept" button to tell the editor to'.
  7794.     self add: 'perform the insertion or "exit" to exit the insert routine.'.
  7795.     self add: 'Some changes may have to be made to the TTMs in order'.
  7796.     self add: 'to facilitate the insertion. In this event, the editor will'.
  7797.     self add: 'notify the user if and when user input is required. (Please'.
  7798.     self add: 'see the manual for info on concurrency/serial issues.)'.
  7799.     self add: 'After any required changes have been made, simply click'.
  7800.     self add: 'on an area in the display view where the TTM should be'.
  7801.     self add: 'located.'.
  7802.     self nextln.
  7803.     self add: '"Compose TTMs"'.
  7804.     self add: 'This function is for convenient concurrent insertion of'.
  7805.     self add: 'multiple ttms. It is exactly the same as "Insert TTM" except'.
  7806.     self add: 'it is assumed that all insertion is to be concurrent.'.
  7807.     self nextln.
  7808.     self add: '"Reset Default"'.
  7809.     self add: 'Each activity that has children also has a default child that'.
  7810.     self add: 'is shown on the display view in bold letters. The default'.
  7811.     self add: 'is used to determine which activities are activated when'.
  7812.     self add: 'they are not explicitly determined by the user; e.g. a'.
  7813.     self add: 'transition whose destination is X implies that the actual'.
  7814.     self add: 'destination is one or more activities WITHIN X when X has'.
  7815.     self add: 'children. The default is automatically assigned to the first'.
  7816.     self add: 'child that was created in X. The default can be reset,'.
  7817.     self add: 'however, using this button. Simply click it, then click on'.
  7818.     self add: 'the activity that is to be the new default.'.
  7819.     self nextln.
  7820.     self add: '"Cancel"'.
  7821.     self add: 'Clicking this button will cancel any currently pending'.
  7822.     self add: 'operation. If an operation is pending, a prompt line will'.
  7823.     self add: 'be displayed above the display view.'.
  7824.     self nextln.
  7825.     self add: '"Help"'.
  7826.     self add: 'Clicking this button will cause this window to be created.'.
  7827.     self nextln.
  7828.     self add: '"Exit"'.
  7829.     self add: 'Clicking this button will exit the user from the Editor.'.
  7830.     self nextln.
  7831.     self nextln.
  7832.     self add: 'The Display View:'.
  7833.     self add: '-------------'.
  7834.     self add: 'There is a middle mouse button menu associated with'.
  7835.     self add: 'each transition and each activity currently displayed on'.
  7836.     self add: 'the editor. These menus provide ways of manipulating'.
  7837.     self add: 'the transitions and activities. These menus are described'.
  7838.     self add: 'below.'.
  7839.     self nextln.
  7840.     self add: '"Operations On Activities"'.
  7841.     self add: '--------------------'.
  7842.     self add: 'zoom in -- same as control button "Zoom In".'.
  7843.     self add: 'move -- moves the position of the activity. The user'.
  7844.     self add: ' will be prompted for the new position.'.
  7845.     self add: 'resize -- resizes the activity. The user will be'.
  7846.     self add: ' prompted for the new bottom right corner of'.
  7847.     self add: ' the activity.'.
  7848.     self add: 'rename -- renames activity.'.
  7849.     self add: 'expose/ -- exposes the child activities if any.'.
  7850.     self add: '/hide -- hides the child activities if any.'.
  7851.     self add: ' <this feature is not yet implemented>'.
  7852.     self add: 'remove -- removes the activity.'.
  7853.     self add: 'add tr. -- same as control button "Add Transition".'.
  7854.     self nextln.
  7855.     self add: '"Operations On Transitions"'.
  7856.     self add: '---------------------'.
  7857.     self add: 'rename -- renames transition.'.
  7858.     self add: 'lower b. -- changes lower bound of transition.'.
  7859.     self add: 'upper b. -- changes upper bound of transition.'.
  7860.     self add: 'guard -- changes guard of transition. The syntax'.
  7861.     self add: ' required for a guard is explained in the'.
  7862.     self add: ' main help window under "Grammar'.
  7863.     self add: ' Description".'.
  7864.     self add: 'function -- changes function of transition. The'.
  7865.     self add: ' syntax required for a function is ex-'.
  7866.     self add: ' plained in the main help window under'.
  7867.     self add: ' "Grammar Description".'.
  7868.     self add: 'expose/ -- exposes the time bounds, guard and'.
  7869.     self add: ' function so they can be seen.'.
  7870.     self add: '/hide -- hides the above.'.
  7871.     self add: 'move -- moves the midpoint of transition arc.'.
  7872.     self add: ' User is prompted for new position.'.
  7873.     self add: 'dest. -- change destination activity for this'.
  7874.     self add: ' transition. User is prompted for new'.
  7875.     self add: ' destination activity.'.
  7876.     self add: 'remove -- removes transition.'.
  7877.     ^self concludeWithNote: true! !
  7878.  
  7879. !HelpScreens methodsFor: 'help access'!
  7880. helpInfo
  7881.     self begin: ('Welcome to Build V0.984'  ) withCenter: true.
  7882.     self add: '                    Contact: jonathan@cs.yorku.ca' .
  7883.     self add: '                            copyright 1990/94'.
  7884.     self add: ''.
  7885.     self add: ''.
  7886.     self add: ' As you can see, "Build" resides in a window that'.
  7887.     self add: 'consists of seven views and an array of control buttons. '.
  7888.     self add: 'Views are scrollable display areas. Control buttons are'.
  7889.     self add: 'labelled rectangles. To "push" a control button, the user'.
  7890.     self add: 'should move the mouse cursor to the button, then click'.
  7891.     self add: 'the left button on the mouse.'.
  7892.     self nextln.
  7893.     self add: '"List Of Existing TTMs"'.
  7894.     self add: '-----------------'.
  7895.     self add: 'This view contains the list of TTMs already created. When'.
  7896.     self add: 'empty, this list will consist of just the two bounding'.
  7897.     self add: 'dashed lines. To select an existing TTM, move the cursor'.
  7898.     self add: 'to it, then click the left mouse button.'.
  7899.     self add: 'Operations involving a selected TTM are performed by'.
  7900.     self add: 'clicking on one of the control buttons at the bottom of the'.
  7901.     self add: 'window. However, the user can also select these operations'.
  7902.     self add: 'using the middle mouse button menu in this view.'.
  7903.     self add: 'IMPORTANT: Please note that none of the following'.
  7904.     self add: 'views will display information or allow the user to input'.
  7905.     self add: 'information UNLESS a TTM in the list is selected. Also,'.
  7906.     self add: 'all but the "Add TTM", "Help" and "Exit Program" control'.
  7907.     self add: 'buttons require a TTM to be selected to be enabled.'.
  7908.     self nextln.
  7909.     self add: '"Note Pad"'.
  7910.     self add: '--------'.
  7911.     self add: 'This view is just a space for the user to include some'.
  7912.     self add: 'description of the selected TTM. This description can be'.
  7913.     self add: 'edited using the usual text cut & paste features. These'.
  7914.     self add: 'are provided in the middle mouse button menu. They'.
  7915.     self add: 'consist of: "again", "undo", "copy", "cut", "paste", '.
  7916.     self add: '"accept" and "cancel". In order for the description to'.
  7917.     self add: 'be added to the TTM, the "accept" option must be used.'.
  7918.     self nextln.
  7919.     self add: '"Activity Variables"'.
  7920.     self add: '--------------'.
  7921.     self add: 'This view lists the activity variables used in the selected'.
  7922.     self add: 'TTM. Because an activity variable can only be added or'.
  7923.     self add: 'removed when the TTM it belongs to is added or'.
  7924.     self add: 'removed, the only middle mouse button menu option'.
  7925.     self add: 'available to the user is "rename" the selected variable.'.
  7926.     self nextln.
  7927.     self add: '"Data Variables"'.
  7928.     self add: '------------'.
  7929.     self add: 'This view lists the data variables used in the selected'.
  7930.     self add: 'TTM. The middle mouse button menu consists of: "add",'.
  7931.     self add: '"remove", "rename", "new lower limit", and "new upper'.
  7932.     self add: 'limit". These last two are for changing the integer range'.
  7933.     self add: 'of the selected variable.'.
  7934.     self nextln.
  7935.     self add: '"Communication Channels"'.
  7936.     self add: '---------------------'.
  7937.     self add: 'This view lists the communication channels available in'.
  7938.     self add: 'the selected TTM. The middle mouse button menu'.
  7939.     self add: 'consists of: "add", "remove", and "rename".'.
  7940.     self nextln.
  7941.     self add: '"SFs:"'.
  7942.     self add: '----'.
  7943.     self add: 'The state formula numbers for the selected TTM are'.
  7944.     self add: 'listed here. When a particular SF number is selected'.
  7945.     self add: 'its state formula is displayed in the following view.'.
  7946.     self add: 'Middle mouse button menu options are: "add", "copy"'.
  7947.     self add: '"clear", "remove", and "renumber". "clear" will remove'.
  7948.     self add: 'all SFs from the selected TTM.'.
  7949.     self add: ' Note that for verification, the above is sufficient.'.
  7950.     self add: 'However, with controller design, the user needs a set'.
  7951.     self add: 'of SFs for EACH specification. So, after each set is'.
  7952.     self add: 'defined by the user, a file should be generated of it'.
  7953.     self add: 'before clearing it and defining the next set.'.
  7954.     self nextln.
  7955.     self add: '"Current SF:"'.
  7956.     self add: '----------'.
  7957.     self add: 'This view displays the current SF selected in the "SFs:"'.
  7958.     self add: 'view. Initially this is nil. It can be edited using the usual'.
  7959.     self add: 'text cut & paste features. These are described above in'.
  7960.     self add: '"Note Pad". The state formula is defined in the same way'.
  7961.     self add: 'as a transition guard. For an outline of the syntax'.
  7962.     self add: 'required see below under "Grammar Description".'.
  7963.     self nextln.
  7964.     self add: '"Add TTM:"'.
  7965.     self add: 'This will add a "blank" TTM to the list of existing TTMs.'.
  7966.     self add: 'The user will be prompted for a name and an activity'.
  7967.     self add: 'variable. It will contain no transitions and only the root'.
  7968.     self add: 'activity.'.
  7969.     self nextln.
  7970.     self add: '"Remove TTM"'.
  7971.     self add: 'This will remove the selected TTM from the list of'.
  7972.     self add: 'existing TTMs.'.
  7973.     self nextln.
  7974.     self add: '"Rename TTM"'.
  7975.     self add: 'This will rename the selected TTM to one provided by'.
  7976.     self add: 'the user.'.
  7977.     self nextln.
  7978.     self add: '"Copy TTM"'.
  7979.     self add: 'This will copy the selected TTM. The user will be'.
  7980.     self add: 'prompted for a new name for the copy.'.
  7981.     self nextln.
  7982.     self add: '"Edit TTM"'.
  7983.     self add: 'This creates an Editor for the selected TTM. It is here'.
  7984.     self add: 'that the transitions and activities are added to the'.
  7985.     self add: 'TTM. Detailed Help is provided within Editor.'.
  7986.     self nextln.
  7987.     self add: '"Query TTM"'.
  7988.     self add: 'This creates a Query window for the selected TTM.'.
  7989.     self add: 'It is here that the user can examine characteristics'.
  7990.     self add: 'of the TTM using conjunctive queries. Detailed Help'.
  7991.     self add: 'is provided within Query window.'.
  7992.     self nextln.
  7993.     self add: '"Simulate TTM"'.
  7994.     self add: 'This creates a Simulator for the selected TTM. It is'.
  7995.     self add: 'here that the user can simulate the operation of the'.
  7996.     self add: 'TTM and debug. Detailed Help is provided within'.
  7997.     self add: 'Simulator.'.
  7998.     self nextln.
  7999.     self add: '"Specify IC"'.
  8000.     self add: 'This creates a Specifier for the selected TTM. It is'.
  8001.     self add: 'here that the user specifies the initial condition(s)'.
  8002.     self add: 'for the TTM. Detailed Help is provided within.'.
  8003.     self nextln.
  8004.     self add: '"Generate Code"'.
  8005.     self add: 'This will generate Quintus Prolog or Prolog III files'.
  8006.     self add: 'that specify the selected TTM. These files are required'.
  8007.     self add: 'for both verification and controller design.'.
  8008.     self add: 'It will also generate Quintus Prolog or Prolog III files for'.
  8009.     self add: 'the state formulae created in the SF views. These files'.
  8010.     self add: 'are required for both verification and controller design.'.
  8011.     self add: 'There is an option for the user to enumerate the activity'.
  8012.     self add: 'names in the files generated. Using numbers will'.
  8013.     self add: 'generally speed up the verification process.'.
  8014.     self nextln.
  8015.     self add: '"File Access"'.
  8016.     self add: 'Clicking this button creates the interface for loading'.
  8017.     self add: 'and saving individual TTMs. It consists of a scrollable'.
  8018.     self add: 'window displaying the contents of the current directory'.
  8019.     self add: 'and buttons for loading, saving, and exiting.'.
  8020.     self add: 'To load, select a valid file (one ending in ".model") then'.
  8021.     self add: 'click the "load" button. To save, select a TTM in the list'.
  8022.     self add: 'of existing TTMs, then click the "save" button. The user'.
  8023.     self add: 'will then be prompted for a filename. Note that valid'.
  8024.     self add: 'filenames must end in ".model".'.
  8025.     self nextln.
  8026.     self add: '"Help"'.
  8027.     self add: 'Clicking this button will cause this window to be created'.
  8028.     self nextln.
  8029.     self add: '"Exit Program"'.
  8030.     self add: 'Clicking this button will exit the Model Builder program.'.
  8031.     self nextln.
  8032.     self nextln.
  8033.     self add: '"Grammar Description:"'.
  8034.     self add: '=================='.
  8035.     self add: 'The following describes the syntax in which guards,'.
  8036.     self add: 'functions, state formulae, and initial conditions must be'.
  8037.     self add: 'expressed in. In almost all instances, this syntax is the'.
  8038.     self add: 'same as required by the Quintus Prolog programming'.
  8039.     self add: 'language. In the examples, A and B are data variables'.
  8040.     self add: 'while X1 and X2 are activity variables. In instances'.
  8041.     self add: 'where only one of the variable types can be used with'.
  8042.     self add: 'a particular symbol, only that variable type will be used'.
  8043.     self add: 'in the example. In instances where both variable types'.
  8044.     self add: 'can be used, both types will be used in the example.'.
  8045.     self nextln.
  8046.     self add: '-- Arithmetic Operators --'.
  8047.     self add: ' + addition A + B'.
  8048.     self add: ' - subtraction B - A'.
  8049.     self add: ' * multiplication A * B'.
  8050.     self add: ' / integer division A / B'.
  8051.     self add: ' % integer remainder (modulo) A % B'.
  8052.     self add: '-- Unary Operators --'.
  8053.     self add: ' + positive +A +5'.
  8054.     self add: ' - negative -A -2'.
  8055.     self add: '-- Inequality Symbols --'.
  8056.     self add: ' = equal A = B X1 = X2'.
  8057.     self add: ' # not equal A # B X1 # X2'.
  8058.     self add: ' > greater than A > B'.
  8059.     self add: ' >= greater than or equal to A >= B'.
  8060.     self add: ' < less than B < A'.
  8061.     self add: ' =< less than or equal to B =< A'.
  8062.     self add: '-- Assignment --'.
  8063.     self add: ' : assign A : A + 1 X1 : off'.
  8064.     self add: '-- Conjunction Operators --'.
  8065.     self add: ' , logical AND A > 0 , X1 # on'.
  8066.     self add: ' ; logical OR X2 = off ; B =< 100'.
  8067.     self add: ' ( left bracket'.
  8068.     self add: ' ) right bracket (A > 0, B > A) ; (X1 # on)'.
  8069.     self nextln.
  8070.     self add: '== Boolean Expressions and Assignments =='.
  8071.     self nextln.
  8072.     self add: 'All guards, state formulae, and initial conditions are'.
  8073.     self add: 'boolean expressions; that is, they all evaluate to either'.
  8074.     self add: 'TRUE or FALSE. All functions are assignments; that is,'.
  8075.     self add: 'they assign particulars values to variables.'.
  8076.     self add: ' "Boolean expressions" can make use of all of the above'.
  8077.     self add: 'symbols. For example, this is a valid boolean expression:'.
  8078.     self add: ' ((A + 1 > 0, A - 1 =< 10) ; (B > -A , (X1 # on ; X2 = off)))'.
  8079.     self add: 'Arithmetic operators, however, cannot be used on the'.
  8080.     self add: 'right hand side of an expression and inequalities must'.
  8081.     self add: 'not be cascaded; i.e. A > B , B > 10 must be used instead'.
  8082.     self add: 'of A > B > 10.'.
  8083.     self add: ' "Assignments" are restricted to using the arithmetic'.
  8084.     self add: 'operators and the logical AND conjunction operator; i.e.'.
  8085.     self add: 'A : A + 1 , B : B - 1 is valid. A > B + 1 ; (B : B - 1) is not.'.
  8086.     self add: 'For assignments, the right hand side must be a variable'.
  8087.     self add: 'and the left hand side must evaluate to a particular'.
  8088.     self add: 'value. When the variable in question is a data variable'.
  8089.     self add: 'the value must evaluate to an integer within the range'.
  8090.     self add: 'given upon initialization.'.
  8091.     self add: ' Note: that with both expressions and assignments, '.
  8092.     self add: 'cascading arithmetic operators can be used. For example,'.
  8093.     self add: 'A : -A + B - 10 + 3 and (A + B - 10 + 3) > 100 are valid.'.
  8094.     self add: ' Note: the multiplication operator does NOT have'.
  8095.     self add: 'precedence over addition and subtraction. Thus, 5+6*2'.
  8096.     self add: 'equals 22 and NOT 17.'.
  8097.     ^self concludeWithNote: true! !
  8098.  
  8099. !HelpScreens methodsFor: 'help access'!
  8100. icInfo
  8101.     self begin: 'Introduction To Specifying ICs' withCenter: true.
  8102.     self add: 'Prolog III Initial Condition:'.
  8103.     self add: '--------------------'.
  8104.     self add: 'This view contains the initial condition for the selected'.
  8105.     self add: 'TTM. This initial condition is used in the Prolog III Code'.
  8106.     self add: 'Generation. It should be specified in the same format'.
  8107.     self add: 'as a transition guard. The usual cut & paste text editing'.
  8108.     self add: 'features are provided in the middle mouse button'.
  8109.     self add: 'menu. These are: "again", "undo", "copy", "cut", "paste",'.
  8110.     self add: '"accept" and "cancel". To save the initial condition typed'.
  8111.     self add: 'into the view the "accept" option must be selected.'.
  8112.     self add: 'A syntax check will then be run on the condition. '.
  8113.     self add: 'If it is valid, the condition will be added to the TTM.'.
  8114.     self add: 'The syntax required for the initial condition is explained'.
  8115.     self add: 'in the main help window under "Grammar Description".'.
  8116.     self nextln.
  8117.     self add: 'Specific IC LIst:'.
  8118.     self add: '------------'.
  8119.     self add: 'This view and the remaining view together provide the'.
  8120.     self add: 'user with the ability to write SPECIFIC initial conditions.'.
  8121.     self add: 'SPECIFIC initial conditions are those that assign values'.
  8122.     self add: 'to every activity and data variable in the TTM and do'.
  8123.     self add: 'not include inequalities or arithmetic expressions. '.
  8124.     self add: ' Specific Initial Conditions are ONLY required by the'.
  8125.     self add: 'finite-state verification program (running under Quintus'.
  8126.     self add: 'Prolog). For any other code generation, the non-specific'.
  8127.     self add: 'initial condition is used.'.
  8128.     self add: ' This view contains a list of numbers. Each number'.
  8129.     self add: 'refers to a unique specific initial condition. When a'.
  8130.     self add: 'number is selected, its specific i.c. is displayed in the'.
  8131.     self add: 'next view. Middle mouse button menu options are: '.
  8132.     self add: '"add", "copy", "clear", and "remove". "clear" will'.
  8133.     self add: 'remove all ICs.'.
  8134.     self add: '"send" will send the currently selected initial condition'.
  8135.     self add: 'to the Starting Condition subview of the Simulate '.
  8136.     self add: 'Window associated with the current TTM. The current'.
  8137.     self add: 'simulation will terminate as if you had pressed the'.
  8138.     self add: '"Clear" button. '.
  8139.     self nextln.
  8140.     self add: '"Selected Specific Initial Condition"'.
  8141.     self add: ' The values for each activity and data variable are'.
  8142.     self add: 'displayed in this list. To change a value, select the'.
  8143.     self add: 'variable, then the middle mouse button menu option:'.
  8144.     self add: '"new initial value". The Specifier will then prompt for'.
  8145.     self add: 'a new value.'.
  8146.     self nextln.
  8147.     self add: '"Help"'.
  8148.     self add: 'Clicking this button will create this help window.'.
  8149.     self nextln.
  8150.     self add: '"Exit"'.
  8151.     self add: '"Clicking this button will exit the user from the'.
  8152.     self add: 'Initial Condition Specifier.'.
  8153.     ^self concludeWithNote: true! !
  8154.  
  8155. !HelpScreens methodsFor: 'help access'!
  8156. queryInfo
  8157.     self begin: 'Querying A TTM' withCenter: true.
  8158.     self add: ' This window provides tools for asking questions about'.
  8159.     self add: 'the selected TTM. The aim is to allow the user to examine'.
  8160.     self add: 'subsets of the transitions that make up the TTM; e.g. we'.
  8161.     self add: 'may wish to display all transitions within activity X that'.
  8162.     self add: 'perform an operation on data variable C. This can be done'.
  8163.     self add: 'easily with the provided tools.'.
  8164.     self add: ' Initially, all of the transitions within the selected TTM'.
  8165.     self add: 'are displayed. The tool works by applying successive'.
  8166.     self add: 'constraints to this table of transitions. An example of'.
  8167.     self add: 'a constraint could be that all transitions should have X'.
  8168.     self add: 'as their source. Applying this constraint would result in'.
  8169.     self add: 'only those transitions being displayed in the table.'.
  8170.     self nextln.
  8171.     self add: ' "Adding Constraints"'.
  8172.     self add: ' Constraints to the table of transitions currently being'.
  8173.     self add: 'displayed are added using a set of 10 predicates. Clicking'.
  8174.     self add: 'the "Add A Constraint" button will cause the program to'.
  8175.     self add: 'prompt for a constraint. After receiving it, the program'.
  8176.     self add: 'selects those transitions in the current table that satisfy'.
  8177.     self add: 'the new constraint, then displays them in the new table.'.
  8178.     self add: ' These constraints are cumulative so the resulting table'.
  8179.     self add: 'will be composed of transitions that satisfy ALL of the'.
  8180.     self add: 'given constraints.'.
  8181.     self add: ' A constraint can be composed of any number of'.
  8182.     self add: 'predicates as long as they are linked to each other using'.
  8183.     self add: 'the logical OR symbol ";". For example, if the user wished'.
  8184.     self add: 'to examine all transitions that begin in activity X1 or '.
  8185.     self add: 'activity X2, the user should type: "source(X1) ; source(X2)"'.
  8186.     self add: 'as the constraint.'.
  8187.     self nextln.
  8188.     self add: ' The following is a list of the valid predicates:'.
  8189.     self nextln.
  8190.     self add: ' finite() or f() -- '.
  8191.     self add: 'transitions with finite upper time bounds.'.
  8192.     self add: ' infinite() or i() -- '.
  8193.     self add: 'transitions with infinite upper time bounds.'.
  8194.     self add: ' upper(#) or u(#) -- '.
  8195.     self add: 'transitions with upper time bounds =< #.'.
  8196.     self add: ' lower(#) or l(#) -- '.
  8197.     self add: 'transitions with lower time bounds >= #.'.
  8198.     self add: ' named(label) or n(label) -- '.
  8199.     self add: 'transitions named <label>. A wildcard character * can be'.
  8200.     self add: 'be used to proceed or follow <label>.'.
  8201.     self add: ' source(X) or s(X) -- '.
  8202.     self add: 'transitions with source activity X.'.
  8203.     self add: ' destination(X) or dest(X) or d(X) -- '.
  8204.     self add: 'transitions with destination activity X.'.
  8205.     self add: ' sourceIn(X) or si(X) -- '.
  8206.     self add: 'transitions with source activity X or source activity within X.'.
  8207.     self add: ' destinationIn(X) or destIn(X) or di(X) -- '.
  8208.     self add: 'transitions with dest. activity X or dest. activity within X.'.
  8209.     self add: ' contains(E) or c(E) -- '.
  8210.     self add: 'transitions with guards and/or functions with instances of'.
  8211.     self add: 'the expression E.'.
  8212.     self nextln.
  8213.     self add: ' "Clear Constraints"'.
  8214.     self add: ' Clicking this button will remove all preceeding constraints'.
  8215.     self add: 'from the table.'.
  8216.     self nextln.
  8217.     self add: ' "List Constraints"'.
  8218.     self add: ' Clicking this button will display a list of the constraints'.
  8219.     self add: 'currently applied to the transition table being displayed.'.
  8220.     self nextln.
  8221.     self add: ' "File Out"'.
  8222.     self add: ' Clicking this button will output the current table display'.
  8223.     self add: 'to a specified file. The user has the option of including'.
  8224.     self add: 'additional information about the TTM such as, a list of the'.
  8225.     self add: 'activity and data variables and initial condition, the'.
  8226.     self add: 'notepad, and a heading. There is also the option to include'.
  8227.     self add: 'any constraints used to create the table.'.
  8228.     self nextln.
  8229.     self add: ' "Exit"'.
  8230.     self add: ' Clicking this button will exit the user from Query.'.
  8231.     self nextln.
  8232.     self add: ' "Help"'.
  8233.     self add: ' Clicking this button will cause this window to be created.'.
  8234.     ^self concludeWithNote: true! !
  8235.  
  8236. !HelpScreens methodsFor: 'help access'!
  8237. simulateInfo
  8238.     self begin: 'Simulating A TTM' withCenter: true.
  8239.     self add: ' Simulation provides a way of testing the operation of a '.
  8240.     self add: 'selected TTM. The simulation window is comprised of four'.
  8241.     self add: 'views. The largest of these is where the changing values of'.
  8242.     self add: 'the TTM variables are displayed. The most recent state of'.
  8243.     self add: 'these variables is displayed at the top of the view. A'.
  8244.     self add: 'transition from one state to another is displayed as an '.
  8245.     self add: 'upward pointing arrow between the states.'.
  8246.     self nextln.
  8247.     self add: '"Starting Condition"'.
  8248.     self add: '---------------'.
  8249.     self add: ' This view displays the values the variables'.
  8250.     self add: 'are initially given prior to simulation. These can be changed'.
  8251.     self add: 'by selecting a variable and then the middle mouse button'.
  8252.     self add: 'menu option. The user is then prompted for the new value'.
  8253.     self add: 'of the variable. The value of "True" for an activity variable'.
  8254.     self add: 'means here that the variable can be any value. This is useful'.
  8255.     self add: 'when the user does not want to specify a specific initial'.
  8256.     self add: 'activity for the TTM to be in.'.
  8257.     self nextln.
  8258.     self add: '"Stopping Condition"'.
  8259.     self add: '----------------'.
  8260.     self add: ' This view contains the condition for which'.
  8261.     self add: 'the simulation will STOP. After each transition, the simulator'.
  8262.     self add: 'will determine if the condition is met. The condition can be'.
  8263.     self add: 'edited in the same as the initial condition of the Specifying'.
  8264.     self add: 'IC window and should be expressed in the same syntax'.
  8265.     self add: 'as the initial condition.'.
  8266.     self nextln.
  8267.     self add: '"Elapsed Ticks"'.
  8268.     self add: '------------'.
  8269.     self add: ' This view displays the current clock time which is'.
  8270.     self add: 'incremented by the tick transition. There are two buttons'.
  8271.     self add: 'for the clock. One will reset the clock to zero. The other'.
  8272.     self add: 'will allow you to set it to whatever offset you desire.'.
  8273.     self nextln.
  8274.     self add: '"Start/Continue"'.
  8275.     self add: 'The simulation begins by clicking this button. The'.
  8276.     self add: 'user will then be presented with a list of the transitions'.
  8277.     self add: 'enabled in the current state (which is defined by the'.
  8278.     self add: 'current values of the TTM variables). Selecting one of these'.
  8279.     self add: 'causes the transition to be taken and the current state to'.
  8280.     self add: 'be changed. Tacked on to the end of the list of transitions'.
  8281.     self add: 'is the option STOP. By selecting this, the user can exit'.
  8282.     self add: 'gracefully from the current simulation. By clicking the Start/'.
  8283.     self add: 'Continue button again, the simulation can be resumed. If'.
  8284.     self add: 'STOP is not selected and the Stopping Condition is not'.
  8285.     self add: 'satisfied, the simulator will present a new list of transitions'.
  8286.     self add: 'and ask for another selection.'.
  8287.     self nextln.
  8288.     self add: '"Step"'.
  8289.     self add: 'This button allows the user to step through one'.
  8290.     self add: 'transition at a time. It does not consider the Stopping'.
  8291.     self add: 'Condition.'.
  8292.     self nextln.
  8293.     self add: '"Clear"'.
  8294.     self add: 'This button will clear the existing simulation run from'.
  8295.     self add: 'the view and reset the current state to the starting'.
  8296.     self add: 'condition.'.
  8297.     self nextln.
  8298.     self add: '"Status"'.
  8299.     self add: 'Clicking this button will display a list of the current'.
  8300.     self add: 'states of all the transitions in the TTM; that is,'.
  8301.     self add: 'whether they are currently disabled, pending, enabled,'.
  8302.     self add: 'or in a state where they must occur or be disabled'.
  8303.     self add: 'before another clock tick.'.
  8304.     self add: 'Details of a particular transition can be obtained by'.
  8305.     self add: 'selecting one of the transitions in the list displayed.'.
  8306.     self nextln.
  8307.     self add: '"File Out"'.
  8308.     self add: 'A simulation run can be written to a file by clicking this'.
  8309.     self add: 'button. There is also the option of including a title,'.
  8310.     self add: 'the notepad, the stopping and starting conditions used for'.
  8311.     self add: 'the run, and the number of ticks that elapsed during the'.
  8312.     self add: 'run.'.
  8313.     self nextln.
  8314.     self add: '"Exit"'.
  8315.     self add: 'Clicking this button will exit the user from the Simulator.'.
  8316.     self nextln.
  8317.     self add: '"Help"'.
  8318.     self add: 'Clicking this button causes this window to be created'.
  8319.     ^self concludeWithNote: true! !
  8320.  
  8321. !HelpScreens methodsFor: 'make text'!
  8322. add: aLine 
  8323.     | end |
  8324.     end := String with: Character cr.
  8325.     currentString := currentString , end , aLine! !
  8326.  
  8327. !HelpScreens methodsFor: 'make text'!
  8328. begin: aTitle withCenter: aBoolean 
  8329.     | length blanks |
  8330.     currentString := ''.
  8331.     length := aTitle size.
  8332.     blanks := ''.
  8333.     aBoolean = true & (length < 70) ifTrue: [(70 - length / 2) floor timesRepeat: [blanks := blanks , ' ']].
  8334.     currentTitle := blanks , aTitle.
  8335.     self add: currentTitle copy.
  8336.     "self nextln"! !
  8337.  
  8338. !HelpScreens methodsFor: 'make text'!
  8339. concludeWithNote: aBoolean 
  8340.     | end note |
  8341.     end := String with: Character cr.
  8342.     note := ' For more assistance please see the manual'.
  8343.     aBoolean = true
  8344.         ifTrue: 
  8345.             [currentString := currentString , end , end , end , note.
  8346.             currentString := currentString asText
  8347.                         emphasizeFrom: currentString size - note size
  8348.                         to: currentString size
  8349.                         with: #bold].
  8350.     currentString := currentString asText
  8351.                 emphasizeFrom: 1
  8352.                 to: currentTitle size + 1
  8353.                 with: #bold.
  8354.     ^currentString! !
  8355.  
  8356. !HelpScreens methodsFor: 'make text'!
  8357. nextln
  8358.     currentString := currentString , (String with: Character cr)! !
  8359.  
  8360. !HelpScreens methodsFor: 'initialize-release'!
  8361. initialize: aTransition 
  8362.  
  8363.      currentTr := aTransition! !
  8364.  
  8365. !HelpScreens methodsFor: 'transition access'!
  8366. transition
  8367.     | tr |
  8368.     tr := currentTr at: 1.
  8369.     self begin: (tr at: 1)
  8370.         withCenter: false.
  8371.     self add: 'guard: (' , (tr at: 2) , ')'.
  8372.     self add: 'function: [' , (tr at: 3) , ']'.
  8373.     self add: 'lower bound: ' , (tr at: 4).
  8374.     self add: 'upper bound: ' , (tr at: 5).
  8375.     self add: 'time elapsed: ' , (currentTr at: 2).
  8376.     ^self concludeWithNote: false! !
  8377.  
  8378. !HelpScreens methodsFor: 'button access'!
  8379. doEditInfo
  8380.  
  8381.      HelpScreens openHelp: 'editing'! !
  8382.  
  8383. !HelpScreens methodsFor: 'button access'!
  8384. doICInfo
  8385.  
  8386.      HelpScreens openHelp: 'specifying'! !
  8387.  
  8388. !HelpScreens methodsFor: 'button access'!
  8389. doQueryInfo
  8390.  
  8391.      HelpScreens openHelp: 'querying'! !
  8392.  
  8393. !HelpScreens methodsFor: 'button access'!
  8394. doSimulateInfo
  8395.  
  8396.      HelpScreens openHelp: 'simulating'! !
  8397.  
  8398. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  8399.  
  8400. HelpScreens class
  8401.     instanceVariableNames: ''!
  8402.  
  8403. !HelpScreens class methodsFor: 'instance creation'!
  8404. new
  8405.  
  8406.  
  8407.  
  8408.    ^super new! !
  8409.  
  8410. !HelpScreens class methodsFor: 'instance creation'!
  8411. new: aTransition
  8412.  
  8413.      ^super new initialize: aTransition! !
  8414.  
  8415. !HelpScreens class methodsFor: 'instance creation'!
  8416. openHelp: helptype
  8417.  
  8418.  
  8419.  
  8420.    self openHelp: self new which: helptype! !
  8421.  
  8422. !HelpScreens class methodsFor: 'instance creation'!
  8423. openHelp: aHelpScreen which: helptype 
  8424.  
  8425.     | window container noteView qButton left hsize top vsize h1Button h2Button h3Button h4Button |
  8426.  
  8427.     window := ScheduledWindow new.
  8428.  
  8429.     helptype = 'introduction' ifTrue: [window label: 'Introduction To Model Builder'].
  8430.  
  8431.     helptype = 'editing' ifTrue: [window label: 'Introduction To Editing'].
  8432.  
  8433.     helptype = 'querying' ifTrue: [window label: 'Introduction To Querying'].
  8434.  
  8435.     helptype = 'simulating' ifTrue: [window label: 'Introduction To Simulating'].
  8436.  
  8437.     helptype = 'specifying' ifTrue: [window label: 'Introduction To Specifying ICs'].
  8438.  
  8439.     window minimumSize: 400 @ 400.
  8440.  
  8441.     container := CompositePart new.
  8442.  
  8443.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  8444.  
  8445.         insideColor: ColorValue gray.
  8446.  
  8447.     helptype = 'introduction'
  8448.  
  8449.         ifTrue: [noteView := TextView
  8450.  
  8451.                         on: aHelpScreen
  8452.  
  8453.                         aspect: #helpInfo
  8454.  
  8455.                         change: nil
  8456.  
  8457.                         menu: nil]
  8458.  
  8459.         ifFalse: [helptype = 'editing'
  8460.  
  8461.                 ifTrue: [noteView := TextView
  8462.  
  8463.                                 on: aHelpScreen
  8464.  
  8465.                                 aspect: #editInfo
  8466.  
  8467.                                 change: nil
  8468.  
  8469.                                 menu: nil]
  8470.  
  8471.                 ifFalse: [helptype = 'querying'
  8472.  
  8473.                         ifTrue: [noteView := TextView
  8474.  
  8475.                                         on: aHelpScreen
  8476.  
  8477.                                         aspect: #queryInfo
  8478.  
  8479.                                         change: nil
  8480.  
  8481.                                         menu: nil]
  8482.  
  8483.                         ifFalse: [helptype = 'specifying'
  8484.  
  8485.                                 ifTrue: [noteView := TextView
  8486.  
  8487.                                                 on: aHelpScreen
  8488.  
  8489.                                                 aspect: #icInfo
  8490.  
  8491.                                                 change: nil
  8492.  
  8493.                                                 menu: nil]
  8494.  
  8495.                                 ifFalse: [noteView := TextView
  8496.  
  8497.                                                 on: aHelpScreen
  8498.  
  8499.                                                 aspect: #simulateInfo
  8500.  
  8501.                                                 change: nil
  8502.  
  8503.                                                 menu: nil]]]].
  8504.  
  8505.     (container add: (LookPreferences edgeDecorator on: noteView)
  8506.  
  8507.         borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.95))
  8508.  
  8509.         insideColor: ColorValue white.
  8510.  
  8511.     left := 0.0.
  8512.  
  8513.     hsize := 0.195.
  8514.  
  8515.     top := 0.95.
  8516.  
  8517.     vsize := 0.05.    "Button for quitting"
  8518.  
  8519.     qButton := PushButton named: 'Exit Help'.
  8520.  
  8521.     qButton model: ((PluggableAdaptor on: aHelpScreen)
  8522.  
  8523.             getBlock: [:model | false]
  8524.  
  8525.             putBlock: [:model :value | ScheduledControllers activeController close]
  8526.  
  8527.             updateBlock: [:model :value :parameter | false]).
  8528.  
  8529.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  8530.  
  8531.         insideColor: ColorValue white.
  8532.  
  8533.     helptype = 'introduction'
  8534.  
  8535.         ifTrue: 
  8536.  
  8537.             [left := left + hsize.
  8538.  
  8539.             h1Button := PushButton named: 'Help-Edit'.
  8540.  
  8541.             h1Button model: ((PluggableAdaptor on: aHelpScreen)
  8542.  
  8543.                     getBlock: [:model | false]
  8544.  
  8545.                     putBlock: [:model :value | model doEditInfo]
  8546.  
  8547.                     updateBlock: [:model :value :parameter | false]).
  8548.  
  8549.             (container add: h1Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  8550.  
  8551.                 insideColor: ColorValue white.
  8552.  
  8553.             left := left + hsize.
  8554.  
  8555.             h2Button := PushButton named: 'Help-Query'.
  8556.  
  8557.             h2Button model: ((PluggableAdaptor on: aHelpScreen)
  8558.  
  8559.                     getBlock: [:model | false]
  8560.  
  8561.                     putBlock: [:model :value | model doQueryInfo]
  8562.  
  8563.                     updateBlock: [:model :value :parameter | false]).
  8564.  
  8565.             (container add: h2Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize + 0.02; bottomFraction: top + vsize))
  8566.  
  8567.                 insideColor: ColorValue white.
  8568.  
  8569.             left := left + hsize + 0.02.
  8570.  
  8571.             h3Button := PushButton named: 'Help-Sim.'.
  8572.  
  8573.             h3Button model: ((PluggableAdaptor on: aHelpScreen)
  8574.  
  8575.                     getBlock: [:model | false]
  8576.  
  8577.                     putBlock: [:model :value | model doSimulateInfo]
  8578.  
  8579.                     updateBlock: [:model :value :parameter | false]).
  8580.  
  8581.             (container add: h3Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  8582.  
  8583.                 insideColor: ColorValue white.
  8584.  
  8585.             left := left + hsize.
  8586.  
  8587.             h4Button := PushButton named: 'Help-ICs'.
  8588.  
  8589.             h4Button model: ((PluggableAdaptor on: aHelpScreen)
  8590.  
  8591.                     getBlock: [:model | false]
  8592.  
  8593.                     putBlock: [:model :value | model doICInfo]
  8594.  
  8595.                     updateBlock: [:model :value :parameter | false]).
  8596.  
  8597.             (container add: h4Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  8598.  
  8599.                 insideColor: ColorValue white].
  8600.  
  8601.     window component: container.
  8602.  
  8603.     window open! !
  8604.  
  8605. !HelpScreens class methodsFor: 'instance creation'!
  8606. openTable: aTransition
  8607.  
  8608.  
  8609.  
  8610.    self openTable: (self new: aTransition) for: aTransition! !
  8611.  
  8612. !HelpScreens class methodsFor: 'instance creation'!
  8613. openTable: aTrScreen for: currentTr 
  8614.  
  8615.     | window container noteView qButton |
  8616.  
  8617.     window := ScheduledWindow new.
  8618.  
  8619.     window label: 'Transition Info'.
  8620.  
  8621.     window minimumSize: 300 @ 150.
  8622.  
  8623.     container := CompositePart new.
  8624.  
  8625.     noteView := TextView
  8626.  
  8627.                 on: aTrScreen
  8628.  
  8629.                 aspect: #transition
  8630.  
  8631.                 change: nil
  8632.  
  8633.                 menu: nil.
  8634.  
  8635.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  8636.  
  8637.         insideColor: ColorValue gray.
  8638.  
  8639.     (container add: (LookPreferences edgeDecorator on: noteView)
  8640.  
  8641.         borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.85))
  8642.  
  8643.         insideColor: ColorValue white.    "Button for quitting"
  8644.  
  8645.     qButton := PushButton named: 'Exit Info Display'.
  8646.  
  8647.     qButton model: ((PluggableAdaptor on: aTrScreen)
  8648.  
  8649.             getBlock: [:model | false]
  8650.  
  8651.             putBlock: [:model :value | ScheduledControllers activeController close]
  8652.  
  8653.             updateBlock: [:model :value :parameter | false]).
  8654.  
  8655.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: 0.0; topFraction: 0.85; rightFraction: 0.195; bottomFraction: 1.0))
  8656.  
  8657.         insideColor: ColorValue white.
  8658.  
  8659.     window component: container.
  8660.  
  8661.     window open! !
  8662.  
  8663. !HelpScreens class methodsFor: 'decoration'!
  8664. buttonWrap: aLabel 
  8665.  
  8666.      | newLabel |
  8667.  
  8668.      newLabel := aLabel.
  8669.  
  8670.      newLabel insideColor: ColorValue white.
  8671.  
  8672.      "newLabel borderColor: ColorValue black."
  8673.  
  8674.      "newLabel borderWidth: 1."
  8675.  
  8676.      ^newLabel! !
  8677.  
  8678. TextList subclass: #AlteredTextList
  8679.     instanceVariableNames: ''
  8680.     classVariableNames: ''
  8681.     poolDictionaries: ''
  8682.     category: 'Build'!
  8683.  
  8684. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  8685.  
  8686. AlteredTextList class
  8687.     instanceVariableNames: ''!
  8688.  
  8689. !AlteredTextList class methodsFor: 'instance creation'!
  8690. onList: aListArray 
  8691.  
  8692.     "Altered method of class TextList. 
  8693.  
  8694.     Changed so that the text style is fixed which allows 
  8695.  
  8696.     for column formatting of the display."
  8697.  
  8698.  
  8699.  
  8700.     ^self new list: aListArray style: (TextAttributes styleNamed: #fixed)! !
  8701.  
  8702. Object subclass: #BuildDummy
  8703.     instanceVariableNames: ''
  8704.     classVariableNames: ''
  8705.     poolDictionaries: ''
  8706.     category: 'Build'!
  8707.  
  8708. !BuildDummy methodsFor: 'ignored'!
  8709. reportFor: ignore! !
  8710.  
  8711. DialogView subclass: #ExtendedDialogView
  8712.     instanceVariableNames: ''
  8713.     classVariableNames: ''
  8714.     poolDictionaries: ''
  8715.     category: 'Build'!
  8716.  
  8717. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  8718.  
  8719. ExtendedDialogView class
  8720.     instanceVariableNames: ''!
  8721.  
  8722. !ExtendedDialogView class methodsFor: 'instance creation'!
  8723. request: messageString1 and: messageString2 withInitial: one and: two
  8724.     " Request two strings from the user. "
  8725.     "ExtendedDialogView request: 'First name' and: 'last name' withInitial: 'dumb' and: 'butt'"
  8726.  
  8727.     | theModel |
  8728.     theModel := ValueHolder with: (Array with: '' with: '').
  8729.     (self model: theModel)
  8730.         addVerticalSpace: 3;
  8731.         addTextLabel: messageString1;
  8732.         addTextFieldOn: ((PluggableAdaptor on: theModel) collectionIndex: 1)
  8733.             initially: one;
  8734.         addVerticalSpace: 3;
  8735.         addTextLabel: messageString2;
  8736.         addTextFieldOn: ((PluggableAdaptor on: theModel) collectionIndex: 2)
  8737.             initially: two;
  8738.         addVerticalSpace: 3;
  8739.         open.
  8740.     ^theModel value! !
  8741.  
  8742. !ExtendedDialogView class methodsFor: 'instance creation'!
  8743. request: messageString1 and: messageString2 withInitial: one and: two onCancel: aBlockOrNil 
  8744.     "Request two strings from the user."
  8745.     "ExtendedDialogView request: 'First name' and: 'last name' 
  8746.     withInitial: 'dumb' and: 'butt' onCancel: [1+ 3]"
  8747.  
  8748.     | theModel acceptView aDV cancelView wasCanceled yp |
  8749.     theModel := ValueHolder with: (Array with: '' with: '').
  8750.     aDV := self model: theModel.
  8751.     wasCanceled := false.
  8752.     aDV addVerticalSpace: 3; addTextLabel: messageString1; addTextFieldOn: ((PluggableAdaptor on: theModel)
  8753.             collectionIndex: 1)
  8754.         initially: one; addVerticalSpace: 3; addTextLabel: messageString2; addTextFieldOn: ((PluggableAdaptor on: theModel)
  8755.             collectionIndex: 2)
  8756.         initially: two; addVerticalSpace: 4.
  8757.     aBlockOrNil == nil
  8758.         ifFalse: 
  8759.             [acceptView := (Button trigger) beDefault; model: ((PluggableAdaptor on: theModel)
  8760.                             getBlock: [:m | false]
  8761.                             putBlock: [:m :v | aDV controller accept]
  8762.                             updateBlock: [:m :a :v | false]); label: 'accept'.
  8763.             cancelView := (Button trigger) model: ((PluggableAdaptor on: theModel)
  8764.                             getBlock: [:m | false]
  8765.                             putBlock: 
  8766.                                 [:m :v | 
  8767.                                 m value: m value.
  8768.                                 wasCanceled := true]
  8769.                             updateBlock: [:m :a :v | false]); label: 'cancel'.
  8770.             yp := aDV yPosition.
  8771.             aDV addWrapper: (BoundedWrapper on: acceptView)
  8772.                 atX: 0.25; yPosition: yp; addWrapper: (BoundedWrapper on: cancelView)
  8773.                 atX: 0.75; addVerticalSpace: 4].
  8774.     aDV open.
  8775.     ^wasCanceled
  8776.         ifTrue: [aBlockOrNil value]
  8777.         ifFalse: [theModel value]! !
  8778.  
  8779. Object subclass: #DisplayObject
  8780.     instanceVariableNames: ''
  8781.     classVariableNames: ''
  8782.     poolDictionaries: ''
  8783.     category: 'Build'!
  8784. DisplayObject comment:
  8785. 'The abstract class DisplayObject provides the protocol for most
  8786.  
  8787. display primitives that are used by other objects, such as Views,
  8788.  
  8789. for presenting information on the screen.  Its subclasses are
  8790.  
  8791. DisplayMedium, DisplayText, InfiniteForm, OpaqueForm, and Path.
  8792.  
  8793.  
  8794.  
  8795. Subclasses must implement methods for 
  8796.  
  8797.      display box access
  8798.  
  8799.           computeBoundingBox
  8800.  
  8801.      displaying
  8802.  
  8803.           displayOn:at:clippingBox:rule:mask:
  8804.  
  8805.  
  8806.  
  8807. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  8808.  
  8809. '!
  8810.  
  8811. DisplayObject comment:
  8812. 'The abstract class DisplayObject provides the protocol for most
  8813.  
  8814. display primitives that are used by other objects, such as Views,
  8815.  
  8816. for presenting information on the screen.  Its subclasses are
  8817.  
  8818. DisplayMedium, DisplayText, InfiniteForm, OpaqueForm, and Path.
  8819.  
  8820.  
  8821.  
  8822. Subclasses must implement methods for 
  8823.  
  8824.      display box access
  8825.  
  8826.           computeBoundingBox
  8827.  
  8828.      displaying
  8829.  
  8830.           displayOn:at:clippingBox:rule:mask:
  8831.  
  8832.  
  8833.  
  8834. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  8835.  
  8836. '!
  8837.  
  8838. !DisplayObject methodsFor: 'accessing'!
  8839. extent
  8840.     "Answer the point that represents the width and height of
  8841.  
  8842. the
  8843.  
  8844.  
  8845.     receiver's bounding box."
  8846.  
  8847.     ^self boundingBox extent! !
  8848.  
  8849. !DisplayObject methodsFor: 'accessing'!
  8850. height
  8851.     "Answer the number that represents the height of the
  8852.  
  8853. receiver's 
  8854.     bounding box."
  8855.  
  8856.     ^self boundingBox height! !
  8857.  
  8858. !DisplayObject methodsFor: 'accessing'!
  8859. offset
  8860.  
  8861.      "Answer the amount by which the receiver should be offset
  8862.  
  8863. when
  8864.  
  8865.      it is displayed or its position is tested."
  8866.  
  8867.  
  8868.  
  8869.      self subclassResponsibility! !
  8870.  
  8871. !DisplayObject methodsFor: 'accessing'!
  8872. offset: aPoint 
  8873.  
  8874.      "Set the amount by which the receiver's position is offset."
  8875.  
  8876.  
  8877.  
  8878.      ^self! !
  8879.  
  8880. !DisplayObject methodsFor: 'accessing'!
  8881. relativeRectangle
  8882.     "Answer a Rectangle whose top left corner is the receiver's
  8883.  
  8884. offset 
  8885.     position
  8886.  
  8887.  and whose width and height are the same as the receiver."
  8888.  
  8889.     ^Rectangle origin: self offset extent: self extent! !
  8890.  
  8891. !DisplayObject methodsFor: 'accessing'!
  8892. width
  8893.     "Answer the number that represents the width of the
  8894.  
  8895. receiver's 
  8896.     bounding box."
  8897.  
  8898.     ^self boundingBox width! !
  8899.  
  8900. !DisplayObject methodsFor: 'truncation and round off'!
  8901. rounded
  8902.  
  8903.      "Convert the offset of the receiver to integer coordinates."
  8904.  
  8905.  
  8906.  
  8907.      self offset: self offset rounded! !
  8908.  
  8909. !DisplayObject methodsFor: 'displaying'!
  8910. display
  8911.  
  8912.      "Show the receiver on the display screen.  Defaults to
  8913.  
  8914. showing the receiver
  8915.  
  8916.      in the upper left corner of the screen."
  8917.  
  8918.  
  8919.  
  8920.      self displayOn: Display! !
  8921.  
  8922. !DisplayObject methodsFor: 'displaying'!
  8923. displayAt: aDisplayPoint 
  8924.  
  8925.      "Display the receiver located at aDisplayPoint with default
  8926.  
  8927. settings for the
  8928.  
  8929.      displayMedium, rule and halftone."
  8930.  
  8931.  
  8932.  
  8933.      self displayOn: Display
  8934.  
  8935.           at: aDisplayPoint
  8936.  
  8937.           clippingBox: Display boundingBox
  8938.  
  8939.           rule: Form over
  8940.  
  8941.           mask: Form black! !
  8942.  
  8943. !DisplayObject methodsFor: 'displaying'!
  8944. displayOn: aDisplayMedium 
  8945.  
  8946.     "Simple default display in order to see the receiver in the upper left corner of 
  8947.  
  8948.     screen."
  8949.  
  8950.  
  8951.  
  8952.     self displayOn: aDisplayMedium at: 0 @ 0! !
  8953.  
  8954. !DisplayObject methodsFor: 'displaying'!
  8955. displayOn: aDisplayMedium at: aDisplayPoint 
  8956.  
  8957.     "Display the receiver located at aDisplayPoint with default 
  8958.  
  8959.     settings for rule and halftone."
  8960.  
  8961.  
  8962.  
  8963.     self
  8964.  
  8965.         displayOn: aDisplayMedium
  8966.  
  8967.         at: aDisplayPoint
  8968.  
  8969.         clippingBox: aDisplayMedium boundingBox
  8970.  
  8971.         rule: Form over
  8972.  
  8973.         mask: Form black! !
  8974.  
  8975. !DisplayObject methodsFor: 'displaying'!
  8976. displayOn: aDisplayMedium at: aDisplayPoint clippingBox:
  8977.  
  8978. clipRectangle rule: ruleInteger mask: aForm
  8979.  
  8980.      "This is the basic display primitive for graphic display
  8981.  
  8982. objects.  Display 
  8983.  
  8984.      the receiver located at aDisplayPoint with rule, rule
  8985.  
  8986. ruleInteger, and mask, 
  8987.  
  8988.      aForm.  Information to be displayed must be confined to the
  8989.  
  8990. area that 
  8991.  
  8992.      intersects with clipRectangle."
  8993.  
  8994.  
  8995.  
  8996.      self subclassResponsibility! !
  8997.  
  8998. !DisplayObject methodsFor: 'transforming'!
  8999. align: alignmentPoint with: relativePoint 
  9000.  
  9001.      "Translate the receiver's offset such that alignmentPoint
  9002.  
  9003. aligns with relativePoint."
  9004.  
  9005.  
  9006.  
  9007.      self offset: (self offset translateBy: relativePoint -
  9008.  
  9009. alignmentPoint)! !
  9010.  
  9011. !DisplayObject methodsFor: 'transforming'!
  9012. scaleBy: aPoint 
  9013.  
  9014.      "Scale the receiver's offset by the amount of the argument,
  9015.  
  9016. aPoint."
  9017.  
  9018.  
  9019.  
  9020.      self offset: (self offset scaleBy: aPoint)! !
  9021.  
  9022. !DisplayObject methodsFor: 'transforming'!
  9023. translateBy: aPoint 
  9024.  
  9025.      "Translate the receiver's offset by the amount of the
  9026.  
  9027. argument, aPoint."
  9028.  
  9029.  
  9030.  
  9031.      self offset: (self offset translateBy: aPoint)! !
  9032.  
  9033. DisplayObject subclass: #Path
  9034.     instanceVariableNames: 'form collectionOfPoints '
  9035.     classVariableNames: ''
  9036.     poolDictionaries: ''
  9037.     category: 'Build'!
  9038. Path comment:
  9039. 'Class Path is the basic superclass of the graphic spatial
  9040.  
  9041. primitives.  Spatial primitives are used to generate
  9042.  
  9043. "trajactories" or paths like lines and circles.
  9044.  
  9045.      
  9046.  
  9047. Instance Variables:
  9048.  
  9049.      form      <Form> the "brush" used for displaying the path
  9050.  
  9051.      collectionOfPoints  <OrderedCollection> of Points along the
  9052.  
  9053. path
  9054.  
  9055.  
  9056.  
  9057. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  9058.  
  9059. '!
  9060.  
  9061. Path comment:
  9062. 'Class Path is the basic superclass of the graphic spatial
  9063.  
  9064. primitives.  Spatial primitives are used to generate
  9065.  
  9066. "trajactories" or paths like lines and circles.
  9067.  
  9068.      
  9069.  
  9070. Instance Variables:
  9071.  
  9072.      form      <Form> the "brush" used for displaying the path
  9073.  
  9074.      collectionOfPoints  <OrderedCollection> of Points along the
  9075.  
  9076. path
  9077.  
  9078.  
  9079.  
  9080. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  9081.  
  9082. '!
  9083.  
  9084. !Path methodsFor: 'adding'!
  9085. add: aPoint 
  9086.     "Include aPoint as one of the receiver's elements."
  9087.  
  9088.     collectionOfPoints add: aPoint! !
  9089.  
  9090. !Path methodsFor: 'removing'!
  9091. removeAllSuchThat: aBlock 
  9092.  
  9093.      "Evaluate aBlock with each of the collectionOfPoints's as
  9094.  
  9095. the argument.
  9096.  
  9097.       Remove each point for which aBlock evaluates to true.
  9098.  
  9099.       Answer the new instance of receiver's class."
  9100.  
  9101.  
  9102.  
  9103.      | newCollection newPath |
  9104.  
  9105.      newPath:= self species new.
  9106.  
  9107.      newCollection:= collectionOfPoints removeAllSuchThat:
  9108.  
  9109. aBlock.
  9110.  
  9111.      newCollection do: [:point | newPath add: point].
  9112.  
  9113.      newPath form: self form.
  9114.  
  9115.      ^newPath! !
  9116.  
  9117. !Path methodsFor: 'enumerating'!
  9118. collect: aBlock 
  9119.  
  9120.      "Evaluate aBlock with each of the collectionOfPoints's as
  9121.  
  9122. the argument. 
  9123.  
  9124.      Collect the resulting values into a new collectionOfPoints. 
  9125.  
  9126. Answer the 
  9127.  
  9128.      new instance of receivers' class."
  9129.  
  9130.  
  9131.  
  9132.      | newCollection newPath |
  9133.  
  9134.      newPath:= self species new.
  9135.  
  9136.      newCollection:= collectionOfPoints collect: aBlock.
  9137.  
  9138.      newCollection do: [:point | newPath add: point].
  9139.  
  9140.      newPath form: self form.
  9141.  
  9142.      ^newPath! !
  9143.  
  9144. !Path methodsFor: 'enumerating'!
  9145. select: aBlock 
  9146.  
  9147.      "Evaluate aBlock with each of the collectionOfPoints's as
  9148.  
  9149. the argument. 
  9150.  
  9151.      Collect into a new collectionOfPoints, only those elements
  9152.  
  9153. for which aBlock 
  9154.  
  9155.      evaluates to true.  Answer the new instance of receivers'
  9156.  
  9157. class."
  9158.  
  9159.  
  9160.  
  9161.      | newCollection newPath |
  9162.  
  9163.      newPath:= self species new.
  9164.  
  9165.      newCollection:= collectionOfPoints select: aBlock.
  9166.  
  9167.      newCollection do: [:point | newPath add: point].
  9168.  
  9169.      newPath form: self form.
  9170.  
  9171.      ^newPath! !
  9172.  
  9173. !Path methodsFor: 'testing'!
  9174. isEmpty
  9175.     "Answer whether the receiver contains any elements."
  9176.  
  9177.     ^collectionOfPoints isEmpty! !
  9178.  
  9179. !Path methodsFor: 'accessing'!
  9180. at: index 
  9181.  
  9182.      "Answer the point on the receiver's path at position index."
  9183.  
  9184.  
  9185.  
  9186.      ^collectionOfPoints at: index! !
  9187.  
  9188. !Path methodsFor: 'accessing'!
  9189. at: index put: aPoint 
  9190.  
  9191.      "Store the argument, aPoint, as the point on the receiver's
  9192.  
  9193. path at 
  9194.  
  9195.      position index."
  9196.  
  9197.  
  9198.  
  9199.      ^collectionOfPoints at: index put: aPoint! !
  9200.  
  9201. !Path methodsFor: 'accessing'!
  9202. first
  9203.  
  9204.      "Answer the first point on the receiver's path."
  9205.  
  9206.  
  9207.  
  9208.      ^collectionOfPoints first! !
  9209.  
  9210. !Path methodsFor: 'accessing'!
  9211. firstPoint
  9212.  
  9213.      "Answer the first point on the receiver's path."
  9214.  
  9215.  
  9216.  
  9217.      ^collectionOfPoints first! !
  9218.  
  9219. !Path methodsFor: 'accessing'!
  9220. firstPoint: aPoint 
  9221.  
  9222.      "Answer the argument aPoint.  Replace the first element of
  9223.  
  9224. the receiver
  9225.  
  9226.      with the new value aPoint."
  9227.  
  9228.  
  9229.  
  9230.      collectionOfPoints at: 1 put: aPoint.
  9231.  
  9232.      ^aPoint! !
  9233.  
  9234. !Path methodsFor: 'accessing'!
  9235. form
  9236.  
  9237.      "Answer the receiver's form. If form is nil then a 1 x 1
  9238.  
  9239. black form (a 
  9240.  
  9241.      black dot) is answered."
  9242.  
  9243.  
  9244.  
  9245.      | aForm |
  9246.  
  9247.      form == nil
  9248.  
  9249.           ifTrue: 
  9250.  
  9251.                [aForm:= Form new extent: 1 @ 1.
  9252.  
  9253.                aForm black.
  9254.  
  9255.                ^aForm]
  9256.  
  9257.           ifFalse: 
  9258.  
  9259.                [^form]! !
  9260.  
  9261. !Path methodsFor: 'accessing'!
  9262. last
  9263.  
  9264.      "Answer the last point on the receiver's path."
  9265.  
  9266.  
  9267.  
  9268.      ^collectionOfPoints last! !
  9269.  
  9270. !Path methodsFor: 'accessing'!
  9271. offset
  9272.  
  9273.      "There are basically two kinds of display objects in the
  9274.  
  9275. system:  those that, when 
  9276.  
  9277.      asked to transform themselves, create a new object;  and
  9278.  
  9279. those that side effect 
  9280.  
  9281.      themselves by maintaining a record of the transformation
  9282.  
  9283. request (typically 
  9284.  
  9285.      an offset).  Path, like Rectangle and Point, is a display
  9286.  
  9287. object of the first kind."
  9288.  
  9289.  
  9290.  
  9291.      self shouldNotImplement! !
  9292.  
  9293. !Path methodsFor: 'accessing'!
  9294. secondPoint
  9295.  
  9296.      "Answer the second element of the receiver."
  9297.  
  9298.  
  9299.  
  9300.      ^collectionOfPoints at: 2! !
  9301.  
  9302. !Path methodsFor: 'accessing'!
  9303. secondPoint: aPoint 
  9304.  
  9305.      "Answer the argument aPoint.  Replace the second element of
  9306.  
  9307. the receiver
  9308.  
  9309.      with the new value aPoint."
  9310.  
  9311.  
  9312.  
  9313.      collectionOfPoints at: 2 put: aPoint.
  9314.  
  9315.      ^aPoint! !
  9316.  
  9317. !Path methodsFor: 'accessing'!
  9318. size
  9319.  
  9320.      "Answer how many elements the receiver contains."
  9321.  
  9322.  
  9323.  
  9324.      ^collectionOfPoints size! !
  9325.  
  9326. !Path methodsFor: 'accessing'!
  9327. thirdPoint
  9328.  
  9329.      "Answer the third element of the receiver."
  9330.  
  9331.  
  9332.  
  9333.      ^collectionOfPoints at: 3! !
  9334.  
  9335. !Path methodsFor: 'accessing'!
  9336. thirdPoint: aPoint 
  9337.  
  9338.      "Answer the argument aPoint.  Replace the third element of
  9339.  
  9340. the receiver
  9341.  
  9342.      with the new value aPoint."
  9343.  
  9344.  
  9345.  
  9346.      collectionOfPoints at: 3 put: aPoint.
  9347.  
  9348.      ^aPoint! !
  9349.  
  9350. !Path methodsFor: 'As yet unclassified'!
  9351. form: aForm 
  9352.     "Make the argument, aForm, the receiver's form."
  9353.  
  9354.     form := aForm! !
  9355.  
  9356. !Path methodsFor: 'As yet unclassified'!
  9357. initializeCollectionOfPoints: anInteger 
  9358.     "Initialize the collection of points on the path to have 
  9359.     
  9360.     potential anInteger elements."
  9361.  
  9362.     collectionOfPoints := OrderedCollection new: anInteger! !
  9363.  
  9364. !Path methodsFor: 'displaying'!
  9365. displayOn: aDisplayMedium at: aDisplayPoint clippingBox:
  9366.  
  9367. clipRectangle rule: ruleInteger mask: aForm 
  9368.  
  9369.      "Display this Path--offset by aDisplayPoint, clipped by
  9370.  
  9371. clipRectangle and the form 
  9372.  
  9373.      associated with this Path will be displayed according to one
  9374.  
  9375. of the sixteen 
  9376.  
  9377.      functions of two logical variables (ruleInteger).  Also the
  9378.  
  9379. source form will be first 
  9380.  
  9381.      ANDed with aForm as a mask.  Does not effect the state of
  9382.  
  9383. the Path."
  9384.  
  9385.  
  9386.  
  9387.      collectionOfPoints do: 
  9388.  
  9389.           [:element | 
  9390.  
  9391.           self form
  9392.  
  9393.                displayOn: aDisplayMedium
  9394.  
  9395.                at: element + aDisplayPoint
  9396.  
  9397.                clippingBox: clipRectangle
  9398.  
  9399.                rule: ruleInteger
  9400.  
  9401.                mask: aForm]! !
  9402.  
  9403. !Path methodsFor: 'displaying'!
  9404. displayOn: aDisplayMedium transformation: displayTransformation
  9405.  
  9406. clippingBox:
  9407.  
  9408. clipRectangle rule: ruleInteger mask: aForm 
  9409.  
  9410.      "Displays this path, translated and scaled by
  9411.  
  9412. aTransformation."
  9413.  
  9414.      "get the scaled and translated Path."
  9415.  
  9416.  
  9417.  
  9418.      | transformedPath |
  9419.  
  9420.      transformedPath:= displayTransformation applyTo: self.
  9421.  
  9422.      transformedPath
  9423.  
  9424.           displayOn: aDisplayMedium
  9425.  
  9426.           at: 0 @ 0
  9427.  
  9428.           clippingBox: clipRectangle
  9429.  
  9430.           rule: ruleInteger
  9431.  
  9432.           mask: aForm! !
  9433.  
  9434. !Path methodsFor: 'display box access'!
  9435. computeBoundingBox
  9436.  
  9437.  
  9438.  
  9439.      | box computedOrigin computedExtent |
  9440.  
  9441.      form == nil
  9442.  
  9443.           ifTrue: [computedOrigin:= 0@0.
  9444.  
  9445.                     computedExtent:= 0@0]
  9446.  
  9447.           ifFalse: [computedOrigin:= form offset.
  9448.  
  9449.                     computedExtent:= form extent].
  9450.  
  9451.      box:= Rectangle origin: (self at: 1) + computedOrigin
  9452.  
  9453. extent: computedExtent.
  9454.  
  9455.      collectionOfPoints do:
  9456.  
  9457.           [:aPoint | box:= box merge: (Rectangle origin: aPoint +
  9458.  
  9459. computedOrigin extent: computedExtent)].
  9460.  
  9461.      ^box! !
  9462.  
  9463. !Path methodsFor: 'transforming'!
  9464. scaleBy: aPoint 
  9465.  
  9466.      "Answers with a new Path scaled by aPoint.  Does not effect
  9467.  
  9468. the current data in
  9469.  
  9470.      this Path."
  9471.  
  9472.  
  9473.  
  9474.      | newPath |
  9475.  
  9476.      newPath:= self species new: self size.
  9477.  
  9478.      newPath form: self form.
  9479.  
  9480.      collectionOfPoints do: 
  9481.  
  9482.           [:element | 
  9483.  
  9484.           newPath add: 
  9485.  
  9486.                     (aPoint x * element x) truncated @ (aPoint y
  9487.  
  9488. * element y) truncated].
  9489.  
  9490.      ^newPath! !
  9491.  
  9492. !Path methodsFor: 'transforming'!
  9493. translateBy: aPoint 
  9494.  
  9495.      "Answers with a new instance of Path whose elements are
  9496.  
  9497. translated by aPoint.  
  9498.  
  9499.      Does not effect the elements of this Path."
  9500.  
  9501.  
  9502.  
  9503.      | newPath |
  9504.  
  9505.      newPath:= self species new: self size.
  9506.  
  9507.      newPath form: self form.
  9508.  
  9509.      collectionOfPoints do: 
  9510.  
  9511.           [:element | 
  9512.  
  9513.           newPath add: 
  9514.  
  9515.                (element x + aPoint x) truncated @ (element y +
  9516.  
  9517. aPoint y) truncated].
  9518.  
  9519.      ^newPath! !
  9520.  
  9521. !Path methodsFor: 'private'!
  9522. initializeCollectionOfPoints
  9523.  
  9524.      "Initialize the collection of points on the path to be
  9525.  
  9526. empty."
  9527.  
  9528.  
  9529.  
  9530.      collectionOfPoints:= OrderedCollection new! !
  9531.  
  9532. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  9533.  
  9534. Path class
  9535.     instanceVariableNames: ''!
  9536.  
  9537. !Path class methodsFor: 'instance creation'!
  9538. new
  9539.  
  9540.      "Answer a new instance of the receiver that is an empty
  9541.  
  9542. sequence."
  9543.  
  9544.  
  9545.  
  9546.      ^self basicNew initializeCollectionOfPoints! !
  9547.  
  9548. !Path class methodsFor: 'instance creation'!
  9549. new: anInteger 
  9550.  
  9551.      "Answer a new instance of the receiver that has
  9552.  
  9553.      initially anInteger elements in its sequence."
  9554.  
  9555.  
  9556.  
  9557.      ^self basicNew initializeCollectionOfPoints: anInteger! !
  9558.  
  9559. Path subclass: #Spline2
  9560.     instanceVariableNames: 'derivatives '
  9561.     classVariableNames: ''
  9562.     poolDictionaries: ''
  9563.     category: 'Build'!
  9564. Spline2 comment:
  9565. 'Class Spline is a subclass of Path representing a collection of
  9566.  
  9567. Points through which a cubic spline curve is fitted.
  9568.  
  9569.  
  9570.  
  9571. Instance Variables:
  9572.  
  9573.      derivatives    <Array of: Points>
  9574.  
  9575.  
  9576.  
  9577. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  9578.  
  9579. '!
  9580.  
  9581. Spline2 comment:
  9582. 'Class Spline is a subclass of Path representing a collection of
  9583.  
  9584. Points through which a cubic spline curve is fitted.
  9585.  
  9586.  
  9587.  
  9588. Instance Variables:
  9589.  
  9590.      derivatives    <Array of: Points>
  9591.  
  9592.  
  9593.  
  9594. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  9595.  
  9596. '!
  9597.  
  9598. !Spline2 methodsFor: 'accessing'!
  9599. derivativePointsAt: knot 
  9600.     "Answer an Array of three points around the element of the 
  9601.     
  9602.     path knot."
  9603.  
  9604.     ^Array
  9605.         with: ((derivatives at: 1)
  9606.                 at: knot)
  9607.         with: ((derivatives at: 2)
  9608.                 at: knot)
  9609.         with: ((derivatives at: 3)
  9610.                 at: knot)! !
  9611.  
  9612. !Spline2 methodsFor: 'accessing'!
  9613. isCyclic
  9614.     "Answer whether the receiver is cyclic, i.e., folds back on 
  9615.     
  9616.     itself."
  9617.  
  9618.     ^self size > 3 and: [self first = self last]! !
  9619.  
  9620. !Spline2 methodsFor: 'displaying'!
  9621. display
  9622.  
  9623.      "Method for display of a Spline curve approximated by
  9624.  
  9625. straight line segments."
  9626.  
  9627.  
  9628.  
  9629.      | steps a b c d t  begin end endX endY aGraphicsContext |
  9630.  
  9631.       aGraphicsContext:= (Window currentWindow) graphicsContext.
  9632.  
  9633.      begin:= self first.
  9634.  
  9635.      1 to: self size-1 do:         "for each knot"
  9636.  
  9637.           [:k | 
  9638.  
  9639.                "taylor series coefficients"
  9640.  
  9641.           d:= self at: k.
  9642.  
  9643.           c:= (derivatives at: 1) at: k.
  9644.  
  9645.           b:= ((derivatives at: 2) at: k) / 2.0.
  9646.  
  9647.           a:= ((derivatives at: 3) at: k) / 6.0.
  9648.  
  9649.                "guess stepping parameter"
  9650.  
  9651.           steps:= ((derivatives at: 2) at: k) abs + ((derivatives
  9652.  
  9653. at: 2) at: k+1) abs.
  9654.  
  9655.           steps:= 5 max: (steps x + steps y) // 100.
  9656.  
  9657.           1 to: steps do: 
  9658.  
  9659.                [:j | 
  9660.  
  9661.                t:= j asFloat / steps asFloat.
  9662.  
  9663.                endX:= a x * t + b x * t + c x * t + d x.
  9664.  
  9665.                endY:= a y * t + b y * t + c y * t + d y.
  9666.  
  9667.                end:= endX @ endY.
  9668.  
  9669.                aGraphicsContext displayLineFrom: begin  to: end.
  9670.  
  9671.                begin:= end].
  9672.  
  9673.           end:= (self at: k+1).
  9674.  
  9675.           aGraphicsContext displayLineFrom: begin  to: end.
  9676.  
  9677.           ]! !
  9678.  
  9679. !Spline2 methodsFor: 'displaying'!
  9680. displayArcOnContext2: aGraphicsContext onView: aView 
  9681.  
  9682.      "Method for display of a Spline curve approximated by
  9683.  
  9684. straight line 
  9685.  
  9686.      segments."
  9687.  
  9688.  
  9689.  
  9690.      | steps a b c d t begin end endX endY temp |
  9691.  
  9692.      begin:= self first.
  9693.  
  9694.      1 to: self size - 1 do: 
  9695.  
  9696.           [:k | 
  9697.  
  9698.           "for each knot"
  9699.  
  9700.           "taylor series coefficients"
  9701.  
  9702.           d:= self at: k.
  9703.  
  9704.           c:= (derivatives at: 1)
  9705.  
  9706.                          at: k.
  9707.  
  9708.           b:= ((derivatives at: 2)
  9709.  
  9710.                          at: k)
  9711.  
  9712.                          / 2.0.
  9713.  
  9714.           a:= ((derivatives at: 3)
  9715.  
  9716.                          at: k)
  9717.  
  9718.                          / 6.0.    "guess stepping parameter"
  9719.  
  9720.           steps:= ((derivatives at: 2)
  9721.  
  9722.                          at: k) abs + ((derivatives at: 2)
  9723.  
  9724.                               at: k + 1) abs.
  9725.  
  9726.           steps:= 5 max: steps x + steps y // 100.
  9727.  
  9728.           1 to: steps do: 
  9729.  
  9730.                [:j | 
  9731.  
  9732.                t:= j asFloat / steps asFloat.
  9733.  
  9734.                endX:= a x * t + b x * t + c x * t + d x.
  9735.  
  9736.                endY:= a y * t + b y * t + c y * t + d y.
  9737.  
  9738.                end:= endX @ endY.
  9739.  
  9740.                aGraphicsContext paint: ColorValue black;
  9741.  
  9742. lineWidth: 2; displayLineFrom: begin to: end.
  9743.  
  9744.                temp:= begin.
  9745.  
  9746.                begin:= end].  
  9747.  
  9748.           end:= self at: k + 1].
  9749.  
  9750.      ^temp! !
  9751.  
  9752. !Spline2 methodsFor: 'displaying'!
  9753. displayArcOnContext: aGraphicsContext onView: aView 
  9754.     "Method for display of a Spline curve approximated by 
  9755.     
  9756.     straight line 
  9757.     
  9758.     segments."
  9759.  
  9760.     | steps a b c d t begin end endX endY temp |
  9761.     begin := self first.
  9762.     1 to: self size - 1
  9763.         do: 
  9764.             [:k | 
  9765.             "for each knot"
  9766.             "taylor series coefficients"
  9767.             d := self at: k.
  9768.             c := (derivatives at: 1)
  9769.                         at: k.
  9770.             b := ((derivatives at: 2)
  9771.                         at: k)
  9772.                         / 2.0.
  9773.             a := ((derivatives at: 3)
  9774.                         at: k)
  9775.                         / 6.0.    "guess stepping parameter"
  9776.             steps := ((derivatives at: 2)
  9777.                         at: k) abs + ((derivatives at: 2)
  9778.                             at: k + 1) abs.
  9779.             steps := 5 max: steps x + steps y // 100.
  9780.             1 to: steps
  9781.                 do: 
  9782.                     [:j | 
  9783.                     t := j asFloat / steps asFloat.
  9784.                     endX := a x * t + b x * t + c x * t + d x.
  9785.                     endY := a y * t + b y * t + c y * t + d y.
  9786.                     end := endX @ endY.
  9787.                     aGraphicsContext paint: ColorValue black; lineWidth: 3; displayLineFrom: begin to: end.
  9788.                     temp := begin.
  9789.                     begin := end].
  9790.             end := self at: k + 1].
  9791.     ^temp! !
  9792.  
  9793. !Spline2 methodsFor: 'displaying'!
  9794. displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule:
  9795.  
  9796. anInteger mask: aForm 
  9797.  
  9798.      "Method for display of a Spline curve approximated by
  9799.  
  9800. straight line segments."
  9801.  
  9802.  
  9803.  
  9804.      | steps a b c d t myBlt begin end endX endY |
  9805.  
  9806.      myBlt:= BitBlt
  9807.  
  9808.           destForm: aDisplayMedium
  9809.  
  9810.           sourceForm: self form
  9811.  
  9812.           halftoneForm: aForm
  9813.  
  9814.           combinationRule: anInteger
  9815.  
  9816.           destOrigin: aPoint
  9817.  
  9818.           sourceOrigin: 0 @ 0
  9819.  
  9820.           extent: Display extent
  9821.  
  9822.           clipRect: clipRect.
  9823.  
  9824.      begin:= self first.
  9825.  
  9826.      1 to: self size-1 do:         "for each knot"
  9827.  
  9828.           [:k | 
  9829.  
  9830.                "taylor series coefficients"
  9831.  
  9832.           d:= self at: k.
  9833.  
  9834.           c:= (derivatives at: 1) at: k.
  9835.  
  9836.           b:= ((derivatives at: 2) at: k) / 2.0.
  9837.  
  9838.           a:= ((derivatives at: 3) at: k) / 6.0.
  9839.  
  9840.                "guess stepping parameter"
  9841.  
  9842.           steps:= ((derivatives at: 2) at: k) abs + ((derivatives
  9843.  
  9844. at: 2) at: k+1) abs.
  9845.  
  9846.           steps:= 5 max: (steps x + steps y) // 100.
  9847.  
  9848.           1 to: steps do: 
  9849.  
  9850.                [:j | 
  9851.  
  9852.                t:= j asFloat / steps asFloat.
  9853.  
  9854.                endX:= a x * t + b x * t + c x * t + d x.
  9855.  
  9856.                endY:= a y * t + b y * t + c y * t + d y.
  9857.  
  9858.                end:= endX @ endY.
  9859.  
  9860.                myBlt drawFrom: begin rounded to: end rounded.
  9861.  
  9862.                begin:= end].
  9863.  
  9864.           end:= (self at: k+1).
  9865.  
  9866.           myBlt drawFrom: begin rounded to: end rounded.
  9867.  
  9868.           ]! !
  9869.  
  9870. !Spline2 methodsFor: 'displaying'!
  9871. displayOnContext: aGraphicsContext 
  9872.  
  9873.     "Method for display of a Spline curve approximated by straight line segments."
  9874.  
  9875.  
  9876.  
  9877.     | steps a b c d t begin end endX endY |
  9878.  
  9879.     begin := self first.
  9880.  
  9881.     1 to: self size - 1
  9882.  
  9883.         do: 
  9884.  
  9885.             [:k | 
  9886.  
  9887.             "for each knot"
  9888.  
  9889.             "taylor series coefficients"
  9890.  
  9891.             d := self at: k.
  9892.  
  9893.             c := (derivatives at: 1)
  9894.  
  9895.                         at: k.
  9896.  
  9897.             b := ((derivatives at: 2)
  9898.  
  9899.                         at: k)
  9900.  
  9901.                         / 2.0.
  9902.  
  9903.             a := ((derivatives at: 3)
  9904.  
  9905.                         at: k)
  9906.  
  9907.                         / 6.0.    "guess stepping parameter"
  9908.  
  9909.             steps := ((derivatives at: 2)
  9910.  
  9911.                         at: k) abs + ((derivatives at: 2)
  9912.  
  9913.                             at: k + 1) abs.
  9914.  
  9915.             steps := 5 max: steps x + steps y // 100.
  9916.  
  9917.             1 to: steps
  9918.  
  9919.                 do: 
  9920.  
  9921.                     [:j | 
  9922.  
  9923.                     t := j asFloat / steps asFloat.
  9924.  
  9925.                     endX := a x * t + b x * t + c x * t + d x.
  9926.  
  9927.                     endY := a y * t + b y * t + c y * t + d y.
  9928.  
  9929.                     end := endX @ endY.
  9930.  
  9931.                     aGraphicsContext displayLineFrom: begin to: end.
  9932.  
  9933.                     begin := end].
  9934.  
  9935.             end := self at: k + 1.
  9936.  
  9937.             aGraphicsContext displayLineFrom: begin to: end]! !
  9938.  
  9939. !Spline2 methodsFor: 'private'!
  9940. computeCurve
  9941.     "Compute an array for the derivatives at each knot."
  9942.  
  9943.     | size extras values |
  9944.     size := self size.
  9945.     self isCyclic
  9946.         ifTrue: 
  9947.             ["for cyclic curves"
  9948.             extras := 2.    "add 2 extra points to each 
  9949.             
  9950.             end."
  9951.             values := Array new: 2 * extras + size.
  9952.             1 to: extras
  9953.                 do: 
  9954.                     [:i | 
  9955.                     values at: i put: (self at: size - extras + i - 1).
  9956.                     values at: size + extras + i put: (self at: i + 1)].
  9957.             values
  9958.                 replaceFrom: extras + 1
  9959.                 to: extras + size
  9960.                 with: collectionOfPoints]
  9961.         ifFalse: 
  9962.             [extras := 0.
  9963.             values := collectionOfPoints].
  9964.     derivatives := Array new: 3.
  9965.     1 to: 3 do: [:i | derivatives at: i put: (Array new: values size)].
  9966.     self
  9967.         derivs: values
  9968.         first: (derivatives at: 1)
  9969.         second: (derivatives at: 2)
  9970.         third: (derivatives at: 3).
  9971.     extras > 0 ifTrue: ["remove extra points"
  9972.         1 to: 3 do: [:i | derivatives at: i put: ((derivatives at: i)
  9973.                     copyFrom: extras + 1 to: extras + size)]]! !
  9974.  
  9975. !Spline2 methodsFor: 'private'!
  9976. derivs: values first: first second: second third: third 
  9977.     "Compute the first, second and third derivitives at each 
  9978.     
  9979.     point in the array values."
  9980.  
  9981.     | size v b |
  9982.     size := values size.
  9983.     size > 2
  9984.         ifTrue: 
  9985.             [v := Array new: size.
  9986.             v at: 1 put: 4.0.
  9987.             b := Array new: size.
  9988.             b at: 1 put: 6.0 * (values first - ((values at: 2)
  9989.                             * 2.0) + (values at: 3)).
  9990.             2 to: size - 2
  9991.                 do: 
  9992.                     [:i | 
  9993.                     v at: i put: 4.0 - (1.0 / (v at: i - 1)).
  9994.                     b at: i put: 6.0 * ((values at: i)
  9995.                                 - ((values at: i + 1)
  9996.                                         * 2.0) + (values at: i + 2)) - ((b at: i - 1)
  9997.                                 / (v at: i - 1))].
  9998.             second at: size - 1 put: (b at: size - 2)
  9999.                     / (v at: size - 2).
  10000.             size - 2
  10001.                 to: 2
  10002.                 by: -1
  10003.                 do: [:i | second at: i put: (b at: i - 1)
  10004.                             - (second at: i + 1) / (v at: i - 1)]].
  10005.     second at: 1 put: 0.0 asPoint.
  10006.     second at: size put: 0.0 asPoint.
  10007.     1 to: size - 1
  10008.         do: 
  10009.             [:i | 
  10010.             first at: i put: (values at: i + 1)
  10011.                     - (values at: i) - ((second at: i)
  10012.                         * 2.0 + (second at: i + 1) / 6.0).
  10013.             third at: i put: (second at: i + 1)
  10014.                     - (second at: i)]! !
  10015.  
  10016. ApplicationModel subclass: #SimulateWindow
  10017.     instanceVariableNames: 'currentTime currentTTM initialCondition finalCondition table tableEntry tabs ttmVariables icSelection fcSelection stop transitionTimes cursorPt displayedVariables filterActView filterDataView filterNewView filterWindowOpen variableLabels windowGC container filterWindow resultCollection simulateTable trajectoryTable tableInterface trajectoryList ncols nrows aLine total icList fcList fcTempString icFormatted clockList advanceNumber advanceTransition advanceTransitionNumber doAdvance doAdvanceTransition lastTransition advanceCount advanceTransitionNumberAspect transitionList tlMenuAspect tlOutAspect pause doAdvanceNoTick '
  10018.     classVariableNames: ''
  10019.     poolDictionaries: ''
  10020.     category: 'Build'!
  10021.  
  10022. !SimulateWindow methodsFor: 'initialize-release'!
  10023. correctVariables
  10024.     | name temp ind |
  10025.     temp := OrderedCollection new.
  10026.     currentTTM currentlyDisplayedSimulateVariables notNil
  10027.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  10028.                 do: 
  10029.                     [:cDV | 
  10030.                     name := cDV at: 1.
  10031.                     ind := 0.
  10032.                     initialCondition
  10033.                         do: 
  10034.                             [:t | 
  10035.                             ind := ind + 1.
  10036.                             (t at: 1)
  10037.                                 = name ifTrue: [temp add: (Array with: name with: ind)]]]]
  10038.         ifFalse: [^nil].
  10039.     ^temp asArray! !
  10040.  
  10041. !SimulateWindow methodsFor: 'initialize-release'!
  10042. initializeNTable
  10043.     | list |
  10044.     trajectoryList := OrderedCollection new.
  10045.     aLine := OrderedCollection new.
  10046.     list := TwoDList
  10047.                 on: trajectoryList
  10048.                 columns: 0
  10049.                 rows: 0.
  10050.     trajectoryTable := SelectionInTable with: list.
  10051.     tableInterface := TableInterface new.
  10052.     tableInterface selectionInTable: trajectoryTable.
  10053.       total := 0.
  10054.     nrows := 0.
  10055.     ncols := 0! !
  10056.  
  10057. !SimulateWindow methodsFor: 'initialize-release'!
  10058. initializeTable
  10059.     ttmVariables := OrderedCollection new.
  10060.     initialCondition do: [:x | ttmVariables add: ((Array ) with: (x at: 1) copy with: (x at: 2) copy)].
  10061.     icFormatted := OrderedCollection new.
  10062.       initialCondition do: [:x| icFormatted add:( (x at: 1), ' = ', (x at: 2)) ].
  10063.     icList list: icFormatted .
  10064.     self resetTable! !
  10065.  
  10066. !SimulateWindow methodsFor: 'initialize-release'!
  10067. initializeTTM: instanceOfTTM 
  10068.     "Prepare the TTM for displaying by initializing the variables."
  10069.  
  10070.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  10071.     advanceNumber := 1.
  10072.     advanceTransition := ''.
  10073.     advanceTransitionNumber := 1.
  10074.     doAdvance := false.
  10075.     doAdvanceTransition := false.
  10076.     doAdvanceNoTick := false.
  10077.     stop := true.
  10078.     currentTTM := instanceOfTTM.
  10079.     currentTime := 0.
  10080.     tabs := OrderedCollection new.
  10081.     transitionList := OrderedCollection new.
  10082.     transitionList add: 'NONE'; add: 'Any Transition'; add: 'Any except tick'; add: 'tick'.
  10083.     filterWindowOpen := False.
  10084.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  10085.                     with: (currentTTM defaultOfAV: (existingAV at: 1)) ].
  10086.     count := 1.
  10087.     currentTTM datavariable size
  10088.         timesRepeat: 
  10089.             [existingDV := currentTTM datavariable at: count.
  10090.             existingDV := Array with: (existingDV at: 1)
  10091.                         with: (existingDV at: 4).
  10092.             count := count + 1.
  10093.             initialCondition add: existingDV].
  10094.     finalCondition := '0=1'.
  10095.     fcTempString := finalCondition copy.
  10096.     fcList := fcTempString asValue.
  10097.     icFormatted := OrderedCollection new.
  10098.     initialCondition do: [:x | icFormatted add: (x at: 1)
  10099.                 , ' = ' , (x at: 2)].
  10100.     icList := SelectionInList new list: icFormatted.
  10101.     transitionTimes := OrderedCollection new.
  10102.     count := 1.
  10103.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  10104.     aTransitionCollection
  10105.         do: 
  10106.             [:x | 
  10107.             aTransitionEntry := OrderedCollection new.
  10108.             set := OrderedCollection new.
  10109.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  10110.             transitionList add: x myName.
  10111.             aTransitionEntry add: set; add: 0.
  10112.             transitionTimes add: aTransitionEntry].
  10113.     labels := OrderedCollection new.
  10114.     labels add: 'ticks'.
  10115.     currentTTM currentlyDisplayedSimulateVariables: self correctVariables.
  10116.     t1 := initialCondition size.
  10117.     currentTTM currentlyDisplayedSimulateVariables notNil
  10118.         ifTrue: 
  10119.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  10120.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  10121.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  10122.     self initializeNTable.
  10123.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  10124.     ncols := t1 + 1.
  10125.     self initializeTable! !
  10126.  
  10127. !SimulateWindow methodsFor: 'initialize-release'!
  10128. initializeTTMNew: instanceOfTTM 
  10129.     "Prepare the TTM for displaying by initializing the variables."
  10130.  
  10131.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  10132.     advanceNumber := 1.
  10133.     advanceTransition := ''.
  10134.     advanceTransitionNumber := 1.
  10135.     doAdvance := false.
  10136.     doAdvanceTransition := false.
  10137.       doAdvanceNoTick := false.
  10138.     stop := true.
  10139.     currentTTM := instanceOfTTM.
  10140.     currentTime := 0.
  10141.     tabs := OrderedCollection new.
  10142.     transitionList := OrderedCollection new.
  10143.     transitionList add: 'NONE'; add: 'Any Transition';  add: 'Any except tick';add: 'tick'.
  10144.     filterWindowOpen := False.
  10145.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  10146.                     with:(existingAV at: 2) inspect].
  10147.     count := 1.
  10148.     currentTTM datavariable size
  10149.         timesRepeat: 
  10150.             [existingDV := currentTTM datavariable at: count.
  10151.             existingDV := Array with: (existingDV at: 1)
  10152.                         with: (existingDV at: 4).
  10153.             count := count + 1.
  10154.             initialCondition add: existingDV].
  10155.     finalCondition := '0=1'.
  10156.     fcTempString := finalCondition copy.
  10157.     fcList := fcTempString asValue.
  10158.     icFormatted := OrderedCollection new.
  10159.     initialCondition do: [:x | icFormatted add: (x at: 1)
  10160.                 , ' = ' , (x at: 2)].
  10161.     icList := SelectionInList new list: icFormatted.
  10162.     transitionTimes := OrderedCollection new.
  10163.     count := 1.
  10164.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  10165.     aTransitionCollection
  10166.         do: 
  10167.             [:x | 
  10168.             aTransitionEntry := OrderedCollection new.
  10169.             set := OrderedCollection new.
  10170.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  10171.             transitionList add: x myName.
  10172.             aTransitionEntry add: set; add: 0.
  10173.             transitionTimes add: aTransitionEntry].
  10174.     labels := OrderedCollection new.
  10175.     labels add: 'ticks'.
  10176.     t1 := initialCondition size.
  10177.     currentTTM currentlyDisplayedSimulateVariables notNil
  10178.         ifTrue: 
  10179.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  10180.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  10181.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  10182.     self initializeNTable.
  10183.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  10184.     ncols := t1 + 1.
  10185.       
  10186.     self initializeTable! !
  10187.  
  10188. !SimulateWindow methodsFor: 'initialize-release'!
  10189. initializeTTMOld: instanceOfTTM 
  10190.     "Prepare the TTM for displaying by initializing the variables."
  10191.  
  10192.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  10193.     advanceNumber := 1.
  10194.     advanceTransition := ''.
  10195.     advanceTransitionNumber := 1.
  10196.     doAdvance := false.
  10197.     doAdvanceTransition := false.
  10198.       doAdvanceNoTick := false.
  10199.     stop := true.
  10200.     currentTTM := instanceOfTTM.
  10201.     currentTime := 0.
  10202.     tabs := OrderedCollection new.
  10203.     transitionList := OrderedCollection new.
  10204.     transitionList add: 'NONE'; add: 'Any Transition';  add: 'Any except tick';add: 'tick'.
  10205.     filterWindowOpen := False.
  10206.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  10207.                     with: (currentTTM typeForAV: existingAV) last myName].
  10208.     count := 1.
  10209.     currentTTM datavariable size
  10210.         timesRepeat: 
  10211.             [existingDV := currentTTM datavariable at: count.
  10212.             existingDV := Array with: (existingDV at: 1)
  10213.                         with: (existingDV at: 4).
  10214.             count := count + 1.
  10215.             initialCondition add: existingDV].
  10216.     finalCondition := '0=1'.
  10217.     fcTempString := finalCondition copy.
  10218.     fcList := fcTempString asValue.
  10219.     icFormatted := OrderedCollection new.
  10220.     initialCondition do: [:x | icFormatted add: (x at: 1)
  10221.                 , ' = ' , (x at: 2)].
  10222.     icList := SelectionInList new list: icFormatted.
  10223.     transitionTimes := OrderedCollection new.
  10224.     count := 1.
  10225.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  10226.     aTransitionCollection
  10227.         do: 
  10228.             [:x | 
  10229.             aTransitionEntry := OrderedCollection new.
  10230.             set := OrderedCollection new.
  10231.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  10232.             transitionList add: x myName.
  10233.             aTransitionEntry add: set; add: 0.
  10234.             transitionTimes add: aTransitionEntry].
  10235.     labels := OrderedCollection new.
  10236.     labels add: 'ticks'.
  10237.     t1 := initialCondition size.
  10238.     currentTTM currentlyDisplayedSimulateVariables notNil
  10239.         ifTrue: 
  10240.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  10241.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  10242.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  10243.     self initializeNTable.
  10244.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  10245.     ncols := t1 + 1.
  10246.       
  10247.     self initializeTable! !
  10248.  
  10249. !SimulateWindow methodsFor: 'condition maintenance'!
  10250. fcAccept
  10251.     self fcAccept: fcList value! !
  10252.  
  10253. !SimulateWindow methodsFor: 'condition maintenance'!
  10254. fcAccept: candidateCondition 
  10255.     | accept cCondition |
  10256.     accept := false.
  10257.     candidateCondition isEmpty
  10258.         ifTrue: [cCondition := 'nil']
  10259.         ifFalse: [cCondition := candidateCondition].
  10260.     cCondition asString = 'nil'
  10261.         ifTrue: [accept := true]
  10262.         ifFalse: [(ParseTree guardSyntaxCheck: cCondition asString from: currentTTM)
  10263.                 ifFalse: [accept := true]].
  10264.     accept = false
  10265.         ifFalse: 
  10266.             [finalCondition := cCondition asString.
  10267.             self changed: #fcList.
  10268.             ^true]
  10269.         ifTrue: 
  10270.             [TTMList speak: 'revised stopping condition rejected.'.
  10271.             self changed: #fcList.
  10272.             ^true]! !
  10273.  
  10274. !SimulateWindow methodsFor: 'condition maintenance'!
  10275. fcMenu
  10276.     "Answer a menu for the final condition view."
  10277.  
  10278.     ^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #fcAccept #cancel )! !
  10279.  
  10280. !SimulateWindow methodsFor: 'condition maintenance'!
  10281. icChange
  10282.     "Change initial value of a variable."
  10283.  
  10284.     | initial oldInitial actual |
  10285.     icList selection ~~ nil ifFalse: []
  10286.         ifTrue: 
  10287.             [actual := initialCondition at: icList selectionIndex.
  10288.             oldInitial := actual at: 2.
  10289.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  10290.             (currentTTM anExistingDV: (actual at: 1))
  10291.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  10292.                         ifFalse: 
  10293.                             [TTMList speak: 'illegal data variable value.'.
  10294.                             ^self]]
  10295.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  10296.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  10297.                                 ifFalse: 
  10298.                                     [TTMList speak: 'illegal activity variable value.'.
  10299.                                     ^self]]
  10300.                         ifFalse: 
  10301.                             [TTMList speak: 'illegal activity variable value.'.
  10302.                             ^self]].
  10303.             initial isEmpty
  10304.                 ifTrue: [^self]
  10305.                 ifFalse: 
  10306.                     [actual at: 2 put: initial.
  10307.                     icFormatted := OrderedCollection new.
  10308.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  10309.                                 , ' = ' , (x at: 2)].
  10310.                     icList list: icFormatted.
  10311.                     self doClear.
  10312.                     self changed: #icTransaction]]! !
  10313.  
  10314. !SimulateWindow methodsFor: 'condition maintenance'!
  10315. icChangeNew
  10316.     "Change initial value of a variable."
  10317.  
  10318.     | initial oldInitial actual |
  10319.     icList selection ~~ nil ifFalse: []
  10320.         ifTrue: 
  10321.             [actual := initialCondition at: icList selectionIndex.
  10322.             oldInitial := actual at: 2.
  10323.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  10324.             (currentTTM anExistingDV: (actual at: 1))
  10325.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  10326.                         ifFalse: 
  10327.                             [TTMList speak: 'illegal data variable value.'.
  10328.                             ^self]]
  10329.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  10330.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  10331.                                 ifFalse: 
  10332.                                     [TTMList speak: 'illegal activity variable value.'.
  10333.                                     ^self]]
  10334.                         ifFalse: 
  10335.                             [TTMList speak: 'illegal activity variable value.'.
  10336.                             ^self]].
  10337.             initial isEmpty
  10338.                 ifTrue: [^self]
  10339.                 ifFalse: 
  10340.                     [actual at: 2 put: initial.
  10341.                     icFormatted := OrderedCollection new.
  10342.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  10343.                                 , ' = ' , (x at: 2)].
  10344.                     icList list: icFormatted.
  10345.                     self doClear.
  10346.                     self changed: #icTransaction]]! !
  10347.  
  10348. !SimulateWindow methodsFor: 'condition maintenance'!
  10349. icChangeOld
  10350.     "Change initial value of a variable."
  10351.  
  10352.     | initial oldInitial actual |
  10353.     icList selection ~~ nil ifFalse: []
  10354.         ifTrue: 
  10355.             [actual := initialCondition at: icList selectionIndex.
  10356.             oldInitial := actual at: 2.
  10357.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  10358.             (currentTTM anExistingDV: (actual at: 1))
  10359.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  10360.                         ifFalse: 
  10361.                             [TTMList speak: 'illegal data variable value.'.
  10362.                             ^self]]
  10363.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  10364.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  10365.                                 ifFalse: 
  10366.                                     [TTMList speak: 'illegal activity variable value.'.
  10367.                                     ^self]]
  10368.                         ifFalse: 
  10369.                             [TTMList speak: 'illegal activity variable value.'.
  10370.                             ^self]].
  10371.             initial isEmpty
  10372.                 ifTrue: [^self]
  10373.                 ifFalse: 
  10374.                     [actual at: 2 put: initial.
  10375.                     icFormatted := OrderedCollection new.
  10376.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  10377.                                 , ' = ' , (x at: 2)].
  10378.                     icList list: icFormatted.
  10379.                     self changed: #icTransaction.
  10380.                     self initializeTable]]! !
  10381.  
  10382. !SimulateWindow methodsFor: 'condition maintenance'!
  10383. icMenu
  10384.     "Answer a menu for the initial condition view."
  10385.  
  10386.     "icSelection == nil ifTrue: [^nil]."
  10387.     ^PopUpMenu labelList: #(#('new initial value' ) ) values: #(#icChange )! !
  10388.  
  10389. !SimulateWindow methodsFor: 'condition maintenance'!
  10390. icSelection: index 
  10391.     "If the selection has been changed, remember the new 
  10392.     
  10393.     selection."
  10394.  
  10395.     | newSel |
  10396.     newSel := index = 0
  10397.                 ifTrue: [nil]
  10398.                 ifFalse: [initialCondition at: index].
  10399.     icSelection == newSel ifTrue: [^self].
  10400.     icSelection := newSel! !
  10401.  
  10402. !SimulateWindow methodsFor: 'condition maintenance'!
  10403. tlMenu
  10404.     ""
  10405.  
  10406.     
  10407.     ^tlMenuAspect! !
  10408.  
  10409. !SimulateWindow methodsFor: 'table access'!
  10410. addEntry
  10411.     "add the current entry to the table."
  10412.  
  10413.     table addFirst: tableEntry.
  10414.     self changed: #tableTransaction! !
  10415.  
  10416. !SimulateWindow methodsFor: 'table access'!
  10417. addLatestValues
  10418.     "Add the latest values of the ttmVariables to the table and display it."
  10419.  
  10420.     | count existingVariable |
  10421.     count := 1.
  10422.     self addStringToLine: currentTime printString.
  10423.     currentTTM currentlyDisplayedSimulateVariables notNil
  10424.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  10425.                 do: 
  10426.                     [:cDV | 
  10427.                     self addStringToLine: ((ttmVariables at: (cDV at: 2))
  10428.                             at: 2).
  10429.                     count := count + 1]]
  10430.         ifFalse: [ttmVariables size = 0 ifFalse: [[count > ttmVariables size]
  10431.                     whileFalse: 
  10432.                         [existingVariable := ttmVariables at: count.
  10433.                         self addStringToLine: (existingVariable at: 2).
  10434.                         count := count + 1]]].
  10435.     self putLine! !
  10436.  
  10437. !SimulateWindow methodsFor: 'table access'!
  10438. addLatestValuesNew
  10439.     "Add the latest values of the ttmVariables to the table and display it."
  10440.  
  10441.     | count existingVariable |
  10442.     count := 1.
  10443.     self addStringToLine: currentTime printString.
  10444.     currentTTM currentlyDisplayedSimulateVariables notNil
  10445.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  10446.                 do: 
  10447.                     [:cDV | 
  10448.                     self addStringToLine: ((ttmVariables at: (cDV at: 2))
  10449.                             at: 2).
  10450.                     count := count + 1]]
  10451.         ifFalse: [ttmVariables size = 0 ifFalse: [[count > ttmVariables size]
  10452.                     whileFalse: 
  10453.                         [existingVariable := ttmVariables at: count.
  10454.                         self addStringToLine: (existingVariable at: 2).
  10455.                         count := count + 1]]].
  10456.     self putLine! !
  10457.  
  10458. !SimulateWindow methodsFor: 'table access'!
  10459. addTransition: transitionName 
  10460.     "Add a transition and arrow to the table and display it."
  10461.  
  10462.     | count sp |
  10463.     sp := 3.
  10464.     count := 1.
  10465.     ncols = 2
  10466.         ifTrue: 
  10467.             [self addStringToLine: ''.
  10468.             self addStringToLine: '  ^' , transitionName]
  10469.         ifFalse: [ncols
  10470.                 timesRepeat: 
  10471.                     [count >= sp & (count \\ sp) == 0 ifFalse: [self addStringToLine: '']
  10472.                         ifTrue: [self addStringToLine: '  ^' , transitionName].
  10473.                     count := count + 1]].
  10474.     self putLine! !
  10475.  
  10476. !SimulateWindow methodsFor: 'table access'!
  10477. addTransitionNew: transitionName 
  10478.     "Add a transition and arrow to the table and display it."
  10479.  
  10480.     | midpoint |
  10481.     midpoint := (ncols / 2) ceiling.
  10482.     self addStringToLine: ' | ' , transitionName.
  10483.     2 to: midpoint do: [:x | self addStringToLine: ''].
  10484.     self addStringToLine: ' | '.
  10485.      (midpoint+ 1) to: ncols do: [:x | self addStringToLine: ''].
  10486.     self putLine! !
  10487.  
  10488. !SimulateWindow methodsFor: 'table access'!
  10489. addTransitionOld: transitionName 
  10490.     "Add a transition and arrow to the table and display it."
  10491.     "[table size > 5] whileTrue: [table removeLast]."
  10492.  
  10493.     | midpoint newName |
  10494.  
  10495.     midpoint := ((tabs at: tabs size - 1)
  10496.                 / 2) ceiling.
  10497.     self clearEntry.
  10498.     tableEntry
  10499.         replaceFrom: midpoint
  10500.         to: midpoint
  10501.         with: '|'.
  10502.     self addEntry.
  10503.     self clearEntry.
  10504.     newName := '| ' , transitionName.
  10505.     tableEntry
  10506.         replaceFrom: midpoint
  10507.         to: midpoint + newName size - 1
  10508.         with: newName.
  10509.     self addEntry.
  10510.     self clearEntry.
  10511.     tableEntry
  10512.         replaceFrom: midpoint
  10513.         to: midpoint
  10514.         with: '^'.
  10515.     self addEntry.
  10516.     self clearEntry! !
  10517.  
  10518. !SimulateWindow methodsFor: 'table access'!
  10519. atTab: tabNumber put: aString 
  10520.     "At the supplied tab position insert aString into the tableEntry."
  10521.  
  10522.     | start length allowedLength newString |
  10523.     start := tabs at: tabNumber.
  10524.     length := aString size.
  10525.     allowedLength := (tabs at: tabNumber + 1)
  10526.                 - (start + 1).
  10527.     length > allowedLength
  10528.         ifTrue: 
  10529.             [newString := aString copyFrom: 1 to: allowedLength.
  10530.             tableEntry
  10531.                 replaceFrom: start
  10532.                 to: start + allowedLength - 1
  10533.                 with: newString]
  10534.         ifFalse: [tableEntry
  10535.                 replaceFrom: start
  10536.                 to: start + length - 1
  10537.                 with: aString]! !
  10538.  
  10539. !SimulateWindow methodsFor: 'table access'!
  10540. clearEntry
  10541.     | tableSize |
  10542.     tableEntry := ''.
  10543.     currentTTM currentlyDisplayedSimulateVariables notNil
  10544.         ifTrue: [tableSize := currentTTM currentlyDisplayedSimulateVariables size * 10]
  10545.         ifFalse: [tableSize := ttmVariables size * 10].
  10546.     tableSize < 80 ifTrue: [tableSize := 80].
  10547.     tableSize timesRepeat: [tableEntry := tableEntry , ' ']! !
  10548.  
  10549. !SimulateWindow methodsFor: 'table access'!
  10550. resetTable
  10551.     "Clear the table and initialize it to the current 
  10552.     
  10553.     values of the ttmVariables."
  10554.  
  10555.     table := OrderedCollection new.
  10556.     self addLatestValues! !
  10557.  
  10558. !SimulateWindow methodsFor: 'table access'!
  10559. tableList
  10560.     "Return a list of the transition entries."
  10561.  
  10562.     ^table collect: [:currentEntry | currentEntry]! !
  10563.  
  10564. !SimulateWindow methodsFor: 'filter window access'!
  10565. acceptAllActs
  10566.     self actVarList do: [:var | (displayedVariables includes: var)
  10567.             ifFalse: [displayedVariables addLast: var]].
  10568.     filterNewView update: #newVarList! !
  10569.  
  10570. !SimulateWindow methodsFor: 'filter window access'!
  10571. acceptAlldata
  10572.     self dataVarList do: [:var | (displayedVariables includes: var)
  10573.             ifFalse: [displayedVariables addLast: var]].
  10574.     filterNewView update: #newVarList! !
  10575.  
  10576. !SimulateWindow methodsFor: 'filter window access'!
  10577. actVarList
  10578.  
  10579.      ^currentTTM activityvariable collect: [:x | x at: 1]! !
  10580.  
  10581. !SimulateWindow methodsFor: 'filter window access'!
  10582. addAVarToList: ignore 
  10583.     | selection chosen |
  10584.     filterActView notNil
  10585.         ifTrue: 
  10586.             [selection := filterActView selection.
  10587.             selection > 0
  10588.                 ifTrue: 
  10589.                     [chosen := self actVarList at: selection.
  10590.                     (displayedVariables includes: chosen)
  10591.                         ifFalse: 
  10592.                             [displayedVariables addLast: chosen.
  10593.                             filterNewView update: #newVarList]]]! !
  10594.  
  10595. !SimulateWindow methodsFor: 'filter window access'!
  10596. addDVarToList: ignore 
  10597.     | selection chosen |
  10598.     filterDataView notNil
  10599.         ifTrue: 
  10600.             [selection := filterDataView selection.
  10601.             selection > 0
  10602.                 ifTrue: 
  10603.                     [chosen := self dataVarList at: selection.
  10604.                     (displayedVariables includes: chosen)
  10605.                         ifFalse: 
  10606.                             [displayedVariables addLast: chosen.
  10607.                             filterNewView update: #newVarList]]]! !
  10608.  
  10609. !SimulateWindow methodsFor: 'filter window access'!
  10610. addVarToList: ignore! !
  10611.  
  10612. !SimulateWindow methodsFor: 'filter window access'!
  10613. aVarListMenu
  10614.  
  10615.     ^PopUpMenu labelList: #(#('accept all' ) ) values: #(#acceptAllActs )! !
  10616.  
  10617. !SimulateWindow methodsFor: 'filter window access'!
  10618. closeFilter
  10619.     filterWindowOpen := False.
  10620.     "super removeDependent: filterWindow."
  10621.     filterWindow controller close! !
  10622.  
  10623. !SimulateWindow methodsFor: 'filter window access'!
  10624. dataVarList
  10625.     ^currentTTM datavariable collect: [:x | x at: 1]! !
  10626.  
  10627. !SimulateWindow methodsFor: 'filter window access'!
  10628. doAcceptFilter
  10629.     "Accept new set of Variables to be displayed in Simulation Window. 
  10630.     Reset the simulation to its initial state"
  10631.  
  10632.     | variables textLabels ttmVarSize c2 ttmVar newArray theArray c1 |
  10633.     textLabels := OrderedCollection new.
  10634.     theArray := Array new: displayedVariables size.
  10635.     ttmVar := nil.
  10636.     ttmVarSize := ttmVariables size.
  10637.     c1 := 1.
  10638.     displayedVariables
  10639.         do: 
  10640.             [:aDV | 
  10641.             newArray := Array new: 2.
  10642.             newArray at: 1 put: aDV.
  10643.             c2 := 1.
  10644.             [c2 > ttmVarSize | (aDV = ttmVar)]
  10645.                 whileFalse: 
  10646.                     [ttmVar := (ttmVariables at: c2)
  10647.                                 at: 1.
  10648.                     aDV = ttmVar
  10649.                         ifTrue: 
  10650.                             [newArray at: 2 put: c2.
  10651.                             theArray at: c1 put: newArray.
  10652.                             c1 := c1 + 1].
  10653.                     c2 := c2 + 1]].
  10654.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  10655.     variables := displayedVariables.
  10656.     variables do: [:aVar | textLabels add: (aVar at: 1)].
  10657.     tableInterface columnLabelsArray: textLabels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  10658.     self doClear.
  10659.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  10660.  
  10661. !SimulateWindow methodsFor: 'filter window access'!
  10662. doAcceptFilterNew
  10663.     "Accept new set of Variable to be displayed in Simulation 
  10664.     
  10665.     Window. 
  10666.     
  10667.     Reset the simulation to its initial state"
  10668.  
  10669.     | variables textLabels     ttmVarSize c2 ttmVar newArray theArray c1  |
  10670.     textLabels := OrderedCollection new.
  10671.     theArray := Array new: displayedVariables size.
  10672.     ttmVar := nil.
  10673.     ttmVarSize := ttmVariables size.
  10674.     c1 := 1.
  10675.     displayedVariables
  10676.         do: 
  10677.             [:aDV | 
  10678.             newArray := Array new: 2.
  10679.             newArray at: 1 put: aDV.
  10680.             c2 := 1.
  10681.             [c2 > ttmVarSize | (aDV = ttmVar)]
  10682.                 whileFalse: 
  10683.                     [ttmVar := (ttmVariables at: c2)
  10684.                                 at: 1.
  10685.                     aDV = ttmVar
  10686.                         ifTrue: 
  10687.                             [newArray at: 2 put: c2.
  10688.                             theArray at: c1 put: newArray.
  10689.                             c1 := c1 + 1].
  10690.                     c2 := c2 + 1]].
  10691.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  10692.     variables := displayedVariables.
  10693.     variables do: [:aVar | textLabels add: aVar at: 1].
  10694.     tableInterface columnLabelsArray: textLabels asArray; columnLabelsFormats: #left;columnWidths: #(100)
  10695.     self doClear.
  10696.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  10697.  
  10698. !SimulateWindow methodsFor: 'filter window access'!
  10699. doAcceptFilterOld
  10700.     "Accept new set of Variable to be displayed in Simulation 
  10701.     
  10702.     Window. 
  10703.     
  10704.     Reset the simulation to its initial state"
  10705.  
  10706.     | variables textLabels temp end iSize pad ttmVarSize c2 ttmVar newArray theArray c1 temp1 |
  10707.     theArray := Array new: displayedVariables size.
  10708.     self setTabs: displayedVariables size forVariableLength: 7.
  10709.     iSize := variableLabels text size.
  10710.     textLabels := ' t:     '.
  10711.     temp1 := ''.
  10712.     8 to: iSize do: [:x | temp1 := temp1 , ' '].
  10713.     variableLabels
  10714.         replaceFrom: 8
  10715.         to: iSize
  10716.         with: temp1.
  10717.     ttmVar := nil.
  10718.     ttmVarSize := ttmVariables size.
  10719.     c1 := 1.
  10720.     displayedVariables
  10721.         do: 
  10722.             [:aDV | 
  10723.             newArray := Array new: 2.
  10724.             newArray at: 1 put: aDV.
  10725.             c2 := 1.
  10726.             [c2 > ttmVarSize | (aDV = ttmVar)]
  10727.                 whileFalse: 
  10728.                     [ttmVar := (ttmVariables at: c2)
  10729.                                 at: 1.
  10730.                     aDV = ttmVar
  10731.                         ifTrue: 
  10732.                             [newArray at: 2 put: c2.
  10733.                             theArray at: c1 put: newArray.
  10734.                             c1 := c1 + 1].
  10735.                     c2 := c2 + 1]].
  10736.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  10737.     variables := displayedVariables.
  10738.     variables
  10739.         do: 
  10740.             [:aVar | 
  10741.             temp := ''.
  10742.             end := 7.
  10743.             aVar size < 7
  10744.                 ifTrue: 
  10745.                     [end := aVar size.
  10746.                     pad := 7 - end.
  10747.                     1 to: pad do: [:y | temp := temp , ' ']].
  10748.             textLabels := textLabels , (aVar copyFrom: 1 to: end) , temp].
  10749.     windowGC medium width notNil
  10750.         ifTrue: 
  10751.             ["container remove: variableLabels."
  10752.             variableLabels := ComposedText withText: textLabels style: (TextAttributes styleNamed: #fixed).
  10753.             SimulateWindow labelWrap: (container add: variableLabels borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05))]
  10754.         ifFalse: [variableLabels
  10755.                 replaceFrom: 1
  10756.                 to: textLabels size
  10757.                 with: textLabels].
  10758.     self doClear.
  10759.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  10760.  
  10761. !SimulateWindow methodsFor: 'filter window access'!
  10762. dumb! !
  10763.  
  10764. !SimulateWindow methodsFor: 'filter window access'!
  10765. dumb: ignore! !
  10766.  
  10767. !SimulateWindow methodsFor: 'filter window access'!
  10768. dVarListMenu
  10769.     ^PopUpMenu labelList: #(#('accept all' ) ) values: #(#acceptAlldata )! !
  10770.  
  10771. !SimulateWindow methodsFor: 'filter window access'!
  10772. newVarList
  10773.     ^displayedVariables! !
  10774.  
  10775. !SimulateWindow methodsFor: 'filter window access'!
  10776. newVarListMenu
  10777.  
  10778.     | selection |
  10779.  
  10780.     filterNewView notNil
  10781.  
  10782.         ifTrue: 
  10783.  
  10784.             [selection := filterNewView selection.
  10785.  
  10786.             selection > 0 ifFalse: [^PopUpMenu labelList: #(#('remove all' ) ) values: #(#removeAll )]
  10787.  
  10788.                 ifTrue: [^PopUpMenu labelList: #(#('remove variable' 'remove all' ) ) values: #(#removeVar #removeAll )]]! !
  10789.  
  10790. !SimulateWindow methodsFor: 'filter window access'!
  10791. removeAll
  10792.  
  10793.     displayedVariables := OrderedCollection new.
  10794.  
  10795.     filterNewView update: #newVarList! !
  10796.  
  10797. !SimulateWindow methodsFor: 'filter window access'!
  10798. removeVar
  10799.  
  10800.     displayedVariables removeAtIndex: filterNewView selection.
  10801.  
  10802.     filterNewView update: #newVarList! !
  10803.  
  10804. !SimulateWindow methodsFor: 'filter window access'!
  10805. varListMenu
  10806.  
  10807.     ^PopUpMenu labelList: #(#(#acceptAll ) ) values: #(#acceptAll )! !
  10808.  
  10809. !SimulateWindow methodsFor: 'filter window access'!
  10810. varNameList
  10811.  
  10812.     ^displayedVariables! !
  10813.  
  10814. !SimulateWindow methodsFor: 'button access'!
  10815. doClear
  10816.     ttmVariables := OrderedCollection new.
  10817.     initialCondition do: [:x | ttmVariables add: ((Array ) with: (x at: 1) copy with: (x at: 2) copy)].
  10818.     self accessTimeFor: #all to: #initialize.
  10819.     self clockReset.
  10820.     "self resetTable"
  10821.     self reset! !
  10822.  
  10823. !SimulateWindow methodsFor: 'button access'!
  10824. doFilter
  10825.     | topWin topView label acceptButton qButton |
  10826.     filterWindowOpen == True ifTrue: [^nil].
  10827.     filterWindowOpen := True.
  10828.     label := 'Filter Variables for : ' , currentTTM named.
  10829.     topWin := ScheduledWindow
  10830.                 model: self
  10831.                 label: label
  10832.                 minimumSize: 350 @ 350.
  10833.     topView := CompositePart new.
  10834.     topWin component: topView.
  10835.     filterWindow := topWin.
  10836.     topView add: 'Activity Variables' asText allBold asComposedText borderedIn: (0.0 @ 0.0 extent: 0.5 @ 0.08).
  10837.     topView add: 'Data Variables' asText allBold asComposedText borderedIn: (0.5 @ 0.0 extent: 0.5 @ 0.08).
  10838.     filterActView := SelectionInListView
  10839.                 on: self
  10840.                 aspect: #actVarList
  10841.                 change: #addAVarToList:
  10842.                 list: #actVarList
  10843.                 menu: #aVarListMenu
  10844.                 initialSelection: nil.
  10845.     topView add: (LookPreferences edgeDecorator on: filterActView)
  10846.         in: (0.0 @ 0.08 extent: 0.5 @ 0.3).
  10847.     filterDataView := SelectionInListView
  10848.                 on: self
  10849.                 aspect: #varNameList
  10850.                 change: #addDVarToList:
  10851.                 list: #dataVarList
  10852.                 menu: #dVarListMenu
  10853.                 initialSelection: nil.
  10854.     topView add: (LookPreferences edgeDecorator on: filterDataView)
  10855.         in: (0.5 @ 0.08 extent: 0.5 @ 0.3).
  10856.     filterNewView := SelectionInListView
  10857.                 on: self
  10858.                 aspect: #newVarList
  10859.                 change: #dumb:
  10860.                 list: #newVarList
  10861.                 menu: #newVarListMenu
  10862.                 initialSelection: nil.
  10863.     topView add: (LookPreferences edgeDecorator on: filterNewView)
  10864.         in: (0.0 @ 0.405 extent: 1.0 @ 0.5).    "*********************"
  10865.     "***********************"
  10866.     "Button accepting filtering out variables"
  10867.     acceptButton := PushButton named: 'Accept for Simulation'.
  10868.     acceptButton model: ((PluggableAdaptor on: self)
  10869.             getBlock: [:model | false]
  10870.             putBlock: [:model :value | model doAcceptFilter]
  10871.             updateBlock: [:model :value :parameter | false]).
  10872.     (topView add: acceptButton borderedIn: ((LayoutFrame new) leftFraction: 0.0; topFraction: 0.9; rightFraction: 0.49; bottomFraction: 0.96))
  10873.         insideColor: ColorValue white.    "Button for 
  10874.     
  10875.     quitting"
  10876.     qButton := PushButton named: 'Exit'.
  10877.     qButton model: ((PluggableAdaptor on: self)
  10878.             getBlock: [:model | false]
  10879.             putBlock: [:model :value | model closeFilter]
  10880.             updateBlock: [:model :value :parameter | false]).
  10881.     (topView add: qButton borderedIn: ((LayoutFrame new) leftFraction: 0.5; topFraction: 0.9; rightFraction: 0.99; bottomFraction: 0.96))
  10882.         insideColor: ColorValue white.
  10883.     topWin openWithExtent: 350 @ 350! !
  10884.  
  10885. !SimulateWindow methodsFor: 'button access'!
  10886. doHelp
  10887.     HelpScreens openHelp: 'simulating'! !
  10888.  
  10889. !SimulateWindow methodsFor: 'button access'!
  10890. doStart
  10891.     stop := false.
  10892.     advanceCount := 0.
  10893.     pause := true.
  10894.     cursorPt := ScheduledControllers activeController sensor cursorPoint.
  10895.     self considerStopping
  10896.         ifTrue: 
  10897.             [stop := true.
  10898.             TTMList speak: 'Stopping Condition is already satisfied.']
  10899.         ifFalse: [[stop = false]
  10900.                 whileTrue: [self selectionOfTransitions]]! !
  10901.  
  10902. !SimulateWindow methodsFor: 'button access'!
  10903. doStates
  10904.     | completeList pending enabled mustOccur disabled aList count entire selection timeElapsed |
  10905.     completeList := self sortTransitions.
  10906.     pending := completeList at: 1.
  10907.     enabled := completeList at: 2.
  10908.     mustOccur := completeList at: 3.
  10909.     disabled := completeList at: 4.
  10910.     aList := OrderedCollection new.
  10911.     entire := disabled.
  10912.     count := 1.
  10913.     [count > disabled size]
  10914.         whileFalse: 
  10915.             [aList add: ((disabled at: count)
  10916.                     at: 1)
  10917.                     , ' is disabled'.
  10918.             count := count + 1].
  10919.     count := 1.
  10920.     [count > pending size]
  10921.         whileFalse: 
  10922.             [aList add: ((pending at: count)
  10923.                     at: 1)
  10924.                     , ' is pending'.
  10925.             entire add: (pending at: count).
  10926.             count := count + 1].
  10927.     count := 1.
  10928.     [count > enabled size]
  10929.         whileFalse: 
  10930.             [aList add: ((enabled at: count)
  10931.                     at: 1)
  10932.                     , ' is enabled'.
  10933.             entire add: (enabled at: count).
  10934.             count := count + 1].
  10935.     aList add: 'tick is enabled'.
  10936.     count := 1.
  10937.     [count > mustOccur size]
  10938.         whileFalse: 
  10939.             [aList add: ((mustOccur at: count)
  10940.                     at: 1)
  10941.                     , ' must occur before a tick'.
  10942.             entire add: (mustOccur at: count).
  10943.             count := count + 1].
  10944.     selection := (PopUpMenu labelList: (Array with: aList)) startUp.
  10945.     selection ~= 0 ifTrue: [(aList at: selection)
  10946.             ~= 'tick is enabled'
  10947.             ifTrue: 
  10948.                 [timeElapsed := TTMList convertToString: (self accessTimeFor: (entire at: selection)
  10949.                                 to: #return).
  10950.                 HelpScreens openTable: (Array with: (entire at: selection)
  10951.                         with: timeElapsed)]]! !
  10952.  
  10953. !SimulateWindow methodsFor: 'button access'!
  10954. doStep
  10955.     "Step through one transition of the TTM."
  10956.  
  10957.     stop := true.
  10958.     advanceCount := 0.
  10959.     self selectionOfTransitions! !
  10960.  
  10961. !SimulateWindow methodsFor: 'evaluating'!
  10962. considerStopping
  10963.     "Compare stopping condition with the current 
  10964.     
  10965.     values of the ttmVariables."
  10966.  
  10967.     ^(self evaluateTFunction: finalCondition asString)
  10968.         = true! !
  10969.  
  10970. !SimulateWindow methodsFor: 'evaluating'!
  10971. evaluateAtomsAs: atomType usingTree: parseTree 
  10972.     atomType = #function
  10973.         ifTrue: 
  10974.             [self functionTraverse: parseTree treeRoot.
  10975.             ^nil]
  10976.         ifFalse: 
  10977.             [self guardTraverse: parseTree treeRoot.
  10978.             ^parseTree treeRoot left contents = 'TRUE']! !
  10979.  
  10980. !SimulateWindow methodsFor: 'evaluating'!
  10981. functionEvaluatingNew: aString 
  10982.     "We assume that the function is syntactically 
  10983.     
  10984.     correct so we just go through the parse tree 
  10985.     
  10986.     and evaluate each expression. Nothing needs 
  10987.     
  10988.     to be returned. The variable values are changed."
  10989.  
  10990.     | components parseTree  |
  10991.     aString = 'nil'
  10992.         ifFalse: 
  10993.             [components := ParseTree fission: aString definedAs: #function.
  10994.             parseTree := ParseTree orderIntoTree: components from: currentTTM.
  10995.             resultCollection := OrderedCollection new.
  10996.             self evaluateAtomsAs: #function usingTree: parseTree.
  10997.             resultCollection do: [ :x |   self store: (x at: 2) in: (x at: 1)]]! !
  10998.  
  10999. !SimulateWindow methodsFor: 'evaluating'!
  11000. functionTraverse: start 
  11001.     "A recursive traversal. Because a function is made 
  11002.     
  11003.     up only of assignments ANDed together we just 
  11004.     
  11005.     do each atom's operation."
  11006.  
  11007.     start left ~= nil ifTrue: [self functionTraverse: start left].
  11008.     start right ~= nil ifTrue: [self functionTraverse: start right].
  11009.     start isAtom ifTrue: [self processFunctionAtom: start contents]! !
  11010.  
  11011. !SimulateWindow methodsFor: 'evaluating'!
  11012. guardEvaluating: aString and: fString 
  11013.     "We assume that the guard is syntactically 
  11014.     
  11015.     correct so we just go through the parse tree 
  11016.     
  11017.     and evaluate each expression. Returns true 
  11018.     
  11019.     if the guard evaluates to true given the 
  11020.     
  11021.     current values of the variables."
  11022.  
  11023.     | result |
  11024.     aString = 'nil' ifTrue: [^true].
  11025.     (fString findString: '?' startingAt: 1)
  11026.         ~= 0 | ((fString findString: '!!' startingAt: 1)
  11027.             ~= 0) ifTrue: [^false].
  11028.     result := self evaluateTGuard: aString.
  11029.     ^result! !
  11030.  
  11031. !SimulateWindow methodsFor: 'evaluating'!
  11032. guardTraverse: start 
  11033.     "A recursive traversal. ."
  11034.  
  11035.     | newContents c |
  11036.     start left ~= nil ifTrue: [self guardTraverse: start left].
  11037.     start right ~= nil ifTrue: [self guardTraverse: start right].
  11038.     newContents := 'FALSE'.
  11039.     start contents = 'ROOT' ifFalse: [start isAtom
  11040.             ifTrue: 
  11041.                 [(self processGuardAtom: start contents)
  11042.                     ifTrue: [newContents := 'TRUE'].
  11043.                 start contents: newContents]
  11044.             ifFalse: 
  11045.                 [c := start contents.
  11046.                 c = 'LEFT' | (c = 'FALSE' | (c = 'TRUE'))
  11047.                     ifTrue: [TTMList speak: 'we got parse tree node errors']
  11048.                     ifFalse: 
  11049.                         [c = 'AND' & (start left contents = 'TRUE' & (start right contents = 'TRUE')) ifTrue: [newContents := 'TRUE'].
  11050.                         c = 'OR' & (start left contents = 'TRUE' | (start right contents = 'TRUE')) ifTrue: [newContents := 'TRUE']].
  11051.                 start contents: newContents]]! !
  11052.  
  11053. !SimulateWindow methodsFor: 'evaluating'!
  11054. selectionOfTransitions
  11055.     | completeList enabled mustOccur choices aList count selected totalChoices found nChoice |
  11056.     completeList := self sortTransitions.
  11057.     choices := nil.
  11058.     aList := OrderedCollection new.
  11059.     totalChoices := 0.
  11060.     enabled := completeList at: 2.
  11061.     mustOccur := completeList at: 3.
  11062.     count := 1.
  11063.     choices := enabled.
  11064.     [count > enabled size]
  11065.         whileFalse: 
  11066.             [aList add: ((enabled at: count)
  11067.                     at: 1).
  11068.             totalChoices := totalChoices + 1.
  11069.             count := count + 1].
  11070.     mustOccur size = 0
  11071.         ifTrue: 
  11072.             [aList add: 'tick'.
  11073.             totalChoices := totalChoices + 1]
  11074.         ifFalse: 
  11075.             [count := 1.
  11076.             [count > mustOccur size]
  11077.                 whileFalse: 
  11078.                     [aList add: ((mustOccur at: count)
  11079.                             at: 1).
  11080.                     choices add: (mustOccur at: count).
  11081.                     totalChoices := totalChoices + 1.
  11082.                     count := count + 1]].
  11083.     nChoice := aList size.
  11084.     aList add: 'STOP'.
  11085.     stop = false ifTrue: [ScheduledControllers activeController sensor cursorPoint: cursorPt].
  11086.     advanceCount  isNil ifTrue: [advanceCount := 0].
  11087.     advanceCount   <  advanceTransitionNumberAspect value
  11088.         ifTrue: 
  11089.             [doAdvanceTransition = true ifTrue: [(selected := aList indexOf: advanceTransition) = 0
  11090.                     ifTrue: [pause := true]
  11091.                     ifFalse: [pause := false]].
  11092.             doAdvance = true ifTrue: [nChoice = 1
  11093.                     ifTrue: 
  11094.                         [selected := 1.
  11095.                         pause := false]
  11096.                     ifFalse: [pause := true]].
  11097.             doAdvanceNoTick = true ifTrue: [nChoice > 2
  11098.                     ifTrue: [pause := true]
  11099.                     ifFalse: [nChoice = 1
  11100.                             ifTrue: 
  11101.                                 [selected := 1.
  11102.                                 pause := false]
  11103.                             ifFalse: [(aList includes: 'tick')
  11104.                                     = true
  11105.                                     ifTrue: 
  11106.                                         [selected := 1.
  11107.                                         pause := false]
  11108.                                     ifFalse: [pause := true]]]]]
  11109.         ifFalse: [pause := true].
  11110.     pause = true
  11111.         ifTrue: 
  11112.             [selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  11113.             advanceCount := 1.
  11114.             pause := true]
  11115.         ifFalse: [advanceCount := advanceCount + 1].
  11116.     selected > totalChoices  | (selected = 0)
  11117.         ifTrue: [stop := true]
  11118.         ifFalse: 
  11119.             [lastTransition := aList at: selected.
  11120.             (aList at: selected)
  11121.                 = 'tick'
  11122.                 ifTrue: [self tick: completeList]
  11123.                 ifFalse: 
  11124.                     [count := 1.
  11125.                     found := false.
  11126.                     [count > choices size | (found = true)]
  11127.                         whileFalse: 
  11128.                             [found := (aList at: selected)
  11129.                                         = ((choices at: count)
  11130.                                                 at: 1).
  11131.                             found = true ifFalse: [count := count + 1]].
  11132.                     found = true
  11133.                         ifTrue: 
  11134.                             [self evaluateTFunction: ((choices at: count)
  11135.                                     at: 3).
  11136.                             self addTransition: ((choices at: count)
  11137.                                     at: 1).
  11138.                             self addLatestValues.
  11139.                             self accessTimeFor: (choices at: count)
  11140.                                 to: #reset]]].
  11141.     self considerStopping ifTrue: [stop := true]! !
  11142.  
  11143. !SimulateWindow methodsFor: 'evaluating'!
  11144. selectionOfTransitionsOld
  11145.     | completeList enabled mustOccur choices aList count selected totalChoices found nChoice |
  11146.     completeList := self sortTransitions.
  11147.     choices := nil.
  11148.     aList := OrderedCollection new.
  11149.     totalChoices := 0.
  11150.     enabled := completeList at: 2.
  11151.     mustOccur := completeList at: 3.
  11152.     count := 1.
  11153.     choices := enabled.
  11154.     [count > enabled size]
  11155.         whileFalse: 
  11156.             [aList add: ((enabled at: count)
  11157.                     at: 1).
  11158.             totalChoices := totalChoices + 1.
  11159.             count := count + 1].
  11160.     mustOccur size = 0
  11161.         ifTrue: 
  11162.             [aList add: 'tick'.
  11163.             totalChoices := totalChoices + 1]
  11164.         ifFalse: 
  11165.             [count := 1.
  11166.             [count > mustOccur size]
  11167.                 whileFalse: 
  11168.                     [aList add: ((mustOccur at: count)
  11169.                             at: 1).
  11170.                     choices add: (mustOccur at: count).
  11171.                     totalChoices := totalChoices + 1.
  11172.                     count := count + 1]].
  11173.     nChoice := aList size.
  11174.     aList add: 'STOP'.
  11175.     stop = false ifTrue: [ScheduledControllers activeController sensor cursorPoint: cursorPt].
  11176.     advanceCount  isNil ifTrue: [advanceCount := 0].
  11177.     advanceCount < advanceTransitionNumberAspect value
  11178.         ifTrue: 
  11179.             [doAdvanceTransition = true ifTrue: [(selected := aList indexOf: advanceTransition) = 0
  11180.                     ifTrue: [pause := true]
  11181.                     ifFalse: [pause := false]].
  11182.             doAdvance = true ifTrue: [nChoice = 1
  11183.                     ifTrue: 
  11184.                         [selected := 1.
  11185.                         pause := false]
  11186.                     ifFalse: [pause := true]].
  11187.             doAdvanceNoTick = true ifTrue: [nChoice > 2
  11188.                     ifTrue: [pause := true]
  11189.                     ifFalse: [nChoice = 1
  11190.                             ifTrue: 
  11191.                                 [selected := 1.
  11192.                                 pause := false]
  11193.                             ifFalse: [(aList includes: 'tick')
  11194.                                     = true
  11195.                                     ifTrue: 
  11196.                                         [selected := 1.
  11197.                                         pause := false]
  11198.                                     ifFalse: [pause := true]]]]]
  11199.         ifFalse: [pause := true].
  11200.     pause = true
  11201.         ifTrue: 
  11202.             [selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  11203.             advanceCount := 0.
  11204.             pause := true]
  11205.         ifFalse: [advanceCount := advanceCount + 1].
  11206.     selected > totalChoices | (selected = 0)
  11207.         ifTrue: [stop := true]
  11208.         ifFalse: 
  11209.             [lastTransition := aList at: selected.
  11210.             (aList at: selected)
  11211.                 = 'tick'
  11212.                 ifTrue: [self tick: completeList]
  11213.                 ifFalse: 
  11214.                     [count := 1.
  11215.                     found := false.
  11216.                     [count > choices size | (found = true)]
  11217.                         whileFalse: 
  11218.                             [found := (aList at: selected)
  11219.                                         = ((choices at: count)
  11220.                                                 at: 1).
  11221.                             found = true ifFalse: [count := count + 1]].
  11222.                     found = true
  11223.                         ifTrue: 
  11224.                             [self evaluateTFunction: ((choices at: count)
  11225.                                     at: 3).
  11226.                             self addTransition: ((choices at: count)
  11227.                                     at: 1).
  11228.                             self addLatestValues.
  11229.                             self accessTimeFor: (choices at: count)
  11230.                                 to: #reset]]].
  11231.     self considerStopping ifTrue: [stop := true]! !
  11232.  
  11233. !SimulateWindow methodsFor: 'evaluating'!
  11234. sortTransitions
  11235.     "returns a sorted set of the transitions. The set 
  11236.     
  11237.     is comprised of four groups. Transitions disabled 
  11238.     
  11239.     in the current state, transitions pending (waiting 
  11240.     
  11241.     for more ticks of clock), transitions enabled (ready 
  11242.     
  11243.     to occur), and transitions mustOccur (their upper 
  11244.     
  11245.     bounds have been reached - they must occur or 
  11246.     
  11247.     be disabled before another clock tick)."
  11248.  
  11249.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  11250.     count := 1.
  11251.     complete := OrderedCollection new.
  11252.     pending := OrderedCollection new.
  11253.     enabled := OrderedCollection new.
  11254.     disabled := OrderedCollection new.
  11255.     mustOccur := OrderedCollection new.
  11256.     [count > transitionTimes size]
  11257.         whileFalse: 
  11258.             [currentEntry := transitionTimes at: count.
  11259.             currentTr := currentEntry at: 1.
  11260.             lower := TTMList convertToNumber: (currentTr at: 4).
  11261.             finiteUpper := (currentTr at: 5)
  11262.                         ~= 'infinity'.
  11263.             finiteUpper = true ifFalse: [upper := 0]
  11264.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  11265.             timeElapsed := currentEntry at: 2.
  11266.             (self evaluateTGuard: (currentTr at: 2))
  11267.                 ifTrue: [timeElapsed >= lower
  11268.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  11269.                                 ifTrue: [mustOccur add: currentTr]
  11270.                                 ifFalse: [enabled add: currentTr]]
  11271.                         ifFalse: [pending add: currentTr]]
  11272.                 ifFalse: 
  11273.                     [currentEntry at: 2 put: 0.
  11274.                     disabled add: currentTr].
  11275.             count := count + 1].
  11276.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  11277.     ^complete! !
  11278.  
  11279. !SimulateWindow methodsFor: 'evaluating'!
  11280. sortTransitionsNew
  11281.     "returns a sorted set of the transitions. The set 
  11282.     
  11283.     is comprised of four groups. Transitions disabled 
  11284.     
  11285.     in the current state, transitions pending (waiting 
  11286.     
  11287.     for more ticks of clock), transitions enabled (ready 
  11288.     
  11289.     to occur), and transitions mustOccur (their upper 
  11290.     
  11291.     bounds have been reached - they must occur or 
  11292.     
  11293.     be disabled before another clock tick)."
  11294.  
  11295.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  11296.     count := 1.
  11297.     complete := OrderedCollection new.
  11298.     pending := OrderedCollection new.
  11299.     enabled := OrderedCollection new.
  11300.     disabled := OrderedCollection new.
  11301.     mustOccur := OrderedCollection new.
  11302.     [count > transitionTimes size]
  11303.         whileFalse: 
  11304.             [currentEntry := transitionTimes at: count.
  11305.             currentTr := currentEntry at: 1.
  11306.             lower := TTMList convertToNumber: (currentTr at: 4).
  11307.             finiteUpper := (currentTr at: 5)
  11308.                         ~= 'infinity'.
  11309.             finiteUpper = true ifFalse: [upper := 0]
  11310.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  11311.             timeElapsed := currentEntry at: 2.
  11312.             (self guardEvaluating: (currentTr at: 2)
  11313.                 and: (currentTr at: 3))
  11314.                 ifTrue: [timeElapsed >= lower
  11315.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  11316.                                 ifTrue: [mustOccur add: currentTr]
  11317.                                 ifFalse: [enabled add: currentTr]]
  11318.                         ifFalse: [pending add: currentTr]]
  11319.                 ifFalse: 
  11320.                     [currentEntry at: 2 put: 0.
  11321.                     disabled add: currentTr].
  11322.             count := count + 1].
  11323.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  11324.     ^complete! !
  11325.  
  11326. !SimulateWindow methodsFor: 'evaluating'!
  11327. sortTransitionsNewG
  11328.     "returns a sorted set of the transitions. The set 
  11329.     
  11330.     is comprised of four groups. Transitions disabled 
  11331.     
  11332.     in the current state, transitions pending (waiting 
  11333.     
  11334.     for more ticks of clock), transitions enabled (ready 
  11335.     
  11336.     to occur), and transitions mustOccur (their upper 
  11337.     
  11338.     bounds have been reached - they must occur or 
  11339.     
  11340.     be disabled before another clock tick)."
  11341.  
  11342.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  11343.     count := 1.
  11344.     complete := OrderedCollection new.
  11345.     pending := OrderedCollection new.
  11346.     enabled := OrderedCollection new.
  11347.     disabled := OrderedCollection new.
  11348.     mustOccur := OrderedCollection new.
  11349.     [count > transitionTimes size]
  11350.         whileFalse: 
  11351.             [currentEntry := transitionTimes at: count.
  11352.             currentTr := currentEntry at: 1.
  11353.             lower := TTMList convertToNumber: (currentTr at: 4).
  11354.             finiteUpper := (currentTr at: 5)
  11355.                         ~= 'infinity'.
  11356.             finiteUpper = true ifFalse: [upper := 0]
  11357.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  11358.             timeElapsed := currentEntry at: 2.
  11359.             (self evaluateTGuard: (currentTr at: 2))
  11360.                 ifTrue: [timeElapsed >= lower
  11361.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  11362.                                 ifTrue: [mustOccur add: currentTr]
  11363.                                 ifFalse: [enabled add: currentTr]]
  11364.                         ifFalse: [pending add: currentTr]]
  11365.                 ifFalse: 
  11366.                     [currentEntry at: 2 put: 0.
  11367.                     disabled add: currentTr].
  11368.             count := count + 1].
  11369.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  11370.     ^complete! !
  11371.  
  11372. !SimulateWindow methodsFor: 'evaluating'!
  11373. sortTransitionsOld
  11374.     "returns a sorted set of the transitions. The set 
  11375.     
  11376.     is comprised of four groups. Transitions disabled 
  11377.     
  11378.     in the current state, transitions pending (waiting 
  11379.     
  11380.     for more ticks of clock), transitions enabled (ready 
  11381.     
  11382.     to occur), and transitions mustOccur (their upper 
  11383.     
  11384.     bounds have been reached - they must occur or 
  11385.     
  11386.     be disabled before another clock tick)."
  11387.  
  11388.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  11389.     count := 1.
  11390.     complete := OrderedCollection new.
  11391.     pending := OrderedCollection new.
  11392.     enabled := OrderedCollection new.
  11393.     disabled := OrderedCollection new.
  11394.     mustOccur := OrderedCollection new.
  11395.     [count > transitionTimes size]
  11396.         whileFalse: 
  11397.             [currentEntry := transitionTimes at: count.
  11398.             currentTr := currentEntry at: 1.
  11399.             lower := TTMList convertToNumber: (currentTr at: 4).
  11400.             finiteUpper := (currentTr at: 5)
  11401.                         ~= 'infinity'.
  11402.             finiteUpper = true ifFalse: [upper := 0]
  11403.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  11404.             timeElapsed := currentEntry at: 2.
  11405.             (self guardEvaluating: (currentTr at: 2)
  11406.                 and: (currentTr at: 3))
  11407.                 ifTrue: [timeElapsed >= lower
  11408.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  11409.                                 ifTrue: [mustOccur add: currentTr]
  11410.                                 ifFalse: [enabled add: currentTr]]
  11411.                         ifFalse: [pending add: currentTr]]
  11412.                 ifFalse: 
  11413.                     [currentEntry at: 2 put: 0.
  11414.                     disabled add: currentTr].
  11415.             count := count + 1].
  11416.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  11417.     ^complete! !
  11418.  
  11419. !SimulateWindow methodsFor: 'evaluating options'!
  11420. add: variable1 to: variable2 
  11421.     | value1 value2 value1asNumber value2asNumber result |
  11422.     value1 := self valueOf: variable1.
  11423.     value2 := self valueOf: variable2.
  11424.     value1 = '-infinity' ifTrue: [^value2].
  11425.     value2 = '-infinity' ifTrue: [^value1].
  11426.     value2 ~= 'infinity' & (value1 ~= 'infinity')
  11427.         ifTrue: 
  11428.             [value1asNumber := TTMList convertToNumber: value1.
  11429.             value2asNumber := TTMList convertToNumber: value2.
  11430.             result := TTMList convertToString: value1asNumber + value2asNumber.
  11431.             ^result]
  11432.         ifFalse: [^'infinity']! !
  11433.  
  11434. !SimulateWindow methodsFor: 'evaluating options'!
  11435. evaluateOperand: anAtom from: start to: end 
  11436.     "Evaluate and then return the value of the given operand."
  11437.  
  11438.     | p left operator variable |
  11439.     p := start.
  11440.     (anAtom at: start)
  11441.         = '+' ifTrue: [p := p + 1].
  11442.     (anAtom at: start)
  11443.         = '-'
  11444.         ifTrue: 
  11445.             [p := p + 1.
  11446.             left := self subtract: (anAtom at: p)
  11447.                         from: '0']
  11448.         ifFalse: [left := anAtom at: p].
  11449.     p := p + 1.
  11450.     [p > end]
  11451.         whileFalse: 
  11452.             [operator := anAtom at: p.
  11453.             p := p + 1.
  11454.             p > end ifTrue: [^left].
  11455.             (ParseTree isAnOperator: (anAtom at: p))
  11456.                 ifTrue: 
  11457.                     [operator = '-'
  11458.                         ifTrue: [(anAtom at: p)
  11459.                                 = '-' ifTrue: [operator := '+']]
  11460.                         ifFalse: [(#('*' '/' '%' ) includes: operator)
  11461.                                 ifTrue: [(anAtom at: p)
  11462.                                         = '-'
  11463.                                         ifTrue: [left := self subtract: left from: '0']
  11464.                                         ifFalse: []]
  11465.                                 ifFalse: [operator := anAtom at: p]].
  11466.                     p := p + 1.
  11467.                     p > end ifTrue: [^left]].
  11468.             variable := anAtom at: p.
  11469.             operator = '+' ifTrue: [left := self add: variable to: left].
  11470.             operator = '*' ifTrue: [left := self multiply: variable and: left].
  11471.             operator = '-' ifTrue: [left := self subtract: variable from: left].
  11472.             operator = '/' ifTrue: [left := self integerDivide: left and: variable].
  11473.             operator = '%' ifTrue: [left := self remainderOf: left and: variable].
  11474.             p := p + 1].
  11475.     ^left! !
  11476.  
  11477. !SimulateWindow methodsFor: 'evaluating options'!
  11478. integerDivide: variable1 and: variable2 
  11479.     | value1 value2 value1asNumber value2asNumber result |
  11480.     value1 := self valueOf: variable1.
  11481.     value2 := self valueOf: variable2.
  11482.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  11483.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^'0'].
  11484.     value1asNumber := TTMList convertToNumber: value1.
  11485.     value2asNumber := TTMList convertToNumber: value2.
  11486.     result := TTMList convertToString: value1asNumber // value2asNumber.
  11487.     ^result! !
  11488.  
  11489. !SimulateWindow methodsFor: 'evaluating options'!
  11490. is: variable1 equalTo: variable2 
  11491.     | value1 value2 |
  11492.     variable1 = 'True' | (variable2 = 'True')
  11493.         ifTrue: [^true]
  11494.         ifFalse: 
  11495.             [value1 := self valueOf: variable1.
  11496.             value2 := self valueOf: variable2.
  11497.             value1 = 'True' | (value2 = 'True')
  11498.                 ifTrue: [^true]
  11499.                 ifFalse: [^value1 = value2]]! !
  11500.  
  11501. !SimulateWindow methodsFor: 'evaluating options'!
  11502. is: variable1 greaterOrEqualTo: variable2 
  11503.     ^(self is: variable1 equalTo: variable2)
  11504.         | (self is: variable1 greaterThan: variable2)! !
  11505.  
  11506. !SimulateWindow methodsFor: 'evaluating options'!
  11507. is: variable1 greaterThan: variable2 
  11508.     | value1 value2 value1asNumber value2asNumber |
  11509.     variable1 = 'True' | (variable2 = 'True')
  11510.         ifTrue: [^true]
  11511.         ifFalse: 
  11512.             [value1 := self valueOf: variable1.
  11513.             value2 := self valueOf: variable2.
  11514.             value1 = 'True' | (value2 = 'True')
  11515.                 ifTrue: [^true]
  11516.                 ifFalse: 
  11517.                     [value2 = '-infinity' | (value1 = 'infinity' & (value2 ~= 'infinity')) ifTrue: [^true].
  11518.                     value1 = '-infinity' | (value2 = 'infinity') ifTrue: [^false].
  11519.                     value1asNumber := TTMList convertToNumber: value1.
  11520.                     value2asNumber := TTMList convertToNumber: value2.
  11521.                     ^value1asNumber > value2asNumber]]! !
  11522.  
  11523. !SimulateWindow methodsFor: 'evaluating options'!
  11524. is: variable1 lessOrEqualTo: variable2 
  11525.     ^self is: variable2 greaterOrEqualTo: variable1! !
  11526.  
  11527. !SimulateWindow methodsFor: 'evaluating options'!
  11528. is: variable1 lessThan: variable2 
  11529.     ^self is: variable2 greaterThan: variable1! !
  11530.  
  11531. !SimulateWindow methodsFor: 'evaluating options'!
  11532. is: variable1 notEqualTo: variable2 
  11533.     (self is: variable1 equalTo: variable2)
  11534.         ifTrue: [^false]
  11535.         ifFalse: [^true]! !
  11536.  
  11537. !SimulateWindow methodsFor: 'evaluating options'!
  11538. multiply: variable1 and: variable2 
  11539.     | value1 value2 value1asNumber value2asNumber result |
  11540.     value1 := self valueOf: variable1.
  11541.     value2 := self valueOf: variable2.
  11542.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  11543.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^value2].
  11544.     value1asNumber := TTMList convertToNumber: value1.
  11545.     value2asNumber := TTMList convertToNumber: value2.
  11546.     result := TTMList convertToString: value1asNumber * value2asNumber.
  11547.     ^result! !
  11548.  
  11549. !SimulateWindow methodsFor: 'evaluating options'!
  11550. processFunctionAtom: anAtom 
  11551.     "store the calculated result in the respective variable."
  11552.  
  11553.     | operand result |
  11554.     operand := anAtom at: 1.
  11555.     result := self
  11556.                 evaluateOperand: anAtom
  11557.                 from: 3
  11558.                 to: anAtom size.
  11559.     anAtom size > 3
  11560.         ifFalse: 
  11561.             [result := anAtom at: 3.
  11562.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  11563.     resultCollection add: (Array with: operand with: result).
  11564.     "self store: result in: operand"! !
  11565.  
  11566. !SimulateWindow methodsFor: 'evaluating options'!
  11567. processFunctionAtomNew: anAtom 
  11568.     "store the calculated result in the respective variable."
  11569.  
  11570.     | operand result |
  11571.     operand := anAtom at: 1.
  11572.     result := self
  11573.                 evaluateOperand: anAtom
  11574.                 from: 3
  11575.                 to: anAtom size.
  11576.     anAtom size > 3
  11577.         ifFalse: 
  11578.             [result := anAtom at: 3.
  11579.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  11580.     resultCollection add: (Array with: operand with: result).
  11581.     "self store: result in: operand"! !
  11582.  
  11583. !SimulateWindow methodsFor: 'evaluating options'!
  11584. processFunctionAtomOld: anAtom 
  11585.     "store the calculated result in the respective variable."
  11586.  
  11587.     | operand result |
  11588.     operand := anAtom at: 1.
  11589.     result := self
  11590.                 evaluateOperand: anAtom
  11591.                 from: 3
  11592.                 to: anAtom size.
  11593.     anAtom size > 3
  11594.         ifFalse: 
  11595.             [result := anAtom at: 3.
  11596.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  11597.     resultCollection add: (Array with: operand with: result).
  11598.     "self store: result in: operand"! !
  11599.  
  11600. !SimulateWindow methodsFor: 'evaluating options'!
  11601. processGuardAtom: anAtom 
  11602.     "Calculate the left side of expression, make note of 
  11603.     
  11604.     the comparator, calculate the right side of expression, 
  11605.     
  11606.     then finally evaluate the expression."
  11607.  
  11608.     | count comparator double left right comparator1 comparator2 |
  11609.     count := 1.
  11610.     comparator := 0.
  11611.     double := 0.
  11612.     [count > anAtom size]
  11613.         whileFalse: 
  11614.             [(ParseTree isAComparator: (anAtom at: count))
  11615.                 ifTrue: [comparator > 0
  11616.                         ifTrue: 
  11617.                             [double > 0 ifTrue: [^false].
  11618.                             (anAtom at: comparator)
  11619.                                 = '>' & ((anAtom at: count)
  11620.                                     = '=') | ((anAtom at: comparator)
  11621.                                     = '=' & ((anAtom at: count)
  11622.                                         = '<')) ifFalse: [^false].
  11623.                             double := count]
  11624.                         ifFalse: [comparator := count]].
  11625.             count := count + 1].
  11626.     comparator < 2 | (comparator = anAtom size) ifTrue: [^false].
  11627.     double = 0 ifTrue: [double := comparator].
  11628.     left := self
  11629.                 evaluateOperand: anAtom
  11630.                 from: 1
  11631.                 to: comparator - 1.
  11632.     right := self
  11633.                 evaluateOperand: anAtom
  11634.                 from: double + 1
  11635.                 to: anAtom size.
  11636.     comparator1 := anAtom at: comparator.
  11637.     double = comparator
  11638.         ifTrue: [comparator2 := nil]
  11639.         ifFalse: [comparator2 := anAtom at: double].
  11640.     comparator1 = '>' & (comparator2 = '=') ifTrue: [^self is: left greaterOrEqualTo: right].
  11641.     comparator1 = '=' & (comparator2 = '<') ifTrue: [^self is: left lessOrEqualTo: right].
  11642.     comparator2 isNil
  11643.         ifTrue: 
  11644.             [comparator1 = '#' ifTrue: [^self is: left notEqualTo: right].
  11645.             comparator1 = '=' ifTrue: [^self is: left equalTo: right].
  11646.             comparator1 = '>' ifTrue: [^self is: left greaterThan: right].
  11647.             comparator1 = '<' ifTrue: [^self is: left lessThan: right]]! !
  11648.  
  11649. !SimulateWindow methodsFor: 'evaluating options'!
  11650. remainderOf: variable1 and: variable2 
  11651.     | value1 value2 value1asNumber value2asNumber result |
  11652.     value1 := self valueOf: variable1.
  11653.     value2 := self valueOf: variable2.
  11654.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  11655.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^'0'].
  11656.     value1asNumber := TTMList convertToNumber: value1.
  11657.     value2asNumber := TTMList convertToNumber: value2.
  11658.     result := TTMList convertToString: value1asNumber \\ value2asNumber.
  11659.     ^result! !
  11660.  
  11661. !SimulateWindow methodsFor: 'evaluating options'!
  11662. subtract: variable1 from: variable2 
  11663.     | value1 value2 value1asNumber value2asNumber result |
  11664.     value1 := self valueOf: variable1.
  11665.     value2 := self valueOf: variable2.
  11666.     value2 = 'infinity' | (value2 = '-infinity')
  11667.         ifTrue: [^value2]
  11668.         ifFalse: [value1 = 'infinity'
  11669.                 ifTrue: [^0]
  11670.                 ifFalse: 
  11671.                     [value1 = '-infinity'
  11672.                         ifTrue: [value1asNumber := 0]
  11673.                         ifFalse: [value1asNumber := TTMList convertToNumber: value1].
  11674.                     value2asNumber := TTMList convertToNumber: value2.
  11675.                     result := TTMList convertToString: value2asNumber - value1asNumber.
  11676.                     ^result]]! !
  11677.  
  11678. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  11679. evaluateTFunction: aString 
  11680.     | rhs parser |
  11681.     "aString inspect."
  11682.     rhs := self getRHS: aString.
  11683.     rhs isNil ifTrue: [^'nil'].
  11684.     parser := BuildAEParser new.
  11685.     resultCollection := OrderedCollection new.
  11686.     rhs do: [:ex | resultCollection add: (Array with: (ex at: 1)
  11687.                 with: (BuildTFExpr valueWithAST: (parser parseForAST: (ex at: 2)
  11688.                             ifFail: [^nil] )
  11689.                         withSw: self))].
  11690.     resultCollection do: [:x | self store: (x at: 2) 
  11691.             in: (x at: 1)]! !
  11692.  
  11693. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  11694. evaluateTGuard: aString 
  11695.     | parser result ok |
  11696.     ok := true.
  11697.     parser := BuildBoolParser new.
  11698.     result := BuildTFExpr valueWithAST: (parser parseForAST: aString ifFail: [ok := false])
  11699.                 withSw: self.
  11700.     ok = true ifTrue: [^result]! !
  11701.  
  11702. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  11703. getRHS: aTransformationFunction 
  11704.     | res str ind comma colon |
  11705.     ind := 1.
  11706.     res := OrderedCollection new.
  11707.     str := aTransformationFunction.
  11708.     (str occurrencesOf: $:)
  11709.         timesRepeat: 
  11710.             [comma := str
  11711.                         nextIndexOf: $,
  11712.                         from: ind
  11713.                         to: str size.
  11714.             comma isNil ifTrue: [comma := str size + 1].
  11715.             colon := str
  11716.                         nextIndexOf: $:
  11717.                         from: ind
  11718.                         to: str size.
  11719.             res add: (Array with: (str copyFrom: ind to: colon - 1)
  11720.                     with: (str copyFrom: colon + 1 to: comma - 1)).
  11721.             ind := comma + 1].
  11722.     ^res! !
  11723.  
  11724. !SimulateWindow methodsFor: 'variable access'!
  11725. addDisplayedVariable: aString
  11726.  
  11727.      displayedVariables addLast: aString! !
  11728.  
  11729. !SimulateWindow methodsFor: 'variable access'!
  11730. container: aC 
  11731.  
  11732.      container := aC! !
  11733.  
  11734. !SimulateWindow methodsFor: 'variable access'!
  11735. currentTTM
  11736.  
  11737.      ^currentTTM! !
  11738.  
  11739. !SimulateWindow methodsFor: 'variable access'!
  11740. displayedVariables
  11741.  
  11742.      ^displayedVariables! !
  11743.  
  11744. !SimulateWindow methodsFor: 'variable access'!
  11745. displayedVariables: aCollection 
  11746.  
  11747.      displayedVariables := aCollection! !
  11748.  
  11749. !SimulateWindow methodsFor: 'variable access'!
  11750. filterWindowOpen
  11751.  
  11752.      ^filterWindowOpen! !
  11753.  
  11754. !SimulateWindow methodsFor: 'variable access'!
  11755. filterWindowOpen: aBoolean 
  11756.  
  11757.      filterWindowOpen := aBoolean! !
  11758.  
  11759. !SimulateWindow methodsFor: 'variable access'!
  11760. find: aVariableName 
  11761.     "Return the variable."
  11762.  
  11763.     | found count existingV |
  11764.     found := nil.
  11765.     count := 1.
  11766.     ttmVariables size
  11767.         timesRepeat: 
  11768.             [existingV := ttmVariables at: count.
  11769.             (existingV at: 1)
  11770.                 = aVariableName
  11771.                 ifTrue: [found := existingV]
  11772.                 ifFalse: [].
  11773.             count := count + 1].
  11774.     ^found! !
  11775.  
  11776. !SimulateWindow methodsFor: 'variable access'!
  11777. findScrollWrapper
  11778.     |   |
  11779.     ^((tableInterface dependents) at: 1) component container
  11780. "do: [:x | x class = #BorderedWrapper & (x component class = #ScrollWrapper) ifTrue: [x component component class = #GeneralSelectionTableView ifTrue: [^x component component]]]"! !
  11781.  
  11782. !SimulateWindow methodsFor: 'variable access'!
  11783. findView
  11784.     |   |
  11785.     ^(((tableInterface dependents) at: 1) components) at: 1 "do: [:x | x class = #BorderedWrapper & (x component class = #ScrollWrapper) ifTrue: [x component component class = #GeneralSelectionTableView ifTrue: [^x component component]]]"! !
  11786.  
  11787. !SimulateWindow methodsFor: 'variable access'!
  11788. initialCondition: aCondition 
  11789.     initialCondition := aCondition! !
  11790.  
  11791. !SimulateWindow methodsFor: 'variable access'!
  11792. setTabs: numberOfDisplayedVariables forVariableLength: vl 
  11793.     tabs := OrderedCollection new.
  11794.     tabs add: 1.
  11795.     2 to: numberOfDisplayedVariables + 2 do: [:x | tabs add: (tabs at: x - 1)
  11796.                 + vl]! !
  11797.  
  11798. !SimulateWindow methodsFor: 'variable access'!
  11799. simulateTable: x 
  11800.     simulateTable := x! !
  11801.  
  11802. !SimulateWindow methodsFor: 'variable access'!
  11803. store: aValue in: aVariable 
  11804.     | trueVariable |
  11805.     trueVariable := self find: aVariable.
  11806.     trueVariable isNil ifFalse: [trueVariable at: 2 put: aValue]! !
  11807.  
  11808. !SimulateWindow methodsFor: 'variable access'!
  11809. valueOf: aVariable 
  11810.     "Return the current value of the variable. 
  11811.     
  11812.     If it is not a variable, return itself (presumeably 
  11813.     
  11814.     a number)."
  11815.  
  11816.     | trueVariable |
  11817.     (aVariable isMemberOf: SmallInteger)
  11818.         ifTrue: [^aVariable]
  11819.         ifFalse: 
  11820.             [trueVariable := self find: aVariable.
  11821.             trueVariable isNil ifFalse: [^trueVariable at: 2]
  11822.                 ifTrue: [^aVariable]]! !
  11823.  
  11824. !SimulateWindow methodsFor: 'variable access'!
  11825. variableLabels: this 
  11826.     variableLabels := this! !
  11827.  
  11828. !SimulateWindow methodsFor: 'variable access'!
  11829. windowGC: aGC 
  11830.     windowGC := aGC! !
  11831.  
  11832. !SimulateWindow methodsFor: 'clock access'!
  11833. accessTimeFor: aTransition to: doAction 
  11834.     "This method gives access to the elapsed times 
  11835.     
  11836.     of the transitions in the TTM. The valid actions 
  11837.     
  11838.     are 1) #initialize all times, 2) #increment the 
  11839.     
  11840.     time of aTransition, 3) #reset the time of 
  11841.     
  11842.     aTransition to 0, and 4) #return the time of 
  11843.     
  11844.     aTransition."
  11845.  
  11846.     | count currentEntry timeElapsed found |
  11847.     doAction = #initialize
  11848.         ifTrue: 
  11849.             [count := 1.
  11850.             [count > transitionTimes size]
  11851.                 whileFalse: 
  11852.                     [currentEntry := transitionTimes at: count.
  11853.                     timeElapsed := 0.
  11854.                     currentEntry at: 2 put: timeElapsed.
  11855.                     count := count + 1]]
  11856.         ifFalse: 
  11857.             [count := 1.
  11858.             found := false.
  11859.             [count > transitionTimes size | (found = true)]
  11860.                 whileFalse: 
  11861.                     [currentEntry := transitionTimes at: count.
  11862.                     found := aTransition = (currentEntry at: 1).
  11863.                     found ifFalse: [count := count + 1]].
  11864.             found
  11865.                 ifTrue: 
  11866.                     [timeElapsed := currentEntry at: 2.
  11867.                     doAction = #increment
  11868.                         ifTrue: 
  11869.                             [timeElapsed := timeElapsed + 1.
  11870.                             currentEntry at: 2 put: timeElapsed].
  11871.                     doAction = #reset ifTrue: [currentEntry at: 2 put: 0].
  11872.                     doAction = #return ifTrue: [^timeElapsed]]]! !
  11873.  
  11874. !SimulateWindow methodsFor: 'clock access'!
  11875. clockList
  11876.      ^clockList := currentTime  asValue! !
  11877.  
  11878. !SimulateWindow methodsFor: 'clock access'!
  11879. clockListNew
  11880.      ^clockList := currentTime  asValue! !
  11881.  
  11882. !SimulateWindow methodsFor: 'clock access'!
  11883. clockListOld
  11884.     | tempList |
  11885.     tempList := OrderedCollection new.
  11886.     tempList add: currentTime.
  11887.     ^tempList collect: [:aTime | aTime printString]! !
  11888.  
  11889. !SimulateWindow methodsFor: 'clock access'!
  11890. clockOffset
  11891.     | newTime |
  11892.     newTime := DialogView request: 'Set clock to how many ticks?' initialAnswer: currentTime printString.
  11893.     newTime isEmpty
  11894.         ifTrue: [^self]
  11895.         ifFalse: 
  11896.             [currentTime := TTMList convertToNumber: newTime.
  11897.             self changed: #clockTransaction]! !
  11898.  
  11899. !SimulateWindow methodsFor: 'clock access'!
  11900. clockReset
  11901.     currentTime := 0.
  11902.     clockList value: currentTime.
  11903.     self changed: #clockTransaction! !
  11904.  
  11905. !SimulateWindow methodsFor: 'clock access'!
  11906. tick: completeList
  11907.     "The completeList of sorted transitions is output 
  11908.     
  11909.     from the sortTransition method."
  11910.  
  11911.     | pending enabled mustOccur count |
  11912.     pending := completeList at: 1.
  11913.     enabled := completeList at: 2.
  11914.     mustOccur := completeList at: 3.
  11915.     mustOccur size = 0
  11916.         ifTrue: 
  11917.             [currentTime := currentTime + 1.
  11918.             clockList value: currentTime.
  11919.             self changed: #clockTransaction.
  11920.             count := 1.
  11921.             [count > pending size]
  11922.                 whileFalse: 
  11923.                     [self accessTimeFor: (pending at: count)
  11924.                         to: #increment.
  11925.                     count := count + 1].
  11926.             count := 1.
  11927.             [count > enabled size]
  11928.                 whileFalse: 
  11929.                     [self accessTimeFor: (enabled at: count)
  11930.                         to: #increment.
  11931.                     count := count + 1].
  11932.             self addTransition: 'tick'.
  11933.             self addLatestValues]
  11934.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  11935.  
  11936. !SimulateWindow methodsFor: 'clock access'!
  11937. tickNew: completeList
  11938.     "The completeList of sorted transitions is output 
  11939.     
  11940.     from the sortTransition method."
  11941.  
  11942.     | pending enabled mustOccur count |
  11943.     pending := completeList at: 1.
  11944.     enabled := completeList at: 2.
  11945.     mustOccur := completeList at: 3.
  11946.     mustOccur size = 0
  11947.         ifTrue: 
  11948.             [currentTime := currentTime + 1.
  11949.             clockList value: currentTime.
  11950.             self changed: #clockTransaction.
  11951.             count := 1.
  11952.             [count > pending size]
  11953.                 whileFalse: 
  11954.                     [self accessTimeFor: (pending at: count)
  11955.                         to: #increment.
  11956.                     count := count + 1].
  11957.             count := 1.
  11958.             [count > enabled size]
  11959.                 whileFalse: 
  11960.                     [self accessTimeFor: (enabled at: count)
  11961.                         to: #increment.
  11962.                     count := count + 1].
  11963.             self addTransition: 'tick'.
  11964.             self addLatestValues]
  11965.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  11966.  
  11967. !SimulateWindow methodsFor: 'clock access'!
  11968. tickOld: completeList 
  11969.     "The completeList of sorted transitions is output 
  11970.     
  11971.     from the sortTransition method."
  11972.  
  11973.     | pending enabled mustOccur count |
  11974.     pending := completeList at: 1.
  11975.     enabled := completeList at: 2.
  11976.     mustOccur := completeList at: 3.
  11977.     mustOccur size = 0
  11978.         ifTrue: 
  11979.             [currentTime := currentTime + 1.
  11980.             self changed: #clockTransaction.
  11981.             count := 1.
  11982.             [count > pending size]
  11983.                 whileFalse: 
  11984.                     [self accessTimeFor: (pending at: count)
  11985.                         to: #increment.
  11986.                     count := count + 1].
  11987.             count := 1.
  11988.             [count > enabled size]
  11989.                 whileFalse: 
  11990.                     [self accessTimeFor: (enabled at: count)
  11991.                         to: #increment.
  11992.                     count := count + 1].
  11993.             self addTransition: 'tick'.
  11994.             self addLatestValues]
  11995.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  11996.  
  11997. !SimulateWindow methodsFor: 'file out'!
  11998. doFileOut
  11999.     | aStream ans1 ans2 ans3 myTable |
  12000.     aStream := self openFileForWrite.
  12001.     aStream isNil ifTrue: [^nil].
  12002.     currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  12003.     ans1 := DialogView confirm: 'Include notepad?'.
  12004.     ans1 = true ifTrue: [currentTTM fileNotePadOn: aStream].
  12005.     ans2 := DialogView confirm: 'Include Starting and Stopping Conditions?'.
  12006.     ans2 = true
  12007.         ifTrue: 
  12008.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  12009.             currentTTM fileThis: self icList on: aStream.
  12010.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  12011.             myTable := OrderedCollection new.
  12012.             myTable add: '  ' , finalCondition.
  12013.             currentTTM fileThis: myTable on: aStream].
  12014.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  12015.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  12016.                 with: '%'
  12017.                 with: '%'
  12018.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  12019.             on: aStream].
  12020.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  12021.     currentTTM fileThis: (self makeCollectionOfStringsWithFieldWidth: 12)
  12022.         on: aStream.
  12023.     aStream close! !
  12024.  
  12025. !SimulateWindow methodsFor: 'file out'!
  12026. doFileOutNew
  12027.     | aStream ans1 ans2 ans3 myTable   |
  12028.     aStream := self openFileForWrite.
  12029.     ans1 := DialogView confirm: 'Include title and notepad?'.
  12030.     ans1 = true
  12031.         ifTrue: 
  12032.             [currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  12033.             currentTTM fileNotePadOn: aStream].
  12034.     ans2 := DialogView confirm: 'Include Starting and Stopping
  12035.  
  12036. Conditions?'.
  12037.     ans2 = true
  12038.         ifTrue: 
  12039.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  12040.             currentTTM fileThis: self icList on: aStream.
  12041.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  12042.             myTable := OrderedCollection new.
  12043.             myTable add: '  ' , finalCondition.
  12044.             currentTTM fileThis: myTable on: aStream].
  12045.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  12046.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  12047.                 with: '%'
  12048.                 with: '%'
  12049.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  12050.             on: aStream].
  12051.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  12052.     
  12053.     
  12054.     currentTTM fileThis: (self  makeCollectionOfStringsWithFieldWidth: 15)  on: aStream.
  12055.     
  12056.     aStream close! !
  12057.  
  12058. !SimulateWindow methodsFor: 'file out'!
  12059. doFileOutOld
  12060.     | aStream ans1 ans2 ans3 myTable varCount actuallyDisplayedVariables |
  12061.     aStream := self openFileForWrite.
  12062.     ans1 := DialogView confirm: 'Include title and notepad?'.
  12063.     ans1 = true
  12064.         ifTrue: 
  12065.             [currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  12066.             currentTTM fileNotePadOn: aStream].
  12067.     ans2 := DialogView confirm: 'Include Starting and Stopping
  12068.  
  12069. Conditions?'.
  12070.     ans2 = true
  12071.         ifTrue: 
  12072.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  12073.             currentTTM fileThis: self icList on: aStream.
  12074.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  12075.             myTable := OrderedCollection new.
  12076.             myTable add: '  ' , finalCondition.
  12077.             currentTTM fileThis: myTable on: aStream].
  12078.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  12079.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  12080.                 with: '%'
  12081.                 with: '%'
  12082.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  12083.             on: aStream].
  12084.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  12085.     self clearEntry.
  12086.     currentTTM currentlyDisplayedSimulateVariables notNil
  12087.         ifTrue: [actuallyDisplayedVariables := currentTTM currentlyDisplayedSimulateVariables collect: [:x | x at: 1]]
  12088.         ifFalse: [actuallyDisplayedVariables := ttmVariables collect: [:x | x at: 1]].
  12089.     varCount := 1.
  12090.     [
  12091.         "ttmVariables"varCount > (actuallyDisplayedVariables size + 1)]
  12092.         whileFalse: 
  12093.             [self atTab: varCount put: '------'.
  12094.             varCount := varCount + 1].
  12095.     table addFirst: tableEntry.
  12096.     self clearEntry.
  12097.     varCount := 1.
  12098.     self atTab: varCount put: 't'.
  12099.     [
  12100.         "ttmVariables"varCount > actuallyDisplayedVariables size]
  12101.         whileFalse: 
  12102.             [
  12103.                 "ttmVariables"self atTab: varCount + 1 put: (actuallyDisplayedVariables at: varCount).
  12104.             varCount := varCount + 1].
  12105.     table addFirst: tableEntry.
  12106.     currentTTM fileThis: table on: aStream.
  12107.     table removeFirst.
  12108.     table removeFirst.
  12109.     aStream close! !
  12110.  
  12111. !SimulateWindow methodsFor: 'file out'!
  12112. forString: aString copyUpToWithPad: anInteger 
  12113.     | temp |
  12114.     temp := aString copyUpTo: anInteger.
  12115.     anInteger - temp size timesRepeat: [temp := temp , ' '].
  12116.     ^temp! !
  12117.  
  12118. !SimulateWindow methodsFor: 'file out'!
  12119. makeCollectionOfStringsWithFieldWidth: anInteger 
  12120.     | temp count result varCount actuallyDisplayedVariables temp2 y |
  12121.     result := OrderedCollection new.
  12122.     currentTTM currentlyDisplayedSimulateVariables notNil
  12123.         ifTrue: [actuallyDisplayedVariables := currentTTM currentlyDisplayedSimulateVariables collect: [:x | x at: 1]]
  12124.         ifFalse: [actuallyDisplayedVariables := ttmVariables collect: [:x | x at: 1]].
  12125.     varCount := 1.
  12126.     temp := self forString: 'ticks' copyUpToWithPad: anInteger.
  12127.     temp2 := self forString: '----- ' copyUpToWithPad: anInteger.
  12128.     [varCount > actuallyDisplayedVariables size]
  12129.         whileFalse: 
  12130.             [temp := temp , (self forString: (actuallyDisplayedVariables at: varCount)
  12131.                             copyUpToWithPad: anInteger).
  12132.             temp2 := temp2 , (self forString: '----- ' copyUpToWithPad: anInteger).
  12133.             varCount := varCount + 1].
  12134.     result add: temp; add: temp2.
  12135.     temp := ''.
  12136.     count := 1.
  12137.     trajectoryTable tableHolder value
  12138.         do: 
  12139.             [:x | 
  12140.             x isInteger
  12141.                 ifTrue: [y := x printString]
  12142.                 ifFalse: [y := x].
  12143.             temp := temp , (self forString: y copyUpToWithPad: anInteger).
  12144.             count := count + 1.
  12145.             count > ncols
  12146.                 ifTrue: 
  12147.                     [count := 1.
  12148.                     result add: temp.
  12149.                     temp := '']].
  12150.     ^result! !
  12151.  
  12152. !SimulateWindow methodsFor: 'file out'!
  12153. openFileForWrite
  12154.     "Returns the stream in append mode or 
  12155.     
  12156.     returns nil if file could not be opened."
  12157.  
  12158.     | defaultName fileName aStream fullPath |
  12159.     defaultName := currentTTM named asString , '.run'.
  12160.     fileName := DialogView request: 'file name to write out as?' initialAnswer: defaultName.
  12161.     fileName isEmpty
  12162.         ifTrue: 
  12163.             [TTMList speak: 'No filename given - generation aborted.'.
  12164.             aStream := nil]
  12165.         ifFalse: 
  12166.             [fullPath := (Filename named: currentTTM getDirectory)
  12167.                         constructString: fileName.
  12168.             aStream := (Filename named: fullPath) appendStream].
  12169.     ^aStream! !
  12170.  
  12171. !SimulateWindow methodsFor: 'closing'!
  12172. closeMe
  12173.     currentTTM openWindows at: 4 put: 0.
  12174.     filterWindowOpen = True ifTrue: [self closeFilter].
  12175.     self closeRequest! !
  12176.  
  12177. !SimulateWindow methodsFor: 'closing'!
  12178. removeDependent: aDependent 
  12179.     aDependent class name = #ApplicationWindow ifTrue: [currentTTM openWindows at: 4 put: 0].
  12180.     filterWindowOpen = True ifTrue: [self closeFilter].
  12181.     super removeDependent: aDependent! !
  12182.  
  12183. !SimulateWindow methodsFor: 'new reset'!
  12184. reset
  12185.     | list labels t1 |
  12186.     trajectoryList := OrderedCollection new.
  12187.     aLine := OrderedCollection new.    
  12188.     list := TwoDList
  12189.                 on: trajectoryList
  12190.                 columns: 0
  12191.                 rows: 0.
  12192.     trajectoryTable table: list.
  12193.     total := 0.
  12194.     labels := OrderedCollection new.
  12195.     labels add: 'ticks'.
  12196.     t1 := initialCondition size.
  12197.     currentTTM currentlyDisplayedSimulateVariables notNil
  12198.         ifTrue: 
  12199.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  12200.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  12201.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  12202.     
  12203.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left.
  12204.     ncols := t1 + 1.
  12205.     self initializeTable! !
  12206.  
  12207. !SimulateWindow methodsFor: 'new variable access'!
  12208. ncols
  12209.     ^ncols! !
  12210.  
  12211. !SimulateWindow methodsFor: 'new variable access'!
  12212. ncols: anInteger
  12213.     ncols := anInteger! !
  12214.  
  12215. !SimulateWindow methodsFor: 'new variable access'!
  12216. nrows
  12217.     ^nrows! !
  12218.  
  12219. !SimulateWindow methodsFor: 'new variable access'!
  12220. simulateTable
  12221.     ^self! !
  12222.  
  12223. !SimulateWindow methodsFor: 'new variable access'!
  12224. tableInterface
  12225.     ^tableInterface! !
  12226.  
  12227. !SimulateWindow methodsFor: 'new variable access'!
  12228. trajectoryList
  12229.     ^trajectoryList! !
  12230.  
  12231. !SimulateWindow methodsFor: 'new variable access'!
  12232. trajectoryTable
  12233.     ^trajectoryTable! !
  12234.  
  12235. !SimulateWindow methodsFor: 'adding'!
  12236. addStringToLine: aString 
  12237.     aLine add: aString.
  12238.       total := total + 1.! !
  12239.  
  12240. !SimulateWindow methodsFor: 'adding'!
  12241. putLine
  12242.     | list lineNumber |
  12243.     lineNumber := 0.
  12244.     aLine addAll: trajectoryList.
  12245.     trajectoryList := aLine.
  12246.     list := TwoDList
  12247.                 on: trajectoryList
  12248.                 columns: ncols
  12249.                 rows: total / ncols.
  12250.     trajectoryTable table: list.
  12251.     advanceCount = 0 | advanceCount = 1
  12252.         ifTrue: [lineNumber := 3]
  12253.         ifFalse: [advanceCount notNil ifTrue: [lineNumber := 2 * advanceCount + 1]].
  12254.     trajectoryTable selectionIndex: 0 @ lineNumber.
  12255.     aLine := OrderedCollection new! !
  12256.  
  12257. !SimulateWindow methodsFor: 'aspects'!
  12258. advanceTransitionNumberAspect
  12259.     "This method was generated by UIDefiner. The initialization provided 
  12260.     below may have been preempted by an initialize method."
  12261.  
  12262.     ^advanceTransitionNumberAspect isNil ifTrue: [advanceTransitionNumberAspect := 0 asValue] ifFalse: [advanceTransitionNumberAspect]! !
  12263.  
  12264. !SimulateWindow methodsFor: 'aspects'!
  12265. fcList
  12266.     "This method was generated by UIDefiner. The initialization provided 
  12267.     below may have been preempted by an initialize method."
  12268.  
  12269.     ^fcList isNil ifTrue: [fcList := String new asValue] ifFalse: [fcList]! !
  12270.  
  12271. !SimulateWindow methodsFor: 'aspects'!
  12272. icList
  12273.     "This method was generated by UIDefiner. The initialization provided 
  12274.     below may have been preempted by an initialize method."
  12275.  
  12276.     ^icList isNil ifTrue: [icList := SelectionInList new] ifFalse: [icList]! !
  12277.  
  12278. !SimulateWindow methodsFor: 'aspects'!
  12279. tlOutAspect
  12280.     "This method was generated by UIDefiner. The initialization provided 
  12281.     below may have been preempted by an initialize method."
  12282.  
  12283.     ^tlOutAspect isNil ifTrue: [tlOutAspect := 'NONE' asValue] ifFalse: [tlOutAspect]! !
  12284.  
  12285. !SimulateWindow methodsFor: 'actions'!
  12286. doTlMenu
  12287.     ""
  12288.  
  12289.     | n |
  12290.     n := (PopUpMenu labelArray: transitionList) startUp.
  12291.     n > 0
  12292.         ifTrue: 
  12293.             [n = 1
  12294.                 ifTrue: 
  12295.                     [doAdvance := false.
  12296.                     doAdvanceTransition := false.
  12297.                     doAdvanceNoTick := false].
  12298.             n = 2
  12299.                 ifTrue: 
  12300.                     [doAdvance := true.
  12301.                     doAdvanceTransition := false.
  12302.                     doAdvanceNoTick := false].
  12303.             n = 3
  12304.                 ifTrue: 
  12305.                     [doAdvance := false.
  12306.                     doAdvanceTransition := false.
  12307.                     doAdvanceNoTick := true].
  12308.             n > 3
  12309.                 ifTrue: 
  12310.                     [doAdvance := false.
  12311.                     doAdvanceTransition := true.
  12312.                     advanceTransition := transitionList at: n].
  12313.             tlOutAspect value: (transitionList at: n)]! !
  12314.  
  12315. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  12316.  
  12317. SimulateWindow class
  12318.     instanceVariableNames: ''!
  12319.  
  12320. !SimulateWindow class methodsFor: 'instance creation'!
  12321. newTable: ttm 
  12322.     ^super new initializeTTM: ttm! !
  12323.  
  12324. !SimulateWindow class methodsFor: 'instance creation'!
  12325. open: currentTTM 
  12326.     self open: (self newTable: currentTTM)
  12327.         with: currentTTM! !
  12328.  
  12329. !SimulateWindow class methodsFor: 'instance creation'!
  12330. open: aSimulateModel with: currentTTM 
  12331.     | title |
  12332.     title := 'Simulating TTM: ' , currentTTM named asText.
  12333.     currentTTM simulateWindow: aSimulateModel.
  12334.     aSimulateModel displayedVariables: OrderedCollection new.
  12335.     aSimulateModel open.
  12336.     aSimulateModel builder window label: title! !
  12337.  
  12338. !SimulateWindow class methodsFor: 'instance creation'!
  12339. openNew: aSimulateModel with: currentTTM 
  12340.     | title |
  12341.     title := 'Simulating TTM: ' , currentTTM named asText.
  12342.     currentTTM simulateWindow: aSimulateModel.
  12343.     aSimulateModel displayedVariables: OrderedCollection new.
  12344.     aSimulateModel open! !
  12345.  
  12346. !SimulateWindow class methodsFor: 'instance creation'!
  12347. openOld: aSimulateModel with: currentTTM 
  12348.     | window container up vsize left hsize startButton stepButton hButton tableView initialView finalView title clockView reButton offButton columns totalPixels textLabels count existingV variableLabels clearButton myWrapper trButton fiButton qButton filterButton ed |
  12349.     window := ScheduledWindow new.
  12350.     title := 'Simulating TTM: ' , currentTTM named asText.
  12351.     window label: title.
  12352.     window model: aSimulateModel.
  12353.     window insideColor: ColorValue white.
  12354.     container := CompositePart new.
  12355.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  12356.         insideColor: ColorValue white.
  12357.     columns := currentTTM activityvariable size + 1 + currentTTM datavariable size * 7.
  12358.     totalPixels := (7.5 * columns) ceiling.
  12359.     totalPixels < 550 ifTrue: [totalPixels := 550].
  12360.     window minimumSize: totalPixels @ 450.
  12361.     currentTTM simulateWindow: aSimulateModel.
  12362.     textLabels := ' t:     '.
  12363.     count := 1.
  12364.     [count > currentTTM activityvariable size]
  12365.         whileFalse: 
  12366.             [existingV := ((currentTTM activityvariable at: count)
  12367.                         at: 1)
  12368.                         , ':       '.
  12369.             existingV := existingV copyFrom: 1 to: 7.
  12370.             textLabels := textLabels , existingV.
  12371.             count := count + 1].
  12372.     count := 1.
  12373.     [count > currentTTM datavariable size]
  12374.         whileFalse: 
  12375.             [existingV := ((currentTTM datavariable at: count)
  12376.                         at: 1)
  12377.                         , ':       '.
  12378.             existingV := existingV copyFrom: 1 to: 7.
  12379.             textLabels := textLabels , existingV.
  12380.             count := count + 1].
  12381.     variableLabels := ComposedText withText: textLabels style: (TextAttributes styleNamed: #fixed).
  12382.     aSimulateModel variableLabels: variableLabels.
  12383.     self labelWrap: (container add: variableLabels borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05)).
  12384.     vsize := 0.05.
  12385.     hsize := 0.15.
  12386.     tableView := AlteredTableView
  12387.                 on: aSimulateModel
  12388.                 aspect: #tableTransaction
  12389.                 list: #tableList.
  12390.      " tableView hasHorizontalScrollBar: true."
  12391.     ed := LookPreferences edgeDecorator on: tableView.    "ed useHorizontalScrollBar."
  12392.     myWrapper := self wrap: ed.
  12393.     container add: myWrapper borderedIn: (0.0 @ 0.05 extent: 1.0 @ 0.65).    "new initial condition view"
  12394.     initialView := SelectionInListView
  12395.                 on: aSimulateModel
  12396.                 printItems: false
  12397.                 oneItem: false
  12398.                 aspect: #icTransaction
  12399.                 change: #icSelection:
  12400.                 list: #icList
  12401.                 menu: #icMenu
  12402.                 initialSelection: nil
  12403.                 useIndex: true.
  12404.     myWrapper := self wrap: (LookPreferences edgeDecorator on: initialView).
  12405.     container add: myWrapper borderedIn: (0.0 @ 0.75 extent: 0.4 @ 0.2).
  12406.     self labelWrap: (container add: 'Starting Condition:' asText allBold asComposedText borderedIn: (0.0 @ 0.7 extent: 0.4 @ 0.05)).    "new stopping condition"
  12407.     finalView := TextView
  12408.                 on: aSimulateModel
  12409.                 aspect: #fcList
  12410.                 change: #fcAccept:
  12411.                 menu: #fcMenu
  12412.                 initialSelection: nil.
  12413.     myWrapper := self wrap: (LookPreferences edgeDecorator on: finalView).
  12414.     container add: myWrapper borderedIn: (0.4 @ 0.75 extent: 0.4 @ 0.2).
  12415.     self labelWrap: (container add: 'Stopping Condition:' asText allBold asComposedText borderedIn: (0.4 @ 0.7 extent: 0.4 @ 0.05)).
  12416.     clockView := AlteredTableView
  12417.                 on: aSimulateModel
  12418.                 aspect: #clockTransaction
  12419.                 list: #clockList.
  12420.     self labelWrap: (container add: clockView borderedIn: (0.8 @ 0.75 extent: 0.2 @ 0.1)).
  12421.     self labelWrap: (container add: 'Elapsed Ticks:' asText allBold asComposedText borderedIn: (0.8 @ 0.7 extent: 0.2 @ 0.05)).
  12422.     up := 0.85.
  12423.     left := 0.8.    "Button for reset of clock"
  12424.     reButton := PushButton named: 'Clock Reset'.
  12425.     reButton model: ((PluggableAdaptor on: aSimulateModel)
  12426.             getBlock: [:model | false]
  12427.             putBlock: [:model :value | model clockReset]
  12428.             updateBlock: [:model :value :parameter | false]).
  12429.     (container add: reButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + 0.2; bottomFraction: up + vsize))
  12430.         insideColor: ColorValue white.
  12431.     up := up + vsize.    "Button for clock offset"
  12432.     offButton := PushButton named: 'Clock Offset'.
  12433.     offButton model: ((PluggableAdaptor on: aSimulateModel)
  12434.             getBlock: [:model | false]
  12435.             putBlock: [:model :value | model clockOffset]
  12436.             updateBlock: [:model :value :parameter | false]).
  12437.     (container add: offButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + 0.2; bottomFraction: up + vsize))
  12438.         insideColor: ColorValue white.
  12439.     up := 0.95.
  12440.     vsize := 0.05.
  12441.     left := 0.
  12442.     hsize := 0.135.    "Button for starting or continuing 
  12443.     
  12444.     simulation"
  12445.     startButton := PushButton named: 'Start/Continue'.
  12446.     startButton model: ((PluggableAdaptor on: aSimulateModel)
  12447.             getBlock: [:model | false]
  12448.             putBlock: [:model :value | model doStart]
  12449.             updateBlock: [:model :value :parameter | false]).
  12450.     (container add: startButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize + 0.0595; bottomFraction: up + vsize))
  12451.         insideColor: ColorValue white.
  12452.     left := left + hsize + 0.0595.
  12453.     hsize := 0.116.    "Button for stepping through simulation 
  12454.     
  12455.     one transition at a time"
  12456.     stepButton := PushButton named: 'Step'.
  12457.     stepButton model: ((PluggableAdaptor on: aSimulateModel)
  12458.             getBlock: [:model | false]
  12459.             putBlock: [:model :value | model doStep]
  12460.             updateBlock: [:model :value :parameter | false]).
  12461.     (container add: stepButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12462.         insideColor: ColorValue white.
  12463.     left := left + hsize.    "Button for clearing table"
  12464.     clearButton := PushButton named: 'Clear'.
  12465.     clearButton model: ((PluggableAdaptor on: aSimulateModel)
  12466.             getBlock: [:model | false]
  12467.             putBlock: [:model :value | model doClear]
  12468.             updateBlock: [:model :value :parameter | false]).
  12469.     (container add: clearButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12470.         insideColor: ColorValue white.
  12471.     left := left + hsize.    "Button for transition states"
  12472.     trButton := PushButton named: 'Status'.
  12473.     trButton model: ((PluggableAdaptor on: aSimulateModel)
  12474.             getBlock: [:model | false]
  12475.             putBlock: [:model :value | model doStates]
  12476.             updateBlock: [:model :value :parameter | false]).
  12477.     (container add: trButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12478.         insideColor: ColorValue white.
  12479.     left := left + hsize.    "***********************"
  12480.     "Button filtering out variables"
  12481.     filterButton := PushButton named: 'Filter'.
  12482.     filterButton model: ((PluggableAdaptor on: aSimulateModel)
  12483.             getBlock: [:model | false]
  12484.             putBlock: [:model :value | model doFilter]
  12485.             updateBlock: [:model :value :parameter | false]).
  12486.     (container add: filterButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12487.         insideColor: ColorValue white.
  12488.     left := left + hsize.    "***********************"
  12489.     "Button for filing out"
  12490.     fiButton := PushButton named: 'File Out'.
  12491.     fiButton model: ((PluggableAdaptor on: aSimulateModel)
  12492.             getBlock: [:model | false]
  12493.             putBlock: [:model :value | model doFileOut]
  12494.             updateBlock: [:model :value :parameter | false]).
  12495.     (container add: fiButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12496.         insideColor: ColorValue white.
  12497.     left := left + hsize.    "Button for quitting"
  12498.     qButton := PushButton named: 'Exit'.
  12499.     qButton model: ((PluggableAdaptor on: aSimulateModel)
  12500.             getBlock: [:model | false]
  12501.             putBlock: [:model :value | TTMList closeWindow: 4 in: currentTTM]
  12502.             updateBlock: [:model :value :parameter | false]).
  12503.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12504.         insideColor: ColorValue white.
  12505.     left := left + hsize.    "Button for help"
  12506.     hButton := PushButton named: 'Help' asText allBold.
  12507.     hButton model: ((PluggableAdaptor on: aSimulateModel)
  12508.             getBlock: [:model | false]
  12509.             putBlock: [:model :value | HelpScreens openHelp: 'simulating']
  12510.             updateBlock: [:model :value :parameter | false]).
  12511.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  12512.         insideColor: ColorValue white.
  12513.     window component: container.
  12514.     aSimulateModel container: container.
  12515.     aSimulateModel windowGC: window graphicsContext.
  12516.     aSimulateModel displayedVariables: OrderedCollection new.
  12517.     currentTTM currentlyDisplayedSimulateVariables notNil
  12518.         ifTrue: 
  12519.             [currentTTM currentlyDisplayedSimulateVariables do: [:x | aSimulateModel displayedVariables addLast: (x at: 1)].
  12520.             aSimulateModel doAcceptFilter].
  12521.     window open! !
  12522.  
  12523. !SimulateWindow class methodsFor: 'decoration'!
  12524. labelWrap: aLabel 
  12525.  
  12526.      | newLabel |
  12527.  
  12528.      newLabel := aLabel.
  12529.  
  12530.      newLabel insideColor: ColorValue white.
  12531.  
  12532.      newLabel borderColor: ColorValue black.
  12533.  
  12534.      newLabel borderWidth: 1.
  12535.  
  12536.      ^newLabel! !
  12537.  
  12538. !SimulateWindow class methodsFor: 'decoration'!
  12539. wrap: aWrapper 
  12540.  
  12541.      | newWrapper |
  12542.  
  12543.      newWrapper := aWrapper.
  12544.  
  12545.      newWrapper noMenuBar.
  12546.  
  12547.      "newWrapper borderColor: ColorValue black."
  12548.  
  12549.      "newWrapper borderWidth: 1."
  12550.  
  12551.      "newWrapper insideColor: ColorValue white."
  12552.  
  12553.      ^newWrapper! !
  12554.  
  12555. !SimulateWindow class methodsFor: 'interface specs'!
  12556. windowSpec
  12557.     "UIPainter new openOnClass: self andSelector: #windowSpec"
  12558.  
  12559.     ^#(#FullSpec #window: #(#WindowSpec #label: 'Simulating TTM:' #min: #(#Point 481 450 ) #bounds: #(#Rectangle 330 286 843 736 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 9 0 0 0.682222 0 0.4 0 0.897778 ) #model: #icList #menu: #icMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.723197 0 0.942222 0 0.838207 0 0.995556 ) #model: #closeMe #label: 'Exit' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.163743 0 0.94 0 0.278752 0 1.0 ) #model: #doStep #label: 'Step' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.272374 0 0.944086 0 0.379377 0 0.995699 ) #model: #doClear #label: 'Clear' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.378168 0 0.944444 0 0.487329 0 0.995556 ) #model: #doStates #label: 'Status' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.489279 0 0.942222 0 0.590643 0 0.995556 ) #model: #doFilter #label: 'Filter' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.00779727 0 0.935556 0 0.163743 0 1.00222 ) #model: #doStart #label: 'Start/Cont.' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0932039 0 0.631111 ) #label: 'Starting Condition:' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.454369 0 0.631111 ) #label: 'Stopping Condition:' ) #(#TableViewSpec #layout: #(#LayoutFrame 0 0.00776699 0 0.0177778 0 0.986408 0 0.631111 ) #model: #tableInterface #tabable: false #style: #small #selectionStyle: #row ) #(#TextEditorSpec #layout: #(#LayoutFrame 0 0.417154 0 0.684444 0 0.762183 0 0.828889 ) #flags: 15 #model: #fcList #menu: #fcMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.854369 0 0.942222 0 0.961165 0 0.993333 ) #model: #doHelp #label: 'Help' #style: #large #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.772374 0 0.737634 0 0.963035 0 0.787097 ) #model: #clockReset #label: 'Clock Reset' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.774319 0 0.784946 0 0.96498 0 0.834409 ) #model: #clockOffset #label: 'Clock Offset' #defaultable: true ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.773879 0 0.688889 0 0.968811 0 0.735555 ) #model: #clockList #type: #number ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.601942 0 0.942222 0 0.712621 0 0.995556 ) #model: #doFileOut #label: 'FileOut' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.770874 0 0.635556 ) #label: 'Clock Value:' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.470817 0 0.834409 ) #label: 'Advance Transition' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.819066 0 0.836559 ) #label: 'Amount' ) #(#GroupBoxSpec #layout: #(#LayoutFrame 0 0.418288 0 0.83871 0 0.970817 0 0.937634 ) ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.805447 0 0.87957 0 0.928016 0 0.922581 ) #model: #advanceTransitionNumberAspect #type: #number ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.533074 0 0.877419 0 0.77821 0 0.924731 ) #model: #tlOutAspect #isReadOnly: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.420233 0 0.866667 0 0.527237 0 0.931183 ) #model: #doTlMenu #label: 'set' #defaultable: true ) ) ) )! !
  12560.  
  12561. !SimulateWindow class methodsFor: 'resources'!
  12562. fcMenu
  12563.     "Answer a menu for the final condition view."
  12564.  
  12565.     ^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #fcAccept #cancel )! !
  12566.  
  12567. !SimulateWindow class methodsFor: 'resources'!
  12568. icMenu
  12569.     "Answer a menu for the initial condition view."
  12570.  
  12571.     "icSelection == nil ifTrue: [^nil]."
  12572.     ^PopUpMenu labelList: #(#('new initial value' ) ) values: #(#icChange )! !
  12573.  
  12574. Model subclass: #TTMListWindow
  12575.     instanceVariableNames: ''
  12576.     classVariableNames: ''
  12577.     poolDictionaries: ''
  12578.     category: 'Build'!
  12579.  
  12580. !TTMListWindow methodsFor: 'closing'!
  12581. changeRequest
  12582.     ^DialogView confirm: 'Are you certain you want to quit?'! !
  12583.  
  12584. Object subclass: #Activity
  12585.     instanceVariableNames: 'activityName type default av selfAV leftNode rightNode box exposedAncestor exposed parent graphicsInfo parentBox hasSubstructure avFlag '
  12586.     classVariableNames: ''
  12587.     poolDictionaries: ''
  12588.     category: 'Build'!
  12589.  
  12590. !Activity methodsFor: 'update'!
  12591. updateStatus
  12592.     rightNode notNil
  12593.         ifTrue: [hasSubstructure := true]
  12594.         ifFalse: [hasSubstructure := false]! !
  12595.  
  12596. !Activity methodsFor: 'accessing'!
  12597. av
  12598.  
  12599.      ^av! !
  12600.  
  12601. !Activity methodsFor: 'accessing'!
  12602. av: newAv
  12603.  
  12604.      av := newAv! !
  12605.  
  12606. !Activity methodsFor: 'accessing'!
  12607. avFlag: aBoolean 
  12608.     avFlag := aBoolean! !
  12609.  
  12610. !Activity methodsFor: 'accessing'!
  12611. collectionType
  12612.     "return the collection type for the immediate children of 
  12613.     
  12614.     the current Activity"
  12615.  
  12616.     ^type! !
  12617.  
  12618. !Activity methodsFor: 'accessing'!
  12619. collectionType: newType
  12620.  
  12621.      "Assign the collection type for the immediate children of
  12622.  
  12623. the current Activity"
  12624.  
  12625.  
  12626.  
  12627.      type := newType.! !
  12628.  
  12629. !Activity methodsFor: 'accessing'!
  12630. default
  12631.     ^default! !
  12632.  
  12633. !Activity methodsFor: 'accessing'!
  12634. default: newDefault
  12635.  
  12636.      default := newDefault! !
  12637.  
  12638. !Activity methodsFor: 'accessing'!
  12639. elderBrotherOf: target 
  12640.  
  12641.      "self is the father of target. Return the immediate 
  12642.  
  12643.      elder brother of target."
  12644.  
  12645.  
  12646.  
  12647.      | father brother |
  12648.  
  12649.      father := self.
  12650.  
  12651.      father left = target
  12652.  
  12653.           ifTrue: [^nil]
  12654.  
  12655.           ifFalse: 
  12656.  
  12657.                [brother := father left.
  12658.  
  12659.                [brother right = target] whileFalse: [brother :=
  12660.  
  12661. brother right].
  12662.  
  12663.                ^brother]! !
  12664.  
  12665. !Activity methodsFor: 'accessing'!
  12666. exposed
  12667.  
  12668.      ^exposed! !
  12669.  
  12670. !Activity methodsFor: 'accessing'!
  12671. exposed: aBoolean 
  12672.  
  12673.      exposed := aBoolean! !
  12674.  
  12675. !Activity methodsFor: 'accessing'!
  12676. exposedAncestor
  12677.  
  12678.      ^exposedAncestor! !
  12679.  
  12680. !Activity methodsFor: 'accessing'!
  12681. exposedAncestor: anActivity 
  12682.  
  12683.      exposedAncestor := anActivity! !
  12684.  
  12685. !Activity methodsFor: 'accessing'!
  12686. graphicsInfo
  12687.  
  12688.      ^graphicsInfo! !
  12689.  
  12690. !Activity methodsFor: 'accessing'!
  12691. graphicsInfo: info 
  12692.  
  12693.      graphicsInfo := info! !
  12694.  
  12695. !Activity methodsFor: 'accessing'!
  12696. hasAV
  12697.     ^avFlag! !
  12698.  
  12699. !Activity methodsFor: 'accessing'!
  12700. hasAV: aBoolean 
  12701.     avFlag := aBoolean! !
  12702.  
  12703. !Activity methodsFor: 'accessing'!
  12704. hasSubstructure
  12705.     ^hasSubstructure! !
  12706.  
  12707. !Activity methodsFor: 'accessing'!
  12708. lastSibling
  12709.     "Return the rightmost sibling of the current Node. If there 
  12710.     
  12711.     is none 
  12712.     
  12713.     then it returns the current node."
  12714.  
  12715.     | lastBrother |
  12716.     lastBrother := self.
  12717.     [lastBrother right isNil]
  12718.         whileFalse: [lastBrother := lastBrother right].
  12719.     ^lastBrother! !
  12720.  
  12721. !Activity methodsFor: 'accessing'!
  12722. lastSibling: newNode
  12723.  
  12724.      "Assign newNode as the rightmost sibling of the current
  12725.  
  12726. Node, self." 
  12727.  
  12728.        
  12729.  
  12730.  
  12731.  
  12732.      | lastBrother |
  12733.  
  12734.      lastBrother := self lastSibling.
  12735.  
  12736.      lastBrother right: newNode.! !
  12737.  
  12738. !Activity methodsFor: 'accessing'!
  12739. left
  12740.  
  12741.      "return the left child of the current Activity"
  12742.  
  12743.  
  12744.  
  12745.      ^leftNode! !
  12746.  
  12747. !Activity methodsFor: 'accessing'!
  12748. left: aNode 
  12749.  
  12750.      "Assign aNode as the left child of the current Activity."
  12751.  
  12752.  
  12753.  
  12754.      leftNode := aNode! !
  12755.  
  12756. !Activity methodsFor: 'accessing'!
  12757. myBox
  12758.  
  12759.      ^box! !
  12760.  
  12761. !Activity methodsFor: 'accessing'!
  12762. myBox: newBox
  12763.  
  12764.      box := newBox! !
  12765.  
  12766. !Activity methodsFor: 'accessing'!
  12767. myName
  12768.  
  12769.      "Return the name of the current Activity."
  12770.  
  12771.  
  12772.  
  12773.      ^activityName! !
  12774.  
  12775. !Activity methodsFor: 'accessing'!
  12776. myName: givenName
  12777.  
  12778.      "Assign the given name to the current Activity."
  12779.  
  12780.  
  12781.  
  12782.      activityName := givenName.! !
  12783.  
  12784. !Activity methodsFor: 'accessing'!
  12785. parent
  12786.     ^parent! !
  12787.  
  12788. !Activity methodsFor: 'accessing'!
  12789. parent: anActivity 
  12790.     parent := anActivity! !
  12791.  
  12792. !Activity methodsFor: 'accessing'!
  12793. parentBox
  12794.  
  12795.      ^parentBox! !
  12796.  
  12797. !Activity methodsFor: 'accessing'!
  12798. parentBox: aBox
  12799.  
  12800.      parentBox := aBox! !
  12801.  
  12802. !Activity methodsFor: 'accessing'!
  12803. right
  12804.  
  12805.      "Return the next right sibling of the current Activity."
  12806.  
  12807.  
  12808.  
  12809.      ^rightNode! !
  12810.  
  12811. !Activity methodsFor: 'accessing'!
  12812. right: aNode 
  12813.  
  12814.      "Assign aNode as the next right sibling of the current
  12815.  
  12816. Activity."
  12817.  
  12818.  
  12819.  
  12820.      rightNode := aNode! !
  12821.  
  12822. !Activity methodsFor: 'accessing'!
  12823. selfAV
  12824.  
  12825.      ^selfAV! !
  12826.  
  12827. !Activity methodsFor: 'accessing'!
  12828. selfAV: temp
  12829.  
  12830.      selfAV := temp! !
  12831.  
  12832. !Activity methodsFor: 'accessing'!
  12833. size
  12834.  
  12835.      "Return the size of the subtree starting at the current
  12836.  
  12837. Node."
  12838.  
  12839.  
  12840.  
  12841.      ^1 + (leftNode isNil
  12842.  
  12843.                ifTrue: [0]
  12844.  
  12845.                ifFalse: [leftNode size]) + (rightNode isNil
  12846.  
  12847.                ifTrue: [0]
  12848.  
  12849.                ifFalse: [rightNode size])! !
  12850.  
  12851. !Activity methodsFor: 'copying'!
  12852. makeCopy
  12853.     | temp |
  12854.     temp := self copy.
  12855.     temp selfAV: self selfAV copy.
  12856.     self myBox notNil ifTrue: [temp myBox: self myBox makeCopy].
  12857.     ^temp! !
  12858.  
  12859. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  12860.  
  12861. Activity class
  12862.     instanceVariableNames: ''!
  12863.  
  12864. !Activity class methodsFor: 'instance creation'!
  12865. name: givenName collectAs: newType left: lNode right: rNode 
  12866.     "Create an instance of an activity. It has a name, a type 
  12867.     
  12868.     (either 
  12869.     
  12870.     #cluster or #parallel) for its immediate children, a left 
  12871.     
  12872.     pointer to 
  12873.     
  12874.     its leftmost child and a right pointer to its next sibling."
  12875.  
  12876.     | newActivity |
  12877.     newActivity := self new.
  12878.     newActivity myName: givenName.
  12879.     newActivity collectionType: newType.
  12880.     newActivity left: lNode.
  12881.     newActivity right: rNode.
  12882.     newActivity myBox: nil.
  12883.     newActivity default: false.
  12884.     newActivity av: nil.
  12885.     newActivity updateStatus.
  12886.     newActivity avFlag: false.
  12887.     newActivity selfAV: (Array with: '' with: '').
  12888.     ^newActivity! !
  12889.  
  12890. SequenceableCollection subclass: #ParseTree
  12891.     instanceVariableNames: 'root errors parent currentPosition currentTTM doAgain '
  12892.     classVariableNames: ''
  12893.     poolDictionaries: ''
  12894.     category: 'Build'!
  12895.  
  12896. !ParseTree methodsFor: 'private'!
  12897. addLeftAtom: newAtom to: currentElement 
  12898.     | newElement |
  12899.     newElement := ParseElement
  12900.                 contents: newAtom
  12901.                 left: nil
  12902.                 right: nil.
  12903.     currentElement left: newElement.
  12904.     currentPosition := newElement! !
  12905.  
  12906. !ParseTree methodsFor: 'private'!
  12907. addLeftConnector: newContents to: current with: child 
  12908.     | newElement |
  12909.     newElement := ParseElement
  12910.                 contents: newContents
  12911.                 left: child
  12912.                 right: nil.
  12913.     current left: newElement.
  12914.     currentPosition := newElement! !
  12915.  
  12916. !ParseTree methodsFor: 'private'!
  12917. addRightAtom: newAtom to: currentElement 
  12918.     | newElement |
  12919.     newElement := ParseElement
  12920.                 contents: newAtom
  12921.                 left: nil
  12922.                 right: nil.
  12923.     currentElement right: newElement.
  12924.     currentPosition := newElement! !
  12925.  
  12926. !ParseTree methodsFor: 'private'!
  12927. addRightConnector: newContents to: current with: child 
  12928.     | newElement |
  12929.     newElement := ParseElement
  12930.                 contents: newContents
  12931.                 left: child
  12932.                 right: nil.
  12933.     current right: newElement.
  12934.     currentPosition := newElement! !
  12935.  
  12936. !ParseTree methodsFor: 'private'!
  12937. extraLeftsFrom: start 
  12938.     "A recursive traversal. Mark as error if 
  12939.     
  12940.     there is a node with contents = 'LEFT'.."
  12941.  
  12942.     start left ~= nil ifTrue: [self extraLeftsFrom: start left].
  12943.     start contents = 'LEFT' ifTrue: [errors := 'extra lefts'].
  12944.     start right ~= nil ifTrue: [self extraLeftsFrom: start right]! !
  12945.  
  12946. !ParseTree methodsFor: 'private'!
  12947. negate: start 
  12948.     start left ~= nil ifTrue: [self negate: start left].
  12949.     start = root ifFalse: [start isAtom
  12950.             ifTrue: [start contents: (self negateAtom: start contents)]
  12951.             ifFalse: [start contents = 'AND'
  12952.                     ifTrue: [start contents: 'OR']
  12953.                     ifFalse: [start contents = 'OR'
  12954.                             ifTrue: [start contents: 'AND']
  12955.                             ifFalse: [TTMList speak: 'error in negating guard']]]].
  12956.     start right ~= nil ifTrue: [self negate: start right]! !
  12957.  
  12958. !ParseTree methodsFor: 'private'!
  12959. negateAtom: oldAtom 
  12960.     "We want to reverse all comparator signs. 
  12961.     
  12962.     Then return the atom."
  12963.  
  12964.     | anAtom p operator comparator replacement replacement2 |
  12965.     anAtom := oldAtom copy.
  12966.     p := 1.
  12967.     operator := anAtom at: p.
  12968.     [(ParseTree isAComparator: operator) = true | (p = anAtom size)]
  12969.         whileFalse: 
  12970.             [p := p + 1.
  12971.             operator := anAtom at: p].
  12972.     p = anAtom size ifTrue: [^anAtom].
  12973.     comparator := operator.
  12974.     replacement2 := nil.
  12975.     (anAtom at: p + 1)
  12976.         = '=' | ((anAtom at: p + 1)
  12977.             = '<')
  12978.         ifTrue: 
  12979.             [comparator = '=' ifTrue: [replacement := '>'].
  12980.             comparator = '>' ifTrue: [replacement := '<'].
  12981.             anAtom removeAtIndex: p + 1]
  12982.         ifFalse: 
  12983.             [comparator = '#' ifTrue: [replacement := '='].
  12984.             comparator = '=' ifTrue: [replacement := '#'].
  12985.             comparator = '<'
  12986.                 ifTrue: 
  12987.                     [replacement := '>'.
  12988.                     replacement2 := '='].
  12989.             comparator = '>'
  12990.                 ifTrue: 
  12991.                     [replacement := '='.
  12992.                     replacement2 := '<']].
  12993.     anAtom at: p put: replacement.
  12994.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  12995.     ^anAtom! !
  12996.  
  12997. !ParseTree methodsFor: 'private'!
  12998. negateAtomNew: oldAtom 
  12999.     "We want to reverse all comparator signs. 
  13000.     
  13001.     Then return the atom."
  13002.  
  13003.     | anAtom p operator comparator replacement replacement2 |
  13004.     anAtom := oldAtom.
  13005.     p := 1.
  13006.     operator := anAtom at: p.
  13007.     [ParseTree isAComparator: operator]
  13008.         whileFalse: 
  13009.             [p := p + 1.
  13010.             operator := anAtom at: p].
  13011.     comparator := operator.
  13012.     replacement2 := nil.
  13013.     (anAtom at: p + 1)
  13014.         = '=' | ((anAtom at: p + 1)
  13015.             = '<')
  13016.         ifTrue: 
  13017.             [comparator = '=' ifTrue: [replacement := '>'].
  13018.             comparator = '>' ifTrue: [replacement := '<'].
  13019.             "anAtom removeAtIndex: p + 1"]
  13020.         ifFalse: 
  13021.             [comparator = '#' ifTrue: [replacement := '='].
  13022.             comparator = '=' ifTrue: [replacement := '#'].
  13023.             comparator = '<'
  13024.                 ifTrue: 
  13025.                     [replacement := '>'.
  13026.                     replacement2 := '='].
  13027.             comparator = '>'
  13028.                 ifTrue: 
  13029.                     [replacement := '='.
  13030.                     replacement2 := '<']].
  13031.     "anAtom removeAtIndex: p."
  13032.     anAtom at: p put: replacement .
  13033.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  13034.     ^anAtom! !
  13035.  
  13036. !ParseTree methodsFor: 'private'!
  13037. negateAtomOld: oldAtom 
  13038.     "We want to reverse all comparator signs. 
  13039.     
  13040.     Then return the atom."
  13041.  
  13042.     | anAtom p operator comparator replacement replacement2 |
  13043.     anAtom := oldAtom.
  13044.     p := 1.
  13045.     operator := anAtom at: p.
  13046.     [ParseTree isAComparator: operator]
  13047.         whileFalse: 
  13048.             [p := p + 1.
  13049.             operator := anAtom at: p].
  13050.     comparator := operator.
  13051.     replacement2 := nil.
  13052.     (anAtom at: p + 1)
  13053.         = '=' | ((anAtom at: p + 1)
  13054.             = '<')
  13055.         ifTrue: 
  13056.             [comparator = '=' ifTrue: [replacement := '>'].
  13057.             comparator = '>' ifTrue: [replacement := '<'].
  13058.             anAtom removeAtIndex: p + 1]
  13059.         ifFalse: 
  13060.             [comparator = '#' ifTrue: [replacement := '='].
  13061.             comparator = '=' ifTrue: [replacement := '#'].
  13062.             comparator = '<'
  13063.                 ifTrue: 
  13064.                     [replacement := '>'.
  13065.                     replacement2 := '='].
  13066.             comparator = '>'
  13067.                 ifTrue: 
  13068.                     [replacement := '='.
  13069.                     replacement2 := '<']].
  13070.     anAtom removeAtIndex: p.
  13071.     anAtom add: replacement beforeIndex: p.
  13072.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  13073.     ^anAtom! !
  13074.  
  13075. !ParseTree methodsFor: 'private'!
  13076. parentOf: target startingAt: start 
  13077.     "A recursive search called by method 'parentOf:'. 
  13078.     
  13079.     Once the parent is found; i.e. no longer = nil, the 
  13080.     
  13081.     search is ended as quickly as possible."
  13082.  
  13083.     start left ~= nil & parent isNil
  13084.         ifTrue: [self parentOf: target startingAt: start left]
  13085.         ifFalse: [].
  13086.     parent isNil
  13087.         ifTrue: [start left = target | (start right = target)
  13088.                 ifTrue: [parent := start]
  13089.                 ifFalse: []]
  13090.         ifFalse: [].
  13091.     start right ~= nil & parent isNil
  13092.         ifTrue: [self parentOf: target startingAt: start right]
  13093.         ifFalse: []! !
  13094.  
  13095. !ParseTree methodsFor: 'private'!
  13096. prenex: start 
  13097.     "Recursive traversal that does one pass of switching 
  13098.     
  13099.     AND and ORs. If more passes may be required, it sets 
  13100.     
  13101.     doAgain = true."
  13102.  
  13103.     | current rsubtree lsubtree movedNode newsubtree |
  13104.     current := start.
  13105.     current contents = 'AND'
  13106.         ifTrue: 
  13107.             [rsubtree := current right.
  13108.             lsubtree := current left.
  13109.             lsubtree contents = 'OR'
  13110.                 ifTrue: 
  13111.                     [current contents: 'OR'.
  13112.                     lsubtree contents: 'AND'.
  13113.                     movedNode := lsubtree right copy.
  13114.                     lsubtree right: rsubtree.
  13115.                     newsubtree := ParseElement
  13116.                                 contents: 'AND'
  13117.                                 left: movedNode
  13118.                                 right: rsubtree copy.
  13119.                     current right: newsubtree.
  13120.                     doAgain := true]
  13121.                 ifFalse: [rsubtree contents = 'OR'
  13122.                         ifTrue: 
  13123.                             [current contents: 'OR'.
  13124.                             rsubtree contents: 'AND'.
  13125.                             movedNode := rsubtree left copy.
  13126.                             rsubtree left: lsubtree.
  13127.                             newsubtree := ParseElement
  13128.                                         contents: 'AND'
  13129.                                         left: lsubtree copy
  13130.                                         right: movedNode.
  13131.                             current left: newsubtree.
  13132.                             doAgain := true]]].
  13133.     start left ~= nil ifTrue: [self prenex: start left].
  13134.     start right ~= nil ifTrue: [self prenex: start right]! !
  13135.  
  13136. !ParseTree methodsFor: 'possible events'!
  13137. atom: newAtom 
  13138.     "An ATOM was encountered. Alter the      
  13139.     ParseTree accordingly. An ATOM could be      
  13140.     a boolean expression or an assignment."
  13141.  
  13142.     currentPosition isAtom
  13143.         ifTrue: 
  13144.             ["errors := 'consecutive atoms'.
  13145.             TTMList speak: errors"]
  13146.         ifFalse: [currentPosition left = nil
  13147.                 ifTrue: [self addLeftAtom: newAtom to: currentPosition]
  13148.                 ifFalse: [currentPosition right = nil & (currentPosition contents ~= 'LEFT')
  13149.                         ifTrue: [self addRightAtom: newAtom to: currentPosition]
  13150.                         ifFalse: 
  13151.                             [errors := 'missing connector'.
  13152.                             TTMList speak: errors]]]! !
  13153.  
  13154. !ParseTree methodsFor: 'possible events'!
  13155. chooseEventFor: anElement 
  13156.     "anElement can be either a left bracket, a right 
  13157.     
  13158.     bracket, logical AND, logical OR, or an atom."
  13159.  
  13160.     | component |
  13161.     errors := nil.
  13162.     component := anElement at: 1.
  13163.     component = '('
  13164.         ifTrue: [self leftBracket]
  13165.         ifFalse: [component = ')'
  13166.                 ifTrue: [self rightBracket]
  13167.                 ifFalse: [component = ';'
  13168.                         ifTrue: [self logicalOr]
  13169.                         ifFalse: [component = ','
  13170.                                 ifTrue: [self logicalAnd]
  13171.                                 ifFalse: [TTMList speak: 'unknown event']]]]! !
  13172.  
  13173. !ParseTree methodsFor: 'possible events'!
  13174. inPrenexForm
  13175.     "Converts the parse tree into prenex form then 
  13176.     
  13177.     returns it."
  13178.  
  13179.     | continue |
  13180.     doAgain := false.
  13181.     
  13182.     continue := true.
  13183.     [continue]
  13184.         whileTrue: 
  13185.             [self prenex: root.
  13186.             continue := doAgain.
  13187.             doAgain := false].
  13188.     ^self! !
  13189.  
  13190. !ParseTree methodsFor: 'possible events'!
  13191. leftBracket
  13192.     "A left bracket was encountered. We create 
  13193.     
  13194.     a special temporary connector for this. Its 
  13195.     
  13196.     left pointer points to all within the brackets 
  13197.     
  13198.     and its right pointer is never used. When the 
  13199.     
  13200.     right bracket is encountered this connector 
  13201.     
  13202.     is removed."
  13203.  
  13204.     | father |
  13205.     currentPosition contents = 'LEFT' | (currentPosition = root)
  13206.         ifTrue: [self
  13207.                 addLeftConnector: 'LEFT'
  13208.                 to: currentPosition
  13209.                 with: currentPosition left]
  13210.         ifFalse: [currentPosition isAtom
  13211.                 ifTrue: 
  13212.                     [father := self parentOf: currentPosition.
  13213.                     father left isNil
  13214.                         ifTrue: [self
  13215.                                 addLeftConnector: 'LEFT'
  13216.                                 to: currentPosition
  13217.                                 with: nil]
  13218.                         ifFalse: [father right isNil
  13219.                                 ifTrue: [self
  13220.                                         addRightConnector: 'LEFT'
  13221.                                         to: currentPosition
  13222.                                         with: nil]
  13223.                                 ifFalse: 
  13224.                                     [errors := 'missing AND/OR'.
  13225.                                     TTMList speak: errors]]]
  13226.                 ifFalse: [currentPosition left isNil
  13227.                         ifTrue: [self
  13228.                                 addLeftConnector: 'LEFT'
  13229.                                 to: currentPosition
  13230.                                 with: nil]
  13231.                         ifFalse: [currentPosition right isNil
  13232.                                 ifTrue: [self
  13233.                                         addRightConnector: 'LEFT'
  13234.                                         to: currentPosition
  13235.                                         with: nil]
  13236.                                 ifFalse: 
  13237.                                     [errors := 'missing AND/OR'.
  13238.                                     TTMList speak: errors]]]]! !
  13239.  
  13240. !ParseTree methodsFor: 'possible events'!
  13241. logicalAnd
  13242.     "A AND was encountered. Alter the ParseTree accordingly. 
  13243.     
  13244.     We want to place this logical AND where the currentPosition 
  13245.     
  13246.     is and make the currentPosition its left child."
  13247.  
  13248.     | father child |
  13249.     currentPosition contents = 'ROOT' | (currentPosition contents = 'LEFT')
  13250.         ifTrue: 
  13251.             [errors := 'AND encountered prior to an atom'.
  13252.             TTMList speak: errors]
  13253.         ifFalse: [currentPosition isAtom
  13254.                 ifFalse: 
  13255.                     [errors := 'consecutive AND/ORs'.
  13256.                     TTMList speak: errors]
  13257.                 ifTrue: 
  13258.                     [father := self parentOf: currentPosition.
  13259.                     child := currentPosition.
  13260.                     [father ~= root & (father contents ~= 'LEFT' & (father left ~= nil & (father right ~= nil)))]
  13261.                         whileTrue: 
  13262.                             [child := father.
  13263.                             father := self parentOf: child].
  13264.                     father = root | (father contents = 'LEFT')
  13265.                         ifTrue: [self
  13266.                                 addLeftConnector: 'AND'
  13267.                                 to: father
  13268.                                 with: child]
  13269.                         ifFalse: 
  13270.                             [errors := 'consecutive
  13271.  
  13272. AND/ORs'.
  13273.                             TTMList speak: errors]]]! !
  13274.  
  13275. !ParseTree methodsFor: 'possible events'!
  13276. logicalOr
  13277.     "A OR was encountered. Alter the 
  13278.     
  13279.     ParseTree accordingly. See logicalAnd 
  13280.     
  13281.     for description."
  13282.  
  13283.     | father child |
  13284.     currentPosition = root | (currentPosition contents = 'LEFT')
  13285.         ifTrue: 
  13286.             [errors := 'OR encountered prior to an atom'.
  13287.             TTMList speak: errors]
  13288.         ifFalse: [currentPosition isAtom
  13289.                 ifFalse: 
  13290.                     [errors := 'consecutive AND/ORs'.
  13291.                     TTMList speak: errors]
  13292.                 ifTrue: 
  13293.                     [father := self parentOf: currentPosition.
  13294.                     child := currentPosition.
  13295.                     [father ~= root & (father contents ~= 'LEFT') & (father left ~= nil & (father right ~= nil))]
  13296.                         whileTrue: 
  13297.                             [child := father.
  13298.                             father := self parentOf: child].
  13299.                     father = root | (father contents = 'LEFT')
  13300.                         ifTrue: [self
  13301.                                 addLeftConnector: 'OR'
  13302.                                 to: father
  13303.                                 with: child]
  13304.                         ifFalse: 
  13305.                             [errors := 'consecutive AND/ORs'.
  13306.                             TTMList speak: errors]]]! !
  13307.  
  13308. !ParseTree methodsFor: 'possible events'!
  13309. negation
  13310.     "Changes the current parse tree to its negation. 
  13311.     
  13312.     Example: (A , (B ; C)) becomes (~A ; (~B , ~C))."
  13313.  
  13314.     self negate: root.
  13315.     ^self! !
  13316.  
  13317. !ParseTree methodsFor: 'possible events'!
  13318. rightBracket
  13319.     "A right bracket was encountered. Alter the 
  13320.     
  13321.     ParseTree accordingly. 
  13322.     
  13323.     We must find the corresponding left bracket. 
  13324.     
  13325.     It acts as a placeholder."
  13326.  
  13327.     | father grandFather |
  13328.     currentPosition = root
  13329.         ifTrue: 
  13330.             [errors := 'Right bracket encountered prior to left'.
  13331.             TTMList speak: errors]
  13332.         ifFalse: 
  13333.             [father := self parentOf: currentPosition.
  13334.             [father contents = 'LEFT' | (father = root)]
  13335.                 whileFalse: [father := self parentOf: father].
  13336.             father = root
  13337.                 ifTrue: 
  13338.                     [errors := 'extra right bracket'.
  13339.                     TTMList speak: errors]
  13340.                 ifFalse: 
  13341.                     [grandFather := self parentOf: father.
  13342.                     grandFather left = father
  13343.                         ifTrue: [grandFather left: father left]
  13344.                         ifFalse: [grandFather right: father left]]]! !
  13345.  
  13346. !ParseTree methodsFor: 'accessing'!
  13347. error
  13348.     ^errors! !
  13349.  
  13350. !ParseTree methodsFor: 'accessing'!
  13351. extraLefts
  13352.     errors := nil.
  13353.     self extraLeftsFrom: root.
  13354.     errors isNil ifFalse: [TTMList speak: 'extra left brackets'].
  13355.     ^errors isNil not! !
  13356.  
  13357. !ParseTree methodsFor: 'accessing'!
  13358. isNotAtom: aComponent 
  13359.     "Return true if the component is leftbracket, 
  13360.     
  13361.     rightbracket, comma, or semi-colon."
  13362.  
  13363.     | result |
  13364.     result := false.
  13365.     aComponent = '(' ifTrue: [result := true].
  13366.     aComponent = ')' ifTrue: [result := true].
  13367.     aComponent = ',' ifTrue: [result := true].
  13368.     aComponent = ';' ifTrue: [result := true].
  13369.     ^result! !
  13370.  
  13371. !ParseTree methodsFor: 'accessing'!
  13372. isNotAtomOld: aComponent 
  13373.     "Return true if the component is leftbracket, 
  13374.     
  13375.     rightbracket, comma, or semi-colon."
  13376.  
  13377.     | result |
  13378.     result := false.
  13379.     aComponent = '(' ifTrue: [result := true].
  13380.     aComponent = ')' ifTrue: [result := true].
  13381.     aComponent = ',' ifTrue: [result := true].
  13382.     aComponent = ';' ifTrue: [result := true].
  13383.     ^result! !
  13384.  
  13385. !ParseTree methodsFor: 'accessing'!
  13386. parentOf: currentElement 
  13387.     "Return the parent of the current Element in 
  13388.     
  13389.     the parse tree. This is used for changing 
  13390.     
  13391.     pointers to the current Element."
  13392.  
  13393.     root = nil
  13394.         ifTrue: [^nil]
  13395.         ifFalse: 
  13396.             [parent := nil.
  13397.             currentElement = root
  13398.                 ifTrue: [^nil]
  13399.                 ifFalse: 
  13400.                     [self parentOf: currentElement startingAt: root.
  13401.                     ^parent]]! !
  13402.  
  13403. !ParseTree methodsFor: 'accessing'!
  13404. treeRoot
  13405.     ^root! !
  13406.  
  13407. !ParseTree methodsFor: 'initialize-release'!
  13408. initializeWith: ttm 
  13409.     "root is initialized as a special connector. Its contents 
  13410.     
  13411.     should never be changed. Its left pointer is to the 
  13412.     
  13413.     parse tree (initialized as nil). Its right pointer is never 
  13414.     
  13415.     used."
  13416.  
  13417.     currentTTM := ttm.
  13418.     errors := nil.
  13419.     root := ParseElement
  13420.                 contents: 'ROOT'
  13421.                 left: nil
  13422.                 right: nil.
  13423.     currentPosition := root.
  13424.     ^root! !
  13425.  
  13426. !ParseTree methodsFor: 'tree syntax check'!
  13427. checkAtomsAs: atomType 
  13428.     errors := nil.
  13429.     atomType = #function
  13430.         ifTrue: [self functionCheck: root]
  13431.         ifFalse: [self guardCheck: root].
  13432.     ^errors! !
  13433.  
  13434. !ParseTree methodsFor: 'tree syntax check'!
  13435. functionCheck: start 
  13436.     "A recursive traversal."
  13437.  
  13438.     start left ~= nil ifTrue: [self functionCheck: start left].
  13439.     start isAtom ifTrue: [(self isFunctionAtom: start contents)
  13440.             ifFalse: 
  13441.                 [errors := 'assignment error'.
  13442.                 TTMList speak: errors]].
  13443.     start right ~= nil ifTrue: [self functionCheck: start right]! !
  13444.  
  13445. !ParseTree methodsFor: 'tree syntax check'!
  13446. guardCheck: start 
  13447.     "A recursive traversal."
  13448.  
  13449.     start left ~= nil ifTrue: [self guardCheck: start left].
  13450.     start isAtom ifTrue: [(self isGuardAtom: start contents)
  13451.             ifFalse: 
  13452.                 [errors := 'expression error'.
  13453.                 TTMList speak: errors]].
  13454.     start right ~= nil ifTrue: [self guardCheck: start right]! !
  13455.  
  13456. !ParseTree methodsFor: 'atom syntax check'!
  13457. isAValidOperand: anAtom from: start to: end with: allowance 
  13458.     "Return true if the section of the atom from start      
  13459.     to end is a valid operand. Note that it      
  13460.     is allowable to have X - -Y which would translate      
  13461.     into X + Y, but not --X + Y. 
  13462.     Allowances refer to what the routine should allow.      
  13463.     If #channel then will only accept an operand that      
  13464.     is a communication channel. If #variable then only      
  13465.     a variable. If #noOperations then no addition or      
  13466.     subtraction is allowed (though negatives are okay)."
  13467.  
  13468.     | p firstPart |
  13469.     p := start.
  13470.     allowance = #channel | (allowance = #variable)
  13471.         ifTrue: 
  13472.             [end > start ifTrue: [^false].
  13473.             allowance = #channel
  13474.                 ifTrue: [^currentTTM anExistingCh: (anAtom at: p)]
  13475.                 ifFalse: [^currentTTM anExistingV: (anAtom at: p)]].
  13476.     firstPart := true.
  13477.     [p > end]
  13478.         whileFalse: 
  13479.             [(ParseTree isAnOperator: (anAtom at: p))
  13480.                 ifTrue: 
  13481.                     [firstPart = false & (allowance = #noOperations) ifTrue: [^false].
  13482.                     p := p + 1.
  13483.                     p > end ifTrue: [^false].
  13484.                     (ParseTree isAnOperator: (anAtom at: p))
  13485.                         ifTrue: 
  13486.                             [firstPart = true | (allowance = #noOperations) ifTrue: [^false].
  13487.                             p := p + 1.
  13488.                             p > end ifTrue: [^false]]].
  13489.             (currentTTM anExistingActivityName: (anAtom at: p))
  13490.                 | (currentTTM anExistingV: (anAtom at: p)) | (TTMList aValidNumber: (anAtom at: p)) ifFalse: [^false].
  13491.             firstPart := false.
  13492.             p := p + 1].
  13493.     ^true! !
  13494.  
  13495. !ParseTree methodsFor: 'atom syntax check'!
  13496. isFunctionAtom: anAtom 
  13497.     "Return true if anAtom is a function assignment."
  13498.  
  13499.     | count assignment allowance1 allowance2 |
  13500.     count := 1.
  13501.     assignment := 0.
  13502.     [count > anAtom size]
  13503.         whileFalse: 
  13504.             [(ParseTree isAnAssigner: (anAtom at: count))
  13505.                 ifTrue: 
  13506.                     [assignment > 0 ifTrue: [^false].
  13507.                     assignment := count].
  13508.             count := count + 1].
  13509.     assignment < 2 | (assignment = anAtom size) ifTrue: [^false].
  13510.     allowance1 := #variable.
  13511.     allowance2 := #anything.
  13512.     (anAtom at: assignment)
  13513.         = '?' | ((anAtom at: assignment)
  13514.             = '!!')
  13515.         ifTrue: 
  13516.             [allowance1 := #channel.
  13517.             (anAtom at: assignment)
  13518.                 = '?' ifTrue: [allowance2 := #variable]].
  13519.     (self
  13520.         isAValidOperand: anAtom
  13521.         from: 1
  13522.         to: assignment - 1
  13523.         with: allowance1)
  13524.         ifFalse: [^false].
  13525.     (self
  13526.         isAValidOperand: anAtom
  13527.         from: assignment + 1
  13528.         to: anAtom size
  13529.         with: allowance2)
  13530.         ifFalse: [^false].
  13531.     ^true! !
  13532.  
  13533. !ParseTree methodsFor: 'atom syntax check'!
  13534. isGuardAtom: anAtom 
  13535.     "Return true if anAtom is a valid guard expression."
  13536.  
  13537.     | count comparator double |
  13538.     count := 1.
  13539.     comparator := 0.
  13540.     double := 0.
  13541.     [count > anAtom size]
  13542.         whileFalse: 
  13543.             [(ParseTree isAComparator: (anAtom at: count))
  13544.                 ifTrue: [comparator > 0
  13545.                         ifTrue: 
  13546.                             [double > 0 ifTrue: [^false].
  13547.                             (anAtom at: comparator)
  13548.                                 = '>' & ((anAtom at: count)
  13549.                                     = '=') | ((anAtom at: comparator)
  13550.                                     = '=' & ((anAtom at: count)
  13551.                                         = '<')) ifFalse: [^false].
  13552.                             double := count]
  13553.                         ifFalse: [comparator := count]].
  13554.             count := count + 1].
  13555.     comparator < 2 | (comparator = anAtom size) ifTrue: [^false].
  13556.     double = 0 ifTrue: [double := comparator].
  13557.     (self
  13558.         isAValidOperand: anAtom
  13559.         from: 1
  13560.         to: comparator - 1
  13561.         with: #anything)
  13562.         ifFalse: [^false].
  13563.     (self
  13564.         isAValidOperand: anAtom
  13565.         from: double + 1
  13566.         to: anAtom size
  13567.         with: #anything)
  13568.         ifFalse: [^false].
  13569.     ^true! !
  13570.  
  13571. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  13572.  
  13573. ParseTree class
  13574.     instanceVariableNames: ''!
  13575.  
  13576. !ParseTree class methodsFor: 'symbol identity'!
  13577. isAComparator: aComponent 
  13578.     "Return true if the component is #, =, <, >, >=, or =<."
  13579.  
  13580.     | result |
  13581.     result := false.
  13582.     aComponent = '#' ifTrue: [result := true].
  13583.     aComponent = '=' ifTrue: [result := true].
  13584.     aComponent = '<' ifTrue: [result := true].
  13585.     aComponent = '>' ifTrue: [result := true].
  13586.     aComponent = '>=' ifTrue: [result := true].
  13587.     aComponent = '=<' ifTrue: [result := true].
  13588.     ^result! !
  13589.  
  13590. !ParseTree class methodsFor: 'symbol identity'!
  13591. isAnAssigner: aComponent 
  13592.     "Return true if the component is :, ?, or !!."
  13593.  
  13594.     | result |
  13595.     result := false.
  13596.     aComponent = ':' ifTrue: [result := true].
  13597.     aComponent = '?' ifTrue: [result := true].
  13598.     aComponent = '!!' ifTrue: [result := true].
  13599.     ^result! !
  13600.  
  13601. !ParseTree class methodsFor: 'symbol identity'!
  13602. isAnOperator: aComponent 
  13603.     "Return true if the component is + or - or * or /"
  13604.  
  13605.     | result |
  13606.     result := false.
  13607.     aComponent = '+' ifTrue: [result := true].
  13608.     aComponent = '-' ifTrue: [result := true].
  13609.     aComponent = '*' ifTrue: [result := true].
  13610.     aComponent = '/' ifTrue: [result := true].
  13611.     aComponent = '%' ifTrue: [result := true].
  13612.     ^result! !
  13613.  
  13614. !ParseTree class methodsFor: 'symbol identity'!
  13615. isAnOperatorOld: aComponent 
  13616.     "Return true if the component is + or - or *."
  13617.  
  13618.     | result |
  13619.     result := false.
  13620.     aComponent = '+' ifTrue: [result := true].
  13621.     aComponent = '-' ifTrue: [result := true].
  13622.     aComponent = '*' ifTrue: [result := true].
  13623.     ^result! !
  13624.  
  13625. !ParseTree class methodsFor: 'string syntax check'!
  13626. functionSyntaxCheck: aString from: currentTTM 
  13627.     "Fission the string into components, then order 
  13628.     
  13629.     them by creating a parse tree. Finally, examine 
  13630.     
  13631.     each assignment to see that it is valid."
  13632.  
  13633.     | errors components parseTree |
  13634.     errors := false.
  13635.     components := ParseTree fission: aString definedAs: #function.
  13636.     components = nil
  13637.         ifTrue: 
  13638.             [TTMList speak: 'illegal symbol(s)'.
  13639.             errors := true]
  13640.         ifFalse: 
  13641.             [parseTree := ParseTree orderIntoTree: components from: currentTTM.
  13642.             parseTree = nil
  13643.                 ifTrue: 
  13644.                     [TTMList speak: 'error in parsing function'.
  13645.                     errors := true]
  13646.                 ifFalse: [parseTree extraLefts
  13647.                         ifTrue: [errors := true]
  13648.                         ifFalse: [(parseTree checkAtomsAs: #function)
  13649.                                 ~= nil ifTrue: [errors := true]]]].
  13650.     ^errors! !
  13651.  
  13652. !ParseTree class methodsFor: 'string syntax check'!
  13653. guardSyntaxCheck: aString from: currentTTM 
  13654.     "Fission the string into components, then order 
  13655.     
  13656.     them by creating a parse tree. Finally, examine 
  13657.     
  13658.     each expression to see that it is valid. Returns 
  13659.     
  13660.     true if an error is found."
  13661.  
  13662.     | errors components parseTree |
  13663.     errors := false.
  13664.     components := ParseTree fission: aString definedAs: #guard.
  13665.     components = nil
  13666.         ifTrue: 
  13667.             [TTMList speak: 'illegal symbol(s)'.
  13668.             errors := true]
  13669.         ifFalse: 
  13670.             [parseTree := ParseTree orderIntoTree: components from: currentTTM.
  13671.             parseTree = nil
  13672.                 ifTrue: 
  13673.                     [TTMList speak: 'error in parsing guard'.
  13674.                     errors := true]
  13675.                 ifFalse: [parseTree extraLefts
  13676.                         ifTrue: [errors := true]
  13677.                         ifFalse: [(parseTree checkAtomsAs: #guard) isNil ifFalse: [errors := true]]]].
  13678.     ^errors! !
  13679.  
  13680. !ParseTree class methodsFor: 'construction'!
  13681. fission: aString definedAs: stringType 
  13682.     "Divide aString into its components which are either numbers      
  13683.     (as strings), variables or operators. Returns nil if error      
  13684.     otherwise      
  13685.     returns components as an OrderedCollection."
  13686.  
  13687.     | components position currentLeft letter errors legalSymbols set |
  13688.     errors := false.
  13689.     stringType = #guard
  13690.         ifTrue: [legalSymbols := #($+ $- $* $/ $% $> $< $= $# $, $; $( $) )]
  13691.         ifFalse: [legalSymbols := #($+ $- $* $/  $% $: $!! $? $, )].
  13692.     components := OrderedCollection new.
  13693.     set := Incrementer new.
  13694.     set startWith: aString.
  13695.     currentLeft := 1.
  13696.     aString size = 0
  13697.         ifTrue: [errors := true]
  13698.         ifFalse: 
  13699.             [letter := set currentLetter.
  13700.             [letter = $@ | errors]
  13701.                 whileFalse: 
  13702.                     [letter isDigit
  13703.                         ifTrue: [[letter ~= $@ & letter isDigit]
  13704.                                 whileTrue: [letter := set nextLetter]]
  13705.                         ifFalse: [letter isAlphaNumeric | (letter = $_)
  13706.                                 ifTrue: [[letter ~= $@ & (letter isAlphaNumeric | (letter = $_))]
  13707.                                         whileTrue: [letter := set nextLetter]]
  13708.                                 ifFalse: [letter isSeparator
  13709.                                         ifTrue: [[letter ~= $@ & letter isSeparator]
  13710.                                                 whileTrue: [letter := set nextLetter]]
  13711.                                         ifFalse: [(legalSymbols includes: letter)
  13712.                                                 ifTrue: [letter := set nextLetter]
  13713.                                                 ifFalse: [errors := true]]]].
  13714.                     position := set currentPosition.
  13715.                     (aString at: currentLeft) isSeparator | errors ifFalse: [components add: (aString copyFrom: currentLeft to: position - 1)].
  13716.                     currentLeft := position]].
  13717.     errors
  13718.         ifTrue: [^nil]
  13719.         ifFalse: [^components]! !
  13720.  
  13721. !ParseTree class methodsFor: 'construction'!
  13722. orderIntoTree: components from: currentTTM 
  13723.     "Given a set of components that have just been 
  13724.     
  13725.     fissioned, we put them into a parse tree. Expressions 
  13726.     
  13727.     and statements are bound into ordered collections 
  13728.     
  13729.     called 'atoms'. Returns nil if there was an error. Else 
  13730.     
  13731.     it returns the parse tree."
  13732.  
  13733.     | currentStatement parseTree error set current |
  13734.     error := nil.
  13735.     parseTree := ParseTree new.
  13736.     parseTree initializeWith: currentTTM.
  13737.     set := Incrementer new.
  13738.     set startWith: components.
  13739.     current := set currentLetter.
  13740.     [current ~= $@ & (error = nil)]
  13741.         whileTrue: 
  13742.             [(parseTree isNotAtom: current)
  13743.                 ifFalse: 
  13744.                     [currentStatement := OrderedCollection new.
  13745.                     [current = $@ | (parseTree isNotAtom: current)]
  13746.                         whileFalse: 
  13747.                             [currentStatement add: current.
  13748.                             current := set nextLetter].
  13749.                     parseTree atom: currentStatement.
  13750.                     "error := parseTree error"].
  13751.             current ~= $@ & (error = nil)
  13752.                 ifTrue: 
  13753.                     [currentStatement := OrderedCollection new.
  13754.                     currentStatement add: current.
  13755.                     parseTree chooseEventFor: currentStatement.
  13756.                     "error := parseTree error."
  13757.                     current := set nextLetter]].
  13758.     error = nil
  13759.         ifTrue: [^parseTree]
  13760.         ifFalse: [^nil]! !
  13761.  
  13762. !ParseTree class methodsFor: 'construction'!
  13763. orderIntoTreeOld: components from: currentTTM 
  13764.     "Given a set of components that have just been 
  13765.     
  13766.     fissioned, we put them into a parse tree. Expressions 
  13767.     
  13768.     and statements are bound into ordered collections 
  13769.     
  13770.     called 'atoms'. Returns nil if there was an error. Else 
  13771.     
  13772.     it returns the parse tree."
  13773.  
  13774.     | currentStatement parseTree error set current |
  13775.     error := nil.
  13776.     parseTree := ParseTree new.
  13777.     parseTree initializeWith: currentTTM.
  13778.     set := Incrementer new.
  13779.     set startWith: components.
  13780.     current := set currentLetter.
  13781.     [current ~= $@ & (error = nil)]
  13782.         whileTrue: 
  13783.             [(parseTree isNotAtom: current)
  13784.                 ifFalse: 
  13785.                     [currentStatement := OrderedCollection new.
  13786.                     [current = $@ | (parseTree isNotAtom: current)]
  13787.                         whileFalse: 
  13788.                             [currentStatement add: current.
  13789.                             current := set nextLetter].
  13790.                     parseTree atom: currentStatement.
  13791.                     error := parseTree error].
  13792.             current ~= $@ & (error = nil)
  13793.                 ifTrue: 
  13794.                     [currentStatement := OrderedCollection new.
  13795.                     currentStatement add: current.
  13796.                     parseTree chooseEventFor: currentStatement.
  13797.                     error := parseTree error.
  13798.                     current := set nextLetter]].
  13799.     error = nil
  13800.         ifTrue: [^parseTree]
  13801.         ifFalse: [^nil]! !
  13802.  
  13803. Object subclass: #ParseElement
  13804.     instanceVariableNames: 'leftChild rightChild value '
  13805.     classVariableNames: ''
  13806.     poolDictionaries: ''
  13807.     category: 'Build'!
  13808.  
  13809. !ParseElement methodsFor: 'accessing'!
  13810. contents
  13811.  
  13812.      ^value! !
  13813.  
  13814. !ParseElement methodsFor: 'accessing'!
  13815. contents: newContents 
  13816.  
  13817.      value := newContents! !
  13818.  
  13819. !ParseElement methodsFor: 'accessing'!
  13820. left
  13821.  
  13822.      ^leftChild! !
  13823.  
  13824. !ParseElement methodsFor: 'accessing'!
  13825. left: newLeft 
  13826.  
  13827.      leftChild := newLeft! !
  13828.  
  13829. !ParseElement methodsFor: 'accessing'!
  13830. right
  13831.  
  13832.      ^rightChild! !
  13833.  
  13834. !ParseElement methodsFor: 'accessing'!
  13835. right: newRight
  13836.  
  13837.      rightChild := newRight! !
  13838.  
  13839. !ParseElement methodsFor: 'testing'!
  13840. isAtom
  13841.     "Return true if self is an atom and not a connector."
  13842.  
  13843.     value = 'LEFT' | (value = 'AND' | (value = 'OR' | (value = 'ROOT')))
  13844.         ifTrue: [^false]
  13845.         ifFalse: [^true]! !
  13846.  
  13847. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  13848.  
  13849. ParseElement class
  13850.     instanceVariableNames: ''!
  13851.  
  13852. !ParseElement class methodsFor: 'instance creation'!
  13853. contents: newContents left: newLeft right: newRight 
  13854.     "Create an instance of a parse element"
  13855.  
  13856.     | newElement |
  13857.     newElement := self new.
  13858.     newElement contents: newContents.
  13859.     newElement left: newLeft.
  13860.     newElement right: newRight.
  13861.     ^newElement! !
  13862.  
  13863. Model subclass: #QueryWindow
  13864.     instanceVariableNames: 'currentTTM table tableEntry tabs myCondition myTrList conditionList '
  13865.     classVariableNames: ''
  13866.     poolDictionaries: ''
  13867.     category: 'Build'!
  13868.  
  13869. !QueryWindow methodsFor: 'table access'!
  13870. addEntry
  13871.  
  13872.     table add: tableEntry! !
  13873.  
  13874. !QueryWindow methodsFor: 'table access'!
  13875. atTab: tabNumber put: aString 
  13876.  
  13877.     "At the supplied tab position insert aString into 
  13878.  
  13879.     the tableEntry."
  13880.  
  13881.  
  13882.  
  13883.     | start length allowedLength newString |
  13884.  
  13885.     start := tabs at: tabNumber.
  13886.  
  13887.     length := aString size.
  13888.  
  13889.     allowedLength := (tabs at: tabNumber + 1)
  13890.  
  13891.                 - (start + 1).
  13892.  
  13893.     length > allowedLength
  13894.  
  13895.         ifTrue: 
  13896.  
  13897.             [newString := aString copyFrom: 1 to: allowedLength.
  13898.  
  13899.             tableEntry
  13900.  
  13901.                 replaceFrom: start
  13902.  
  13903.                 to: start + allowedLength - 1
  13904.  
  13905.                 with: newString]
  13906.  
  13907.         ifFalse: [tableEntry
  13908.  
  13909.                 replaceFrom: start
  13910.  
  13911.                 to: start + length - 1
  13912.  
  13913.                 with: aString]! !
  13914.  
  13915. !QueryWindow methodsFor: 'table access'!
  13916. tableList
  13917.  
  13918.     "Return a list of the transition entries."
  13919.  
  13920.  
  13921.  
  13922.     ^table collect: [:currentEntry | currentEntry]! !
  13923.  
  13924. !QueryWindow methodsFor: 'initialize-release'!
  13925. initializeEntry
  13926.     tableEntry := ''.
  13927.     80 timesRepeat: [tableEntry := tableEntry , ' ']! !
  13928.  
  13929. !QueryWindow methodsFor: 'initialize-release'!
  13930. initializeTrList
  13931.  
  13932.     ^currentTTM transitionlist collect: [:item | item]! !
  13933.  
  13934. !QueryWindow methodsFor: 'initialize-release'!
  13935. initializeTTM: instanceOfTTM 
  13936.     "Prepare the TTM for displaying by initializing the 
  13937.     
  13938.     variables."
  13939.  
  13940.     currentTTM := instanceOfTTM.
  13941.     myCondition := String new.
  13942.     conditionList := OrderedCollection new.
  13943.     myTrList := self initializeTrList.
  13944.     table := OrderedCollection new.
  13945.     tabs := OrderedCollection new.
  13946.     tabs add: 1; add: 14; add: 39; add: 64; add: 72; add: 82.
  13947.     self initializeEntry.
  13948.     self processTransitions! !
  13949.  
  13950. !QueryWindow methodsFor: 'processing'!
  13951. breakdown: aGuard atTab: tabNumber 
  13952.  
  13953.     "We return a table of lines of the prescribed length."
  13954.  
  13955.  
  13956.  
  13957.     | guard prescribedLines allowedLength segment |
  13958.  
  13959.     guard := aGuard.
  13960.  
  13961.     prescribedLines := OrderedCollection new.
  13962.  
  13963.     allowedLength := (tabs at: tabNumber + 1)
  13964.  
  13965.                 - (tabs at: tabNumber) - 2.
  13966.  
  13967.     [guard size > allowedLength]
  13968.  
  13969.         whileTrue: 
  13970.  
  13971.             [segment := guard copyFrom: 1 to: allowedLength.
  13972.  
  13973.             prescribedLines add: segment.
  13974.  
  13975.             guard := guard copyFrom: allowedLength + 1 to: guard size].
  13976.  
  13977.     prescribedLines add: guard.
  13978.  
  13979.     ^prescribedLines! !
  13980.  
  13981. !QueryWindow methodsFor: 'processing'!
  13982. processTransitions
  13983.     | guard transformation guardLines functionLines extraLines name lower upper aTransitionCollection |
  13984.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  13985.     aTransitionCollection
  13986.         do: 
  13987.             [:x | 
  13988.             self initializeEntry.
  13989.             name := x myName.
  13990.             guard := x myGuard.
  13991.             transformation := x myAction.
  13992.             lower := x boundLower.
  13993.             upper := x boundUpper.
  13994.             self atTab: 1 put: name.
  13995.             guardLines := self breakdown: guard atTab: 2.
  13996.             self atTab: 2 put: (guardLines at: 1).
  13997.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  13998.             self atTab: 3 put: (functionLines at: 1).
  13999.             self atTab: 4 put: lower.
  14000.             self atTab: 5 put: upper.
  14001.             self addEntry.
  14002.             extraLines := 2.
  14003.             [extraLines > functionLines size & (extraLines > guardLines size)]
  14004.                 whileFalse: 
  14005.                     [self initializeEntry.
  14006.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  14007.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  14008.                     self addEntry.
  14009.                     extraLines := extraLines + 1]]! !
  14010.  
  14011. !QueryWindow methodsFor: 'processing'!
  14012. processTransitionsNew
  14013.     | guard transformation guardLines functionLines extraLines name lower upper aTransitionCollection |
  14014.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  14015.     aTransitionCollection
  14016.         do: 
  14017.             [:x | 
  14018.             self initializeEntry.
  14019.             name := x myName.
  14020.             guard := x myGuard.
  14021.             transformation := x myAction.
  14022.             lower := x boundLower.
  14023.             upper := x boundUpper.
  14024.             self atTab: 1 put: name.
  14025.             guardLines := self breakdown: guard atTab: 2.
  14026.             self atTab: 2 put: (guardLines at: 1).
  14027.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  14028.             self atTab: 3 put: (functionLines at: 1).
  14029.             self atTab: 4 put: lower.
  14030.             self atTab: 5 put: upper.
  14031.             self addEntry.
  14032.             extraLines := 2.
  14033.             [extraLines > functionLines size & (extraLines > guardLines size)]
  14034.                 whileFalse: 
  14035.                     [self initializeEntry.
  14036.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  14037.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  14038.                     self addEntry.
  14039.                     extraLines := extraLines + 1]]! !
  14040.  
  14041. !QueryWindow methodsFor: 'processing'!
  14042. processTransitionsOld
  14043.     | guard transformation trList guardLines functionLines extraLines shared count set name lower upper |
  14044.     trList := myTrList collect: [:element | element].
  14045.     [trList size > 0]
  14046.         whileTrue: 
  14047.             [shared := currentTTM transitionlist sharedTransitionsNamed: trList first myName.
  14048.             count := 1.
  14049.             [count > shared size]
  14050.                 whileFalse: 
  14051.                     [trList remove: (shared at: count)
  14052.                         ifAbsent: [].
  14053.                     count := count + 1].
  14054.             self initializeEntry.
  14055.             set := currentTTM processSharedTransitions: shared.
  14056.             name := set at: 1.
  14057.             guard := set at: 2.
  14058.             transformation := set at: 3.
  14059.             lower := set at: 4.
  14060.             upper := set at: 5.
  14061.             self atTab: 1 put: name.
  14062.             guardLines := self breakdown: guard atTab: 2.
  14063.             self atTab: 2 put: (guardLines at: 1).
  14064.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  14065.             self atTab: 3 put: (functionLines at: 1).
  14066.             self atTab: 4 put: lower.
  14067.             self atTab: 5 put: upper.
  14068.             self addEntry.
  14069.             extraLines := 2.
  14070.             [extraLines > functionLines size & (extraLines > guardLines size)]
  14071.                 whileFalse: 
  14072.                     [self initializeEntry.
  14073.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  14074.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  14075.                     self addEntry.
  14076.                     extraLines := extraLines + 1]]! !
  14077.  
  14078. !QueryWindow methodsFor: 'file out'!
  14079. openFileForWrite
  14080.     "Returns the stream in append mode or 
  14081.     
  14082.     returns nil if file could not be opened."
  14083.  
  14084.     | defaultName fileName aStream fullPath |
  14085.     defaultName := currentTTM named asString , '.qry'.
  14086.     fileName := DialogView request: 'file name to write out as?' initialAnswer: defaultName.
  14087.     fileName isEmpty
  14088.         ifTrue: 
  14089.             [TTMList speak: 'No filename given - generation aborted.'.
  14090.             aStream := nil]
  14091.         ifFalse: 
  14092.             [fullPath := (Filename named: currentTTM getDirectory)
  14093.                         constructString: fileName.
  14094.             aStream := (Filename named: fullPath) appendStream].
  14095.     ^aStream! !
  14096.  
  14097. !QueryWindow methodsFor: 'constraints'!
  14098. commandFor: operator with: argument 
  14099.  
  14100.     "We determine if it is a valid operator, o, and a 
  14101.  
  14102.     valid argument. If so, we do the command."
  14103.  
  14104.  
  14105.  
  14106.     | c newList n o |
  14107.  
  14108.     c := nil.
  14109.  
  14110.     o := operator asLowercase.
  14111.  
  14112.     o = 'named' | (o = 'n')
  14113.  
  14114.         ifTrue: 
  14115.  
  14116.             [c := 'named'.
  14117.  
  14118.             newList := self wildcardSearch: myTrList for: argument].
  14119.  
  14120.     o = 'sourcein' | (o = 'si')
  14121.  
  14122.         ifTrue: 
  14123.  
  14124.             [c := 'source within'.
  14125.  
  14126.             newList := self
  14127.  
  14128.                         transitionsOf: myTrList
  14129.  
  14130.                         within: argument
  14131.  
  14132.                         usedAs: #source].
  14133.  
  14134.     o = 'destinationin' | (o = 'destin' | (o = 'di'))
  14135.  
  14136.         ifTrue: 
  14137.  
  14138.             [c := 'destination within'.
  14139.  
  14140.             newList := self
  14141.  
  14142.                         transitionsOf: myTrList
  14143.  
  14144.                         within: argument
  14145.  
  14146.                         usedAs: #destination].
  14147.  
  14148.     o = 'source' | (o = 's')
  14149.  
  14150.         ifTrue: 
  14151.  
  14152.             [c := 'source'.
  14153.  
  14154.             newList := myTrList select: [:transition | transition startingAt myName = argument]].
  14155.  
  14156.     o = 'destination' | (o = 'dest' | (o = 'd'))
  14157.  
  14158.         ifTrue: 
  14159.  
  14160.             [c := 'destination'.
  14161.  
  14162.             newList := myTrList select: [:transition | transition endingAt myName = argument]].
  14163.  
  14164.     o = 'lower' | (o = 'l') ifTrue: [(TTMList aValidNumber: argument)
  14165.  
  14166.             & (argument ~= 'infinity')
  14167.  
  14168.             ifTrue: 
  14169.  
  14170.                 [c := 'lower'.
  14171.  
  14172.                 n := TTMList convertToNumber: argument.
  14173.  
  14174.                 newList := myTrList select: [:transition | (TTMList convertToNumber: transition boundLower asString)
  14175.  
  14176.                                 >= n]]].
  14177.  
  14178.     o = 'upper' | (o = 'u') ifTrue: [(TTMList aValidNumber: argument)
  14179.  
  14180.             ifTrue: 
  14181.  
  14182.                 [c := 'upper'.
  14183.  
  14184.                 argument = 'infinity'
  14185.  
  14186.                     ifTrue: [newList := myTrList]
  14187.  
  14188.                     ifFalse: 
  14189.  
  14190.                         [n := TTMList convertToNumber: argument.
  14191.  
  14192.                         newList := myTrList select: [:transition | transition boundUpper asString ~= 'infinity' & ((TTMList convertToNumber: transition boundUpper asString)
  14193.  
  14194.                                             <= n)]]]].
  14195.  
  14196.     o = 'finite' | (o = 'f')
  14197.  
  14198.         ifTrue: 
  14199.  
  14200.             [c := 'finite upper bounds'.
  14201.  
  14202.             newList := myTrList select: [:transition | transition boundUpper asString ~= 'infinity']].
  14203.  
  14204.     o = 'infinite' | (o = 'i')
  14205.  
  14206.         ifTrue: 
  14207.  
  14208.             [c := 'infinite upper bounds'.
  14209.  
  14210.             newList := myTrList select: [:transition | transition boundUpper asString = 'infinity']].
  14211.  
  14212.     o = 'contains' | (o = 'c')
  14213.  
  14214.         ifTrue: 
  14215.  
  14216.             [c := 'contains'.
  14217.  
  14218.             newList := myTrList select: [:transition | transition containsThis: argument]].
  14219.  
  14220.     c notNil
  14221.  
  14222.         ifTrue: [^newList]
  14223.  
  14224.         ifFalse: [^nil]! !
  14225.  
  14226. !QueryWindow methodsFor: 'constraints'!
  14227. parseConstraint
  14228.     "Remove extraneous characters from constraint, 
  14229.     
  14230.     break it into component predicates, then evaluate 
  14231.     
  14232.     each of the predicates."
  14233.  
  14234.     | pieces candidate current logicalOr newTrList count err currentCommand supplement c |
  14235.     pieces := OrderedCollection new.
  14236.     newTrList := OrderedCollection new.
  14237.     candidate := TTMList removeAllBlanksFrom: myCondition.
  14238.     candidate isEmpty
  14239.         ifFalse: 
  14240.             [current := 1.
  14241.             logicalOr := candidate findString: ';' startingAt: current.
  14242.             [logicalOr ~= 0 & (current > candidate size) not]
  14243.                 whileTrue: 
  14244.                     [pieces add: (candidate copyFrom: current to: logicalOr - 1).
  14245.                     current := logicalOr + 1.
  14246.                     current > candidate size ifFalse: [logicalOr := candidate findString: ';' startingAt: current]].
  14247.             current > candidate size ifFalse: [pieces add: (candidate copyFrom: current to: candidate size)]].
  14248.     count := 1.
  14249.     err := false.
  14250.     pieces size ~= 0
  14251.         ifTrue: 
  14252.             [[count <= pieces size & (err = false)]
  14253.                 whileTrue: 
  14254.                     [currentCommand := pieces at: count.
  14255.                     supplement := self processConstraint: currentCommand.
  14256.                     supplement isNil
  14257.                         ifTrue: [err := true]
  14258.                         ifFalse: 
  14259.                             [c := 1.
  14260.                             [c > supplement size]
  14261.                                 whileFalse: 
  14262.                                     [(newTrList includes: (supplement at: c))
  14263.                                         ifFalse: [newTrList add: (supplement at: c)].
  14264.                                     c := c + 1]].
  14265.                     count := count + 1].
  14266.             err = false
  14267.                 ifTrue: 
  14268.                     [myTrList := newTrList.
  14269.                     conditionList add: candidate.
  14270.                     table := OrderedCollection new.
  14271.                     self processTransitions.
  14272.                     self changed: #tableTransaction]]! !
  14273.  
  14274. !QueryWindow methodsFor: 'constraints'!
  14275. processConstraint: candidate 
  14276.  
  14277.     | err start end operator argument newList |
  14278.  
  14279.     err := false.
  14280.  
  14281.     start := candidate findString: '(' startingAt: 1.
  14282.  
  14283.     end := candidate findString: ')' startingAt: 1.
  14284.  
  14285.     start >= end | (start = 0 | (end = 0 | (end ~= candidate size))) ifTrue: [err := true].
  14286.  
  14287.     err = false
  14288.  
  14289.         ifTrue: 
  14290.  
  14291.             [operator := (candidate copyFrom: 1 to: start - 1) asString.
  14292.  
  14293.             operator = 'finite' | (operator = 'f' | (operator = 'infinite' | (operator = 'i')))
  14294.  
  14295.                 ifTrue: [argument := '']
  14296.  
  14297.                 ifFalse: [end - 1 >= (start + 1)
  14298.  
  14299.                         ifTrue: [argument := (candidate copyFrom: start + 1 to: end - 1) asString]
  14300.  
  14301.                         ifFalse: [err := true]].
  14302.  
  14303.             err = false
  14304.  
  14305.                 ifTrue: 
  14306.  
  14307.                     [newList := self commandFor: operator with: argument.
  14308.  
  14309.                     newList isNil
  14310.  
  14311.                         ifTrue: [err := true]
  14312.  
  14313.                         ifFalse: [^newList]]].
  14314.  
  14315.     err = true
  14316.  
  14317.         ifTrue: 
  14318.  
  14319.             [TTMList speak: 'Syntax error in constraint'.
  14320.  
  14321.             ^nil]! !
  14322.  
  14323. !QueryWindow methodsFor: 'private'!
  14324. setOfActivitiesFrom: activityName 
  14325.  
  14326.      "Return the set of all activities that have an 
  14327.  
  14328.      ancestor activity with the name, activityName."
  14329.  
  14330.  
  14331.  
  14332.      | total count focus c s |
  14333.  
  14334.      total := currentTTM activitytree listOfActivities.
  14335.  
  14336.      focus := OrderedCollection new.
  14337.  
  14338.      count := 1.
  14339.  
  14340.      [count > total size]
  14341.  
  14342.           whileFalse: 
  14343.  
  14344.                [(total at: count) myName = activityName
  14345.  
  14346.                     ifTrue: 
  14347.  
  14348.                          [s := currentTTM activitytree
  14349.  
  14350. listChildrenOf: (total at: count).
  14351.  
  14352.                          c := 1.
  14353.  
  14354.                          [c > s size]
  14355.  
  14356.                               whileFalse: 
  14357.  
  14358.                                    [focus add: (s at: c).
  14359.  
  14360.                                    c := c + 1]].
  14361.  
  14362.                count := count + 1].
  14363.  
  14364.      ^focus! !
  14365.  
  14366. !QueryWindow methodsFor: 'private'!
  14367. transitionsOf: aList within: activity usedAs: directionType 
  14368.  
  14369.     | set newList count node s c |
  14370.  
  14371.     set := self setOfActivitiesFrom: activity.
  14372.  
  14373.     newList := OrderedCollection new.
  14374.  
  14375.     set size ~= 0
  14376.  
  14377.         ifTrue: 
  14378.  
  14379.             [count := 1.
  14380.  
  14381.             [count > set size]
  14382.  
  14383.                 whileFalse: 
  14384.  
  14385.                     [node := set at: count.
  14386.  
  14387.                     directionType = #source ifTrue: [s := aList select: [:transition | transition startingAt = node]].
  14388.  
  14389.                     directionType = #destination ifTrue: [s := aList select: [:transition | transition endingAt = node]].
  14390.  
  14391.                     directionType = #both ifTrue: [s := aList select: [:transition | transition startingAt = node | (transition endingAt = node)]].
  14392.  
  14393.                     c := 1.
  14394.  
  14395.                     [c > s size]
  14396.  
  14397.                         whileFalse: 
  14398.  
  14399.                             [newList isEmpty
  14400.  
  14401.                                 ifTrue: [newList add: (s at: c)]
  14402.  
  14403.                                 ifFalse: [(newList includes: (s at: c))
  14404.  
  14405.                                         ifFalse: [newList add: (s at: c)]].
  14406.  
  14407.                             c := c + 1].
  14408.  
  14409.                     count := count + 1]].
  14410.  
  14411.     newList isEmpty
  14412.  
  14413.         ifTrue: [^nil]
  14414.  
  14415.         ifFalse: [^newList]! !
  14416.  
  14417. !QueryWindow methodsFor: 'private'!
  14418. wildcardSearch: aList for: argument 
  14419.  
  14420.     | newList asterix1 a |
  14421.  
  14422.     newList := OrderedCollection new.
  14423.  
  14424.     asterix1 := argument findString: '*' startingAt: 1.
  14425.  
  14426.     asterix1 = 0
  14427.  
  14428.         ifTrue: [newList := aList select: [:transition | transition myName = argument]]
  14429.  
  14430.         ifFalse: 
  14431.  
  14432.             [argument size = 1 ifTrue: [^aList].
  14433.  
  14434.             asterix1 = 1
  14435.  
  14436.                 ifTrue: 
  14437.  
  14438.                     [a := argument copyFrom: 2 to: argument size.
  14439.  
  14440.                     newList := aList select: [:transition | (transition myName copyFrom: transition myName size - a size + 1 to: transition myName size)
  14441.  
  14442.                                     = a]].
  14443.  
  14444.             asterix1 = argument size
  14445.  
  14446.                 ifTrue: 
  14447.  
  14448.                     [a := argument copyFrom: 1 to: argument size - 1.
  14449.  
  14450.                     newList := aList select: [:transition | (transition myName copyFrom: 1 to: a size)
  14451.  
  14452.                                     = a]]].
  14453.  
  14454.     newList isEmpty
  14455.  
  14456.         ifTrue: [^nil]
  14457.  
  14458.         ifFalse: [^newList]! !
  14459.  
  14460. !QueryWindow methodsFor: 'button access'!
  14461. doAddConstraint
  14462.  
  14463.     | candidate |
  14464.  
  14465.     candidate := DialogView request: 'Type in a constraint on the table:'.
  14466.  
  14467.     candidate isEmpty ifTrue: [^self].
  14468.  
  14469.     myCondition := candidate asString.
  14470.  
  14471.     self parseConstraint! !
  14472.  
  14473. !QueryWindow methodsFor: 'button access'!
  14474. doClearConstraints
  14475.     table := OrderedCollection new.
  14476.     myTrList := self initializeTrList.
  14477.     self processTransitions.
  14478.     conditionList := OrderedCollection new.
  14479.     myCondition := String new.
  14480.     self changed: #cList.
  14481.     self changed: #tableTransaction! !
  14482.  
  14483. !QueryWindow methodsFor: 'button access'!
  14484. doListConstraints
  14485.  
  14486.     conditionList isEmpty ifFalse: [(PopUpMenu labelList: (Array with: conditionList)) startUp]! !
  14487.  
  14488. !QueryWindow methodsFor: 'button access'!
  14489. doOutput
  14490.     | aStream myTable low high ans1 ans3 ans2 c currentIC |
  14491.     aStream := self openFileForWrite.
  14492.     aStream isNil ifTrue: [^nil].
  14493.     ans1 := DialogView confirm: 'Include title and notepad?'.
  14494.     ans1 = true
  14495.         ifTrue: 
  14496.             [currentTTM fileTitle: 'Description of TTM: ' , currentTTM named on: aStream.
  14497.             currentTTM fileNotePadOn: aStream].
  14498.     conditionList isEmpty
  14499.         ifTrue: [ans2 := false]
  14500.         ifFalse: 
  14501.             [ans2 := DialogView confirm: 'Include constraints used?'.
  14502.             ans2 = true
  14503.                 ifTrue: 
  14504.                     [currentTTM fileHeading: 'Constraints used:' on: aStream.
  14505.                     currentTTM fileThis: conditionList on: aStream]].
  14506.     ans3 := DialogView confirm: 'Include additional info?'.
  14507.     ans3 = true | (ans2 = true) ifTrue: [currentTTM fileHeading: 'List Of Transitions:' on: aStream].
  14508.     table := OrderedCollection new.
  14509.     self initializeEntry.
  14510.     self atTab: 1 put: 'Transition:'.
  14511.     self atTab: 2 put: 'Guard:'.
  14512.     self atTab: 3 put: 'Function:'.
  14513.     self atTab: 4 put: 'Lower:'.
  14514.     self atTab: 5 put: 'Upper:'.
  14515.     self addEntry.
  14516.     self initializeEntry.
  14517.     self atTab: 1 put: '-----------'.
  14518.     self atTab: 2 put: '------'.
  14519.     self atTab: 3 put: '---------'.
  14520.     self atTab: 4 put: '------'.
  14521.     self atTab: 5 put: '------'.
  14522.     self addEntry.
  14523.     currentTTM fileThis: table on: aStream.
  14524.     table := OrderedCollection new.
  14525.     self processTransitions.
  14526.     currentTTM fileThis: table on: aStream.
  14527.     ans3 = true
  14528.         ifTrue: 
  14529.             [currentTTM fileHeading: 'Activity Variables:' on: aStream.
  14530.             myTable := currentTTM activityvariable collect: [:existingAV | ' ' , (existingAV at: 1)].
  14531.             currentTTM fileThis: myTable on: aStream.
  14532.             currentTTM fileHeading: 'Data Variables:' on: aStream.
  14533.             low := ' low: '.
  14534.             high := ' high: '.
  14535.             myTable := currentTTM datavariable collect: [:existingDV | ' ' , (existingDV at: 1) , low , (existingDV at: 2) , high , (existingDV at: 3)].
  14536.             currentTTM fileThis: myTable on: aStream.
  14537.             currentTTM fileHeading: 'Communication Channels:' on: aStream.
  14538.             myTable := currentTTM commchannel collect: [:existingCH | ' ' , (existingCH at: 1)].
  14539.             currentTTM fileThis: myTable on: aStream.
  14540.             currentTTM fileHeading: 'Initial Condition:' on: aStream.
  14541.             myTable := OrderedCollection new.
  14542.             c := TTMList removeAllBlanksFrom: currentTTM initialcondition.
  14543.             myTable add: ' ' , c.
  14544.             currentTTM fileThis: myTable on: aStream.
  14545.             currentTTM specificIC size ~= 0
  14546.                 ifTrue: 
  14547.                     [currentTTM fileHeading: 'Specific Initial Conditions:' on: aStream.
  14548.                     c := 1.
  14549.                     [c > currentTTM specificIC size]
  14550.                         whileFalse: 
  14551.                             [myTable := OrderedCollection new.
  14552.                             myTable add: ' Initial Condition # ' , ((currentTTM specificIC at: c)
  14553.                                         at: 1).
  14554.                             currentTTM fileThis: myTable on: aStream.
  14555.                             currentIC := (currentTTM specificIC at: c)
  14556.                                         at: 2.
  14557.                             currentTTM fileThis: (currentIC collect: [:item | ' ' , (item at: 1) , '=' , (item at: 2)])
  14558.                                 on: aStream.
  14559.                             c := c + 1]]].
  14560.                 aStream close! !
  14561.  
  14562. !QueryWindow methodsFor: 'closing'!
  14563. removeDependent: aDependent 
  14564.  
  14565.     currentTTM openWindows at: 3 put: 0.
  14566.  
  14567.     super removeDependent: aDependent! !
  14568.  
  14569. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  14570.  
  14571. QueryWindow class
  14572.     instanceVariableNames: ''!
  14573.  
  14574. !QueryWindow class methodsFor: 'instance creation'!
  14575. newTable: ttm
  14576.  
  14577.  
  14578.  
  14579.    ^super new initializeTTM: ttm! !
  14580.  
  14581. !QueryWindow class methodsFor: 'instance creation'!
  14582. openTable: ttm
  14583.  
  14584.  
  14585.  
  14586.    self openTable: (self newTable: ttm) for: ttm! !
  14587.  
  14588. !QueryWindow class methodsFor: 'instance creation'!
  14589. openTable: aTransitionTable for: ttm 
  14590.     | window container tableView tempString tableLabel left top hsize vsize iButton myWrapper cButton aButton heButton lButton qButton |
  14591.     window := ScheduledWindow new.
  14592.     tableLabel := 'Querying TTM: ' , ttm named.
  14593.     window label: tableLabel.
  14594.     window minimumSize: 600 @ 400.
  14595.     window insideColor: ColorValue white.
  14596.     container := CompositePart new.
  14597.     (container add: ' ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  14598.         insideColor: ColorValue white.
  14599.     tableView := AlteredTableView
  14600.                 on: aTransitionTable
  14601.                 aspect: #tableTransaction
  14602.                 list: #tableList.
  14603.     myWrapper := self wrap: (LookPreferences edgeDecorator on: tableView).
  14604.     container add: myWrapper borderedIn: (0.0 @ 0.05 extent: 1.0 @ 0.9).
  14605.     tempString := ComposedText withText: ' Transition:  Guard:                   Function:                   Lower:     Upper:' style: (TextAttributes styleNamed: #fixed).
  14606.     self labelWrap: (container add: tempString borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05)).
  14607.     left := 0.
  14608.     top := 0.95.
  14609.     hsize := 0.2133.
  14610.     vsize := 0.05.
  14611.     aButton := PushButton named: 'Add A Constraint'.
  14612.     aButton model: ((PluggableAdaptor on: aTransitionTable)
  14613.             getBlock: [:model | false]
  14614.             putBlock: [:model :value | model doAddConstraint]
  14615.             updateBlock: [:model :value :parameter | false]).
  14616.     (container add: aButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  14617.         insideColor: ColorValue white.
  14618.     left := left + hsize.
  14619.     cButton := PushButton named: 'Clear Constraints'.
  14620.     cButton model: ((PluggableAdaptor on: aTransitionTable)
  14621.             getBlock: [:model | false]
  14622.             putBlock: [:model :value | model doClearConstraints]
  14623.             updateBlock: [:model :value :parameter | false]).
  14624.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  14625.         insideColor: ColorValue white.
  14626.     left := left + hsize.
  14627.     lButton := PushButton named: 'List Constraints'.
  14628.     lButton model: ((PluggableAdaptor on: aTransitionTable)
  14629.             getBlock: [:model | false]
  14630.             putBlock: [:model :value | model doListConstraints]
  14631.             updateBlock: [:model :value :parameter | false]).
  14632.     (container add: lButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  14633.         insideColor: ColorValue white.
  14634.     left := left + hsize.
  14635.     iButton := PushButton named: 'File Out'.
  14636.     iButton model: ((PluggableAdaptor on: aTransitionTable)
  14637.             getBlock: [:model | false]
  14638.             putBlock: [:model :value | model doOutput]
  14639.             updateBlock: [:model :value :parameter | false]).
  14640.     (container add: iButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  14641.         insideColor: ColorValue white.
  14642.     left := left + 0.12.
  14643.     qButton := PushButton named: 'Exit'.
  14644.     qButton model: ((PluggableAdaptor on: aTransitionTable)
  14645.             getBlock: [:model | false]
  14646.             putBlock: [:model :value | TTMList closeWindow: 3 in: ttm]
  14647.             updateBlock: [:model :value :parameter | false]).
  14648.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  14649.         insideColor: ColorValue white.
  14650.     left := left + 0.12.
  14651.     heButton := PushButton named: 'Help' asText allBold.
  14652.     heButton model: ((PluggableAdaptor on: aTransitionTable)
  14653.             getBlock: [:model | false]
  14654.             putBlock: [:model :value | HelpScreens openHelp: 'querying']
  14655.             updateBlock: [:model :value :parameter | false]).
  14656.     (container add: heButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  14657.         insideColor: ColorValue white.
  14658.     window component: container.
  14659.     window open! !
  14660.  
  14661. !QueryWindow class methodsFor: 'decoration'!
  14662. labelWrap: aLabel 
  14663.  
  14664.      | newLabel |
  14665.  
  14666.      newLabel := aLabel.
  14667.  
  14668.      newLabel insideColor: ColorValue white.
  14669.  
  14670.      newLabel borderColor: ColorValue black.
  14671.  
  14672.      newLabel borderWidth: 1.
  14673.  
  14674.      ^newLabel! !
  14675.  
  14676. !QueryWindow class methodsFor: 'decoration'!
  14677. wrap: aWrapper 
  14678.  
  14679.      | newWrapper |
  14680.  
  14681.      newWrapper := aWrapper.
  14682.  
  14683.      newWrapper noMenuBar.
  14684.  
  14685.      "newWrapper borderColor: ColorValue black."
  14686.  
  14687.      "newWrapper borderWidth: 1."
  14688.  
  14689.      "newWrapper insideColor: ColorValue white."
  14690.  
  14691.      ^newWrapper! !
  14692.  
  14693. SequenceableCollection subclass: #ActivityTree
  14694.     instanceVariableNames: 'root parent '
  14695.     classVariableNames: ''
  14696.     poolDictionaries: ''
  14697.     category: 'Build'!
  14698.  
  14699. !ActivityTree methodsFor: 'testing'!
  14700. ancestorOf: lower onLevelOf: upper 
  14701.     | ancestorList count found |
  14702.     ancestorList := self ancestorListOf: lower.
  14703.     count := ancestorList size.
  14704.     found := false.
  14705.     [count > 0 & (found = false)]
  14706.         whileTrue: 
  14707.             [found := self is: upper aBrotherOf: (ancestorList at: count).
  14708.             found = false ifTrue: [count := count - 1]].
  14709.     found = true ifTrue: [^ancestorList at: count].
  14710.     ^nil! !
  14711.  
  14712. !ActivityTree methodsFor: 'testing'!
  14713. is: activity1 above: activity2 
  14714.  
  14715.      ^(self ancestorListOf: activity1) size < (self
  14716.  
  14717. ancestorListOf: activity2) size! !
  14718.  
  14719. !ActivityTree methodsFor: 'testing'!
  14720. is: activity1 aBrotherOf: activity2 
  14721.     | sibling |
  14722.     activity1 = activity2 ifTrue: [^true].
  14723.     sibling := (self parentOf: activity1) left.
  14724.     [sibling notNil]
  14725.         whileTrue: 
  14726.             [sibling = activity2 ifTrue: [^true].
  14727.             sibling := sibling right].
  14728.     ^false! !
  14729.  
  14730. !ActivityTree methodsFor: 'testing'!
  14731. is: aPossibleParent anAncestorOf: anActivity 
  14732.  
  14733.      (self isRoot: anActivity)
  14734.  
  14735.           ifTrue: [^false]
  14736.  
  14737.           ifFalse: [^(self ancestorListOf: anActivity)
  14738.  
  14739.                     includes: aPossibleParent]! !
  14740.  
  14741. !ActivityTree methodsFor: 'testing'!
  14742. is: activity1 concurrentWith: activity2 
  14743.     "Return true if the two activities run 
  14744.     
  14745.     concurrently with each other."
  14746.  
  14747.     | ancestorsOf1 ancestorsOf2 count1 currentAncestor1 |
  14748.     ancestorsOf1 := self ancestorListOf: activity1.
  14749.     ancestorsOf1 removeLast.
  14750.     ancestorsOf2 := self ancestorListOf: activity2.
  14751.     ancestorsOf2 removeLast.
  14752.     ancestorsOf1 size = 0 | (ancestorsOf2 size = 0) ifTrue: [^false].
  14753.     count1 := ancestorsOf1 size.
  14754.     [count1 > 0]
  14755.         whileTrue: 
  14756.             [currentAncestor1 := ancestorsOf1 at: count1.
  14757.             (ancestorsOf2 includes: currentAncestor1)
  14758.                 & (currentAncestor1 collectionType ~= #cluster) ifTrue: [^true].
  14759.             (ancestorsOf2 includes: currentAncestor1)
  14760.                 & (currentAncestor1 collectionType = #cluster) ifTrue: [^false].
  14761.             count1 := count1 - 1].
  14762.     ^false! !
  14763.  
  14764. !ActivityTree methodsFor: 'testing'!
  14765. isConcurrentProcess: activity1 
  14766.     "Return true if the activity1 is a concurrent 
  14767.     
  14768.     process; that is, it possibly has cousins 
  14769.     
  14770.     running at the same time as it. Does NOT 
  14771.     
  14772.     look at itself."
  14773.  
  14774.     | ancestorsOf1 count1 currentAncestor1 |
  14775.     ancestorsOf1 := self ancestorListOf: activity1.
  14776.     ancestorsOf1 removeLast.
  14777.     ancestorsOf1 size = 0 ifTrue: [^false].
  14778.     count1 := ancestorsOf1 size.
  14779.     [count1 > 0]
  14780.         whileTrue: 
  14781.             [currentAncestor1 := ancestorsOf1 at: count1.
  14782.             currentAncestor1 collectionType ~= #cluster ifTrue: [^true].
  14783.             count1 := count1 - 1].
  14784.     ^false! !
  14785.  
  14786. !ActivityTree methodsFor: 'testing'!
  14787. isEmpty
  14788.     "Is the tree empty?"
  14789.  
  14790.     ^root isNil! !
  14791.  
  14792. !ActivityTree methodsFor: 'testing'!
  14793. isRoot: candidate
  14794.  
  14795.      "Is the given activity the root?"
  14796.  
  14797.  
  14798.  
  14799.      ^root = candidate! !
  14800.  
  14801. !ActivityTree methodsFor: 'accessing'!
  14802. activityNames
  14803.     ^self listOfActivities collect: [:x | x myName]! !
  14804.  
  14805. !ActivityTree methodsFor: 'accessing'!
  14806. allImmediateChildrenOf: anActivity 
  14807.     | temp sibling |
  14808.     temp := OrderedCollection new.
  14809.     sibling := anActivity left.
  14810.     [sibling notNil]
  14811.         whileTrue: 
  14812.             [temp add: sibling.
  14813.             sibling := sibling right].
  14814.     ^temp! !
  14815.  
  14816. !ActivityTree methodsFor: 'accessing'!
  14817. allSiblingsOf: anActivity 
  14818.     "inclusive"
  14819.  
  14820.     | temp sibling p |
  14821.     temp := OrderedCollection new.
  14822.     p := self parentOf: anActivity.
  14823.     sibling := p left.
  14824.     [sibling notNil]
  14825.         whileTrue: 
  14826.             [temp add: sibling.
  14827.             sibling := sibling right].
  14828.     ^temp! !
  14829.  
  14830. !ActivityTree methodsFor: 'accessing'!
  14831. ancestorListOf: anActivity 
  14832.     | current ancestors temp |
  14833.     current := anActivity.
  14834.     ancestors := OrderedCollection new.
  14835.     [current notNil]
  14836.         whileTrue: 
  14837.             [temp := current.
  14838.             current := self parentOf: temp.
  14839.             current notNil ifTrue: [current collectionType = #cluster ifTrue: [ancestors addFirst: temp]]].
  14840.     ^ancestors! !
  14841.  
  14842. !ActivityTree methodsFor: 'accessing'!
  14843. ancestorListOfsafe: anActivity 
  14844.     | current ancestors |
  14845.     current := anActivity.
  14846.     ancestors := OrderedCollection new.
  14847.     [current notNil]
  14848.         whileTrue: 
  14849.             [ancestors addFirst: current.
  14850.             current := self parentOf: current].
  14851.     ^ancestors! !
  14852.  
  14853. !ActivityTree methodsFor: 'accessing'!
  14854. currentDefaultOf: parentActivity 
  14855.     "Return the current default of the given activity"
  14856.  
  14857.     | default child |
  14858.     default := nil.
  14859.     child := parentActivity left.
  14860.     [child notNil]
  14861.         whileTrue: 
  14862.             [child default = true ifTrue: [default := child].
  14863.             child := child right].
  14864.     ^default! !
  14865.  
  14866. !ActivityTree methodsFor: 'accessing'!
  14867. getRoot
  14868.  
  14869.      self emptyCheck.
  14870.  
  14871.      ^root! !
  14872.  
  14873. !ActivityTree methodsFor: 'accessing'!
  14874. listChildrenOf: aParent 
  14875.     "Return an OrderedCollection of activities 
  14876.     
  14877.     stemming from aParent & incl. aParent"
  14878.  
  14879.     parent := OrderedCollection new.
  14880.     parent add: aParent.
  14881.     aParent left notNil ifTrue: [self listChildrenFrom: aParent left].
  14882.     ^parent! !
  14883.  
  14884. !ActivityTree methodsFor: 'accessing'!
  14885. listOfActivities
  14886.     parent := OrderedCollection new.
  14887.     self copyList: self getRoot.
  14888.     ^parent! !
  14889.  
  14890. !ActivityTree methodsFor: 'accessing'!
  14891. listOnlyChildrenOf: aParent 
  14892.     "Return an OrderedCollection of activities 
  14893.     
  14894.     stemming from aParent & incl. aParent"
  14895.  
  14896.     parent := OrderedCollection new.
  14897.     
  14898.     aParent left notNil ifTrue: [self listChildrenFrom: aParent left].
  14899.     ^parent! !
  14900.  
  14901. !ActivityTree methodsFor: 'accessing'!
  14902. newRoot: myroot 
  14903.  
  14904.      root := myroot! !
  14905.  
  14906. !ActivityTree methodsFor: 'accessing'!
  14907. parentOf: currentElement 
  14908.     | brother |
  14909.     root = nil
  14910.         ifTrue: [^nil]
  14911.         ifFalse: 
  14912.             [parent := nil.
  14913.             currentElement = root
  14914.                 ifTrue: [^nil]
  14915.                 ifFalse: 
  14916.                     [self parentOf: currentElement startingAt: root.
  14917.                     parent right = currentElement
  14918.                         ifTrue: 
  14919.                             [brother := parent.
  14920.                             parent := nil.
  14921.                             self parentOf: brother startingAt: root.
  14922.                             [parent right = brother]
  14923.                                 whileTrue: 
  14924.                                     [brother := parent.
  14925.                                     parent := nil.
  14926.                                     self parentOf: brother startingAt: root].
  14927.                             ^parent]
  14928.                         ifFalse: [^parent]]]! !
  14929.  
  14930. !ActivityTree methodsFor: 'accessing'!
  14931. relateLevelOf: activity1 to: activity2 
  14932.     "Given two activities return level relation 
  14933.     
  14934.     between them; activity 1 is either ABOVE 
  14935.     
  14936.     activity2, BELOW activity2, or SAME as 
  14937.     
  14938.     activity2"
  14939.  
  14940.     | ancestorsOf1 ancestorsOf2 |
  14941.     ancestorsOf1 := self ancestorListOf: activity1.
  14942.     ancestorsOf2 := self ancestorListOf: activity2.
  14943.     ancestorsOf1 size = ancestorsOf2 size ifTrue: [^'SAME'].
  14944.     ancestorsOf1 size < ancestorsOf2 size ifTrue: [^'ABOVE'].
  14945.     ancestorsOf1 size > ancestorsOf2 size ifTrue: [^'BELOW']! !
  14946.  
  14947. !ActivityTree methodsFor: 'accessing'!
  14948. size
  14949.     "Return the size of the tree. If the tree is empty, return      
  14950.     zero, else      
  14951.     get the size using the root as the current Node and the Node      
  14952.     method      
  14953.     called, size."
  14954.  
  14955.     self isEmpty
  14956.         ifTrue: [^0]
  14957.         ifFalse: [^root size]! !
  14958.  
  14959. !ActivityTree methodsFor: 'adding'!
  14960. addChildTo: existingNode 
  14961.     "Make the newNode a child of the existing node. If the 
  14962.     
  14963.     existing node 
  14964.     
  14965.     already has children, we make the new node the rightmost 
  14966.     
  14967.     sibling of the existing children."
  14968.  
  14969.     | child activityName newNode |
  14970.     activityName := DialogView request: 'New activity name?'.
  14971.     activityName isEmpty
  14972.         ifTrue: [^nil]
  14973.         ifFalse: 
  14974.             [newNode := Activity
  14975.                         name: activityName
  14976.                         collectAs: #cluster
  14977.                         left: nil
  14978.                         right: nil.
  14979.             newNode parent: existingNode.
  14980.             child := existingNode left.
  14981.             child isNil
  14982.                 ifTrue: [existingNode left: newNode]
  14983.                 ifFalse: [self addSibling: newNode to: child].
  14984.             ^newNode]! !
  14985.  
  14986. !ActivityTree methodsFor: 'adding'!
  14987. addChildTo: existingNode withName: activityName 
  14988.     "Make the newNode a child of the existing node. If the 
  14989.     
  14990.     existing node 
  14991.     
  14992.     already has children, we make the new node the rightmost 
  14993.     
  14994.     sibling of the existing children."
  14995.  
  14996.     | child newNode |
  14997.     newNode := Activity
  14998.                 name: activityName
  14999.                 collectAs: #cluster
  15000.                 left: nil
  15001.                 right: nil.
  15002.      newNode parent: existingNode.
  15003.     child := existingNode left.
  15004.     child isNil
  15005.         ifTrue: 
  15006.             [newNode default: true.
  15007.             existingNode left: newNode]
  15008.         ifFalse: [self addSibling: newNode to: child].
  15009.     ^newNode! !
  15010.  
  15011. !ActivityTree methodsFor: 'adding'!
  15012. addCreatedNode: newNode to: existingNode 
  15013.     "Make the newNode a child of the existing node. If the 
  15014.     
  15015.     existing node 
  15016.     
  15017.     already has children, we make the new node the rightmost 
  15018.     
  15019.     sibling of the existing children."
  15020.  
  15021.     | child |
  15022.     child := existingNode left.
  15023.     child isNil
  15024.         ifTrue: 
  15025.             [existingNode left: newNode.
  15026.             newNode default: true]
  15027.         ifFalse: [self addSibling: newNode to: child].
  15028.     newNode parent: existingNode.
  15029.     ^newNode! !
  15030.  
  15031. !ActivityTree methodsFor: 'adding'!
  15032. createRoot: ttmname 
  15033.     "The collection is empty, so make the argument, ttmname, 
  15034.     
  15035.     the name of the new root. There are no children and the 
  15036.     
  15037.     collection type (either cluster or parallel) is defaulted 
  15038.     
  15039.     to 
  15040.     
  15041.     cluster."
  15042.  
  15043.     ^root := Activity
  15044.                 name: ttmname
  15045.                 collectAs: #cluster
  15046.                 left: nil
  15047.                 right: nil! !
  15048.  
  15049. !ActivityTree methodsFor: 'removing'!
  15050. removeActivity: target 
  15051.     "Remove the target and all its children and modify pointer 
  15052.     
  15053.     from 
  15054.     
  15055.     father or elder brother."
  15056.  
  15057.     | father elderBrother youngerBrother |
  15058.     self isEmpty ifFalse: [root = target
  15059.             ifTrue: []
  15060.             ifFalse: 
  15061.                 [youngerBrother := target right.
  15062.                 father := self parentOf: target.
  15063.                 elderBrother := father elderBrotherOf: target.
  15064.                 elderBrother = nil
  15065.                     ifTrue: [father left: youngerBrother]
  15066.                     ifFalse: [elderBrother right: youngerBrother]]]! !
  15067.  
  15068. !ActivityTree methodsFor: 'copying'!
  15069. buildTree: anActivity 
  15070.     | newActivity |
  15071.     newActivity := anActivity makeCopy.
  15072.     anActivity right notNil ifTrue: [newActivity right: (self buildTree: anActivity right)].
  15073.     anActivity left notNil ifTrue: [newActivity left: (self buildTree: anActivity left)].
  15074.     ^newActivity! !
  15075.  
  15076. !ActivityTree methodsFor: 'copying'!
  15077. makeCopy
  15078.     root notNil
  15079.         ifTrue: [^self buildTree: root]
  15080.         ifFalse: [^nil]! !
  15081.  
  15082. !ActivityTree methodsFor: 'private'!
  15083. addSibling: newNode to: existingNode 
  15084.     "Make the newNode the rightmost sibling of the existing 
  15085.     
  15086.     node."
  15087.  
  15088.     existingNode lastSibling: newNode.
  15089.     ^newNode! !
  15090.  
  15091. !ActivityTree methodsFor: 'private'!
  15092. copyList: start 
  15093.     start left ~= nil ifTrue: [self copyList: start left].
  15094.     start right ~= nil ifTrue: [self copyList: start right].
  15095.     parent add: start! !
  15096.  
  15097. !ActivityTree methodsFor: 'private'!
  15098. listChildrenFrom: start 
  15099.     start left ~= nil ifTrue: [self listChildrenFrom: start left].
  15100.     start right ~= nil ifTrue: [self listChildrenFrom: start right].
  15101.     parent add: start! !
  15102.  
  15103. !ActivityTree methodsFor: 'private'!
  15104. parentOf: target startingAt: start 
  15105.     "A recursive search called by method 'parentOf:'. 
  15106.     
  15107.     Once the parent is found; i.e. no longer = nil, the 
  15108.     
  15109.     search is ended as quickly as possible."
  15110.  
  15111.     start left ~= nil & parent isNil
  15112.         ifTrue: [self parentOf: target startingAt: start left]
  15113.         ifFalse: [].
  15114.     parent isNil
  15115.         ifTrue: [start left = target | (start right = target)
  15116.                 ifTrue: [parent := start]
  15117.                 ifFalse: []]
  15118.         ifFalse: [].
  15119.     start right ~= nil & parent isNil
  15120.         ifTrue: [self parentOf: target startingAt: start right]
  15121.         ifFalse: []! !
  15122.  
  15123. View subclass: #EditingView
  15124.     instanceVariableNames: 'aspect exposedActs displayFlag '
  15125.     classVariableNames: ''
  15126.     poolDictionaries: ''
  15127.     category: 'Build'!
  15128.  
  15129. !EditingView methodsFor: 'accessing'!
  15130. aspect: aSymbol 
  15131.     "Register the message that is to be used for accessing the model's 
  15132.     dictionary of 
  15133.     
  15134.     chartable values."
  15135.  
  15136.     aspect := aSymbol! !
  15137.  
  15138. !EditingView methodsFor: 'accessing'!
  15139. boundary
  15140.     ^Rectangle
  15141.         left: self bounds left + 10
  15142.         right: self bounds right - 10
  15143.         top: self bounds top + 40
  15144.         bottom: self bounds bottom - 10! !
  15145.  
  15146. !EditingView methodsFor: 'accessing'!
  15147. defaultControllerClass
  15148.  
  15149.      ^EditingController! !
  15150.  
  15151. !EditingView methodsFor: 'accessing'!
  15152. displayFlag: aBoolean 
  15153.  
  15154.      displayFlag := aBoolean! !
  15155.  
  15156. !EditingView methodsFor: 'accessing'!
  15157. labelBoundary
  15158.     | labelWidth labelWindow |
  15159.     labelWidth := self boundary top - (self bounds top + 20).
  15160.     labelWindow := Rectangle
  15161.                 left: self boundary left
  15162.                 right: self boundary right
  15163.                 top: self bounds top + 20
  15164.                 bottom: self bounds top + 20 + labelWidth.
  15165.     ^labelWindow! !
  15166.  
  15167. !EditingView methodsFor: 'activity drawing'!
  15168. boxForNewActivity: aLabel at: cursorPosition 
  15169.     | hsize vsize maxRight maxBottom activityDim intersection locationBox child siblingBox |
  15170.     activityDim := self newActivityBox: aLabel.
  15171.     hsize := activityDim right.
  15172.     vsize := activityDim bottom.
  15173.     maxRight := self boundary right.
  15174.     maxBottom := self boundary bottom.
  15175.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  15176.         ifTrue: 
  15177.             [intersection := false.
  15178.             locationBox := activityDim copy moveBy: cursorPosition.
  15179.             child := model mynode left.
  15180.             [child notNil & (intersection = false)]
  15181.                 whileTrue: 
  15182.                     [child myBox notNil
  15183.                         ifTrue: 
  15184.                             [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  15185.                             intersection := locationBox intersects: siblingBox].
  15186.                     child := child right].
  15187.             intersection ifFalse: [^activityDim]].
  15188.     ^nil! !
  15189.  
  15190. !EditingView methodsFor: 'activity drawing'!
  15191. drawActivity: aRectangle at: aPoint withLabel: aLabel isDefault: aBoolean collect: collectionType 
  15192.     | labelPoint newLabel whiteBox newRect |
  15193.     labelPoint := aPoint translatedBy: 3 @ 2.
  15194.     whiteBox := aRectangle copy.
  15195.     whiteBox bottom: 20.
  15196.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; displayRectangle: whiteBox at: aPoint.
  15197.     collectionType = #cluster
  15198.         ifTrue: [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; lineWidth: 1; displayRectangularBorder: aRectangle at: aPoint]
  15199.         ifFalse: 
  15200.             [newRect := aRectangle copy moveBy: aPoint.
  15201.             self dashedLineFrom: newRect topLeft to: newRect topRight.
  15202.             self dashedLineFrom: newRect topRight to: newRect bottomRight.
  15203.             self dashedLineFrom: newRect topLeft to: newRect bottomLeft.
  15204.             self dashedLineFrom: newRect bottomLeft to: newRect bottomRight].
  15205.     aBoolean = true
  15206.         ifTrue: [newLabel := self style: aLabel asText allBold]
  15207.         ifFalse: [newLabel := self style: aLabel asText].
  15208.     (self graphicsContext) clippingRectangle: self boundary; display: newLabel at: labelPoint.
  15209.     ^aRectangle! !
  15210.  
  15211. !EditingView methodsFor: 'activity drawing'!
  15212. newActivityBox: aLabel 
  15213.     | hsize vsize activityDim |
  15214.     hsize := ((aLabel size + 1) * 8) ceiling + 5.
  15215.     vsize := 20.
  15216.     activityDim := Rectangle
  15217.                 left: 0
  15218.                 right: hsize
  15219.                 top: 0
  15220.                 bottom: vsize.
  15221.     ^activityDim! !
  15222.  
  15223. !EditingView methodsFor: 'transition drawing'!
  15224. drawTransitionArcFor: aTransition 
  15225.     | m s e count tr style |
  15226.     count := 1.
  15227.     [count > model ttm transitionlist size]
  15228.         whileFalse: 
  15229.             [tr := model ttm transitionlist at: count.
  15230.             aTransition = tr
  15231.                 ifTrue: 
  15232.                     [(model visibleSourceFor: tr)
  15233.                         ifTrue: 
  15234.                             [style := tr myArc sourceArrow.
  15235.                             s := tr myArc sourceStart.
  15236.                             m := tr myArc sourceMid.
  15237.                             e := tr myArc sourceEnd]
  15238.                         ifFalse: 
  15239.                             [style := tr myArc destArrow.
  15240.                             s := tr myArc destStart.
  15241.                             m := tr myArc destMid.
  15242.                             e := tr myArc destEnd].
  15243.                     self
  15244.                         drawTransitionArcFrom: s
  15245.                         to: e
  15246.                         via: m
  15247.                         inStyle: style.
  15248.                     self labelTransition: aTransition at: m.
  15249.                     ^nil].
  15250.             count := count + 1]! !
  15251.  
  15252. !EditingView methodsFor: 'transition drawing'!
  15253. labelTransition: aTransition at: middle 
  15254.     | msg2 msg3 u msg box m temp defaultSource defaultDest |
  15255.     temp := ''.
  15256.     defaultSource := ''.
  15257.     aTransition defaultSourceAssignments isNil ifFalse: [aTransition defaultSourceAssignments isEmpty ifFalse: [defaultSource := '<']].
  15258.     defaultDest := ''.
  15259.     aTransition defaultDestinationAssignments isNil ifFalse: [aTransition defaultDestinationAssignments isEmpty ifFalse: [defaultDest := '>']].
  15260.     aTransition shared = true ifTrue: [temp := '#'].
  15261.     m := middle copy.
  15262.     msg2 := '(' , aTransition myGuard , ')->'.
  15263.     msg3 := '[' , aTransition myAction , ']'.
  15264.     aTransition boundUpper = 'infinity'
  15265.         ifTrue: [u := '*']
  15266.         ifFalse: [u := aTransition boundUpper].
  15267.     msg := defaultSource , aTransition myName , defaultDest , ' [' , aTransition boundLower , '|' , u , ']' , temp.
  15268.     box := aTransition myArc dimensions copy.
  15269.     box right: (msg size * 7.5) ceiling.
  15270.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15271.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg)
  15272.         at: (m translatedBy: 2 @ 2).
  15273.     aTransition depth = #exposed
  15274.         ifTrue: 
  15275.             [aTransition myGuard = 'nil'
  15276.                 ifFalse: 
  15277.                     [m y: m y + 17.
  15278.                     box right: (msg2 size * 7.5) ceiling.
  15279.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15280.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg2)
  15281.                         at: (m translatedBy: 1 @ 2)].
  15282.             aTransition myAction = 'nil' & (aTransition myGuard = 'nil')
  15283.                 ifFalse: 
  15284.                     [m y: m y + 17.
  15285.                     box right: (msg3 size * 7.5) ceiling.
  15286.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15287.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg3)
  15288.                         at: (m translatedBy: 1 @ 2)]]! !
  15289.  
  15290. !EditingView methodsFor: 'transition drawing'!
  15291. labelTransitionOld: aTransition at: middle 
  15292.     | msg2 msg3 u msg box m temp |
  15293.       temp := ''.
  15294.       aTransition shared = true ifTrue: [ temp := '#'].
  15295.     m := middle copy.
  15296.     msg2 := '(' , aTransition myGuard , ')->'.
  15297.     msg3 := '[' , aTransition myAction , ']'.
  15298.     aTransition boundUpper = 'infinity'
  15299.         ifTrue: [u := '*']
  15300.         ifFalse: [u := aTransition boundUpper].
  15301.     msg := aTransition myName , ' [' , aTransition boundLower , '|' , u , ']',temp.
  15302.     box := aTransition myArc dimensions copy.
  15303.     box right: (msg size * 7.5) ceiling.
  15304.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15305.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg)
  15306.         at: (m translatedBy: 2 @ 2).
  15307.     aTransition depth = #exposed
  15308.         ifTrue: 
  15309.             [aTransition myGuard = 'nil'
  15310.                 ifFalse: 
  15311.                     [m y: m y + 17.
  15312.                     box right: (msg2 size * 7.5) ceiling.
  15313.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15314.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg2)
  15315.                         at: (m translatedBy: 1 @ 2)].
  15316.             aTransition myAction = 'nil' & (aTransition myGuard = 'nil')
  15317.                 ifFalse: 
  15318.                     [m y: m y + 17.
  15319.                     box right: (msg3 size * 7.5) ceiling.
  15320.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  15321.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg3)
  15322.                         at: (m translatedBy: 1 @ 2)]]! !
  15323.  
  15324. !EditingView methodsFor: 'displaying'!
  15325. dashedLineFrom: a to: b 
  15326.     "p1 and p2 should either be on same vertical or horizontal line at least 10 
  15327.     
  15328.     pixels apart."
  15329.  
  15330.     | interval current complete next draw p1 p2 |
  15331.     a x > b x | (a y > b y)
  15332.         ifTrue: 
  15333.             [p1 := b.
  15334.             p2 := a]
  15335.         ifFalse: 
  15336.             [p1 := a.
  15337.             p2 := b].
  15338.     interval := 10.
  15339.     draw := true.
  15340.     current := p1 copy.
  15341.     complete := false.
  15342.     [complete = false]
  15343.         whileTrue: 
  15344.             [p1 x < p2 x
  15345.                 ifTrue: 
  15346.                     [next := current x + interval @ current y.
  15347.                     next x > p2 x
  15348.                         ifTrue: 
  15349.                             [next x: p2 x.
  15350.                             complete := true]]
  15351.                 ifFalse: 
  15352.                     [next := current x @ (current y + interval).
  15353.                     next y > p2 y
  15354.                         ifTrue: 
  15355.                             [next y: p2 y.
  15356.                             complete := true]].
  15357.             draw = true
  15358.                 ifTrue: 
  15359.                     [draw := false.
  15360.                     interval := 5.
  15361.                     (self graphicsContext) paint: ColorValue black; lineWidth: 2; displayLineFrom: current to: next]
  15362.                 ifFalse: 
  15363.                     [draw := true.
  15364.                     interval := 10].
  15365.             current := next copy]! !
  15366.  
  15367. !EditingView methodsFor: 'displaying'!
  15368. displayOn2: ignored 
  15369.     "Override the parent's displaying method. Note that this is an 
  15370.     automatic redisplay. When the window has been written over, this 
  15371.     method is called. The view can access the model's methods by using 
  15372.     the prefix 'model' just as with the controller."
  15373.  
  15374.     | child titleText cCount temp theDefault |
  15375.     model isNil ifTrue: [^nil].
  15376.     model myview: self.
  15377.     ignored = #noUpdate ifFalse: [model updateDisplayedActs].
  15378.     (self graphicsContext) paint: ColorValue lightGray; displayRectangle: self boundary.
  15379.     (self graphicsContext) paint: ColorValue white; displayRectangle: self labelBoundary.
  15380.     model mynode hasAV
  15381.         ifTrue: [temp := model mynode selfAV at: 1]
  15382.         ifFalse: [temp := ''].
  15383.     titleText := model mynode myName , ' ( ' , temp , ' )'.
  15384.     self graphicsContext display: titleText at: self boundary left + 5 @ (self labelBoundary top + 17).
  15385.     (self graphicsContext) paint: ColorValue black; lineWidth: 2; displayRectangularBorder: (self boundary copy top: self labelBoundary top).
  15386.     child := model mynode left.
  15387.     cCount := 1.
  15388.     model waitingFor notNil ifTrue: [self pending].
  15389.     [cCount > model displayedActs size]
  15390.         whileFalse: 
  15391.             [child := model displayedActs at: cCount.
  15392.             child myBox isNil
  15393.                 ifFalse: 
  15394.                     [temp := ''.
  15395.                     child left notNil ifTrue: [temp := '@'].
  15396.                     model mynode collectionType = #cluster
  15397.                         ifTrue: [theDefault := child default]
  15398.                         ifFalse: [theDefault := false].
  15399.                     self
  15400.                         drawActivity: child myBox dimensions
  15401.                         at: child myBox location
  15402.                         withLabel: child myName , temp
  15403.                         isDefault: theDefault
  15404.                         collect: model mynode collectionType].
  15405.             cCount := cCount + 1].
  15406.     model ttm markActivitiesUnexposed.
  15407.     self displayAllExposedActivities! !
  15408.  
  15409. !EditingView methodsFor: 'displaying'!
  15410. displayOn: ingnored 
  15411.     displayFlag = True
  15412.         ifTrue: 
  15413.             [displayFlag := False.
  15414.             
  15415.             [(Delay forMilliseconds: 150) wait.
  15416.             self displayOn2: nil.
  15417.             displayFlag := True] fork]! !
  15418.  
  15419. !EditingView methodsFor: 'displaying'!
  15420. pending
  15421.     "Pending message displaying"
  15422.  
  15423.     | wait aBox msg |
  15424.     wait := model waitingFor.
  15425.     aBox := Rectangle
  15426.                 left: self bounds left
  15427.                 right: self bounds right
  15428.                 top: self bounds top
  15429.                 bottom: self labelBoundary top - 1.
  15430.     wait notNil
  15431.         ifTrue: 
  15432.             [(self graphicsContext) paint: ColorValue white; displayRectangle: aBox.
  15433.             wait = #addActivity | (wait = #moveActivity)
  15434.                 ifTrue: [msg := 'to position top left corner of activity']
  15435.                 ifFalse: [wait = #resizeActivity
  15436.                         ifTrue: [msg := 'to mark bottom right corner of activity']
  15437.                         ifFalse: [wait = #addTransition | (wait = #changeDestination)
  15438.                                 ifTrue: [msg := 'to select destination activity']
  15439.                                 ifFalse: [wait = #moveTransition
  15440.                                         ifTrue: [msg := 'to position mid point of transition']
  15441.                                         ifFalse: [wait = #addTransition1
  15442.                                                 ifTrue: [msg := 'to select source activity']
  15443.                                                 ifFalse: [wait = #zoomin
  15444.                                                         ifTrue: [msg := 'to zoom in on an activity']
  15445.                                                         ifFalse: [wait = #setDefault
  15446.                                                                 ifTrue: [msg := 'to select new default activity']
  15447.                                                                 ifFalse: [wait = #inConcurrently | (wait = #inSerially)
  15448.                                                                         ifTrue: [msg := 'to position top left corner of ttm']
  15449.                                                                         ifFalse: [wait = #selfloop | (wait = #changeselfloop)
  15450.                                                                                 ifTrue: [msg := 'to select selfloop midpt']
  15451.                                                                                 ifFalse: []]]]]]]]].
  15452.             msg := '>>Click left mouse button ' , msg , '<<'.
  15453.             msg := msg asText allBold.
  15454.             self graphicsContext display: msg at: aBox left + 3 @ (aBox top + 14)]
  15455.         ifFalse: [(self graphicsContext) paint: ColorValue lightGray; displayRectangle: aBox]! !
  15456.  
  15457. !EditingView methodsFor: 'displaying'!
  15458. style: aText 
  15459.  
  15460.     ^ComposedText withText: aText style: (TextAttributes styleNamed: #fixed)! !
  15461.  
  15462. !EditingView methodsFor: 'displaying'!
  15463. update: aParameter 
  15464.     "If the aspect of the model that this view cares about has changed, 
  15465.     redisplay."
  15466.  
  15467.     aParameter = aspect ifTrue: [self invalidate]! !
  15468.  
  15469. !EditingView methodsFor: 'calculations'!
  15470. borderPointFrom: s through: m 
  15471.     m x > s x
  15472.         ifTrue: [m y > s y
  15473.                 ifTrue: [^self boundary bottomRight]
  15474.                 ifFalse: [^self boundary topRight]]
  15475.         ifFalse: [m y > s y
  15476.                 ifTrue: [^self boundary bottomLeft]
  15477.                 ifFalse: [^self boundary topLeft]]! !
  15478.  
  15479. !EditingView methodsFor: 'calculations'!
  15480. boxPoints: box1 to: box2 
  15481.     "Compute which two points on the two boxes are closest together and 
  15482.     return 
  15483.  
  15484.     them both. The boxes are Box dimensions moved by their 
  15485.     locations."
  15486.  
  15487.     | sideBox2 sideBox1 point1 point2 beginPt endPt |
  15488.     beginPt := 1.
  15489.     endPt := 2.
  15490.     sideBox1 := self findSideOf: box2 facing: box1.
  15491.     sideBox2 := self findSideOf: box1 facing: box2.
  15492.     point1 := box1 center nearestPointOnLineFrom: (sideBox2 at: beginPt)
  15493.                 to: (sideBox2 at: endPt).
  15494.     point2 := box2 center nearestPointOnLineFrom: (sideBox1 at: beginPt)
  15495.                 to: (sideBox1 at: endPt).
  15496.     ^Array with: point1 with: point2! !
  15497.  
  15498. !EditingView methodsFor: 'calculations'!
  15499. boxPoints: box1 to: box2 via: middle 
  15500.     "Compute which two points on the two boxes are closest together and 
  15501.     return 
  15502.  
  15503.     them both."
  15504.  
  15505.     | sideBox2 sideBox1 beginPt endPt point1 point2 |
  15506.     beginPt := 1.
  15507.     endPt := 2.
  15508.     sideBox1 := self findSideOf: box2 face: middle.
  15509.     sideBox2 := self findSideOf: box1 face: middle.
  15510.     point1 := self midPointOf: (sideBox2 at: beginPt)
  15511.                 and: (sideBox2 at: endPt).
  15512.     point2 := self midPointOf: (sideBox1 at: beginPt)
  15513.                 and: (sideBox1 at: endPt).
  15514.     ^Array with: point1 with: point2! !
  15515.  
  15516. !EditingView methodsFor: 'calculations'!
  15517. boxPoints: box1 toPoint: end via: middle 
  15518.     "Compute which two points on the two boxes are closest together and 
  15519.     return 
  15520.     
  15521.     them both."
  15522.  
  15523.     | sideBox2 beginPt endPt point1 point2 |
  15524.     beginPt := 1.
  15525.     endPt := 2.
  15526.     sideBox2 := self findSideOf: box1 face: middle.
  15527.     point1 := self midPointOf: (sideBox2 at: beginPt)
  15528.                 and: (sideBox2 at: endPt).
  15529.     point2 := end copy.
  15530.     ^Array with: point1 with: point2! !
  15531.  
  15532. !EditingView methodsFor: 'calculations'!
  15533. boxPointsPoint: start to: box2 via: middle 
  15534.     "Compute which two points on the two boxes are closest together and 
  15535.     return 
  15536.     
  15537.     them both."
  15538.  
  15539.     | sideBox1 beginPt endPt point1 point2 |
  15540.     beginPt := 1.
  15541.     endPt := 2.
  15542.     sideBox1 := self findSideOf: box2 face: middle.
  15543.     point1 := start copy.
  15544.     point2 := self midPointOf: (sideBox1 at: beginPt)
  15545.                 and: (sideBox1 at: endPt).
  15546.     ^Array with: point1 with: point2! !
  15547.  
  15548. !EditingView methodsFor: 'calculations'!
  15549. findSideOf: box1 face: pt 
  15550.     "Find which side of box1 faces box2. I will try to match the best face of the 
  15551.     box 
  15552.  
  15553.     possible. Return the line representing the facing side."
  15554.  
  15555.     | diag1 diag2 side beginPt endPt |
  15556.     diag1 := OrderedCollection new: 2.
  15557.     diag1 add: 0 @ 0; add: 0 @ 0.
  15558.     diag2 := OrderedCollection new: 2.
  15559.     diag2 add: 0 @ 0; add: 0 @ 0.
  15560.     side := OrderedCollection new: 2.
  15561.     side add: 0 @ 0; add: 0 @ 0.
  15562.     beginPt := 1.
  15563.     endPt := 2.
  15564.     diag1 at: beginPt put: box1 topLeft.
  15565.     diag1 at: endPt put: box1 bottomRight.
  15566.     diag2 at: beginPt put: box1 bottomLeft.
  15567.     diag2 at: endPt put: box1 topRight.
  15568.     (self
  15569.         is: box1 topRight
  15570.         onSameSideAs: pt
  15571.         of: diag1)
  15572.         ifTrue: [side at: beginPt put: box1 topRight]
  15573.         ifFalse: [side at: beginPt put: box1 bottomLeft].
  15574.     (self
  15575.         is: box1 topLeft
  15576.         onSameSideAs: pt
  15577.         of: diag2)
  15578.         ifTrue: [side at: endPt put: box1 topLeft]
  15579.         ifFalse: [side at: endPt put: box1 bottomRight].
  15580.     ^side! !
  15581.  
  15582. !EditingView methodsFor: 'calculations'!
  15583. findSideOf: box1 facing: box2 
  15584.     "Find which side of box1 faces box2. I will try to match the best face of the 
  15585.     box 
  15586.  
  15587.     possible. Return the line representing the facing side. The line 
  15588.     returned is an 
  15589.  
  15590.     OrderedCollection of 2 points."
  15591.  
  15592.     | diag1 diag2 side beginPt endPt |
  15593.     diag1 := OrderedCollection new: 2.
  15594.     diag1 add: 0 @ 0; add: 0 @ 0.
  15595.     diag2 := OrderedCollection new: 2.
  15596.     diag2 add: 0 @ 0; add: 0 @ 0.
  15597.     side := OrderedCollection new: 2.
  15598.     side add: 0 @ 0; add: 0 @ 0.
  15599.     beginPt := 1.
  15600.     endPt := 2.
  15601.     diag1 at: beginPt put: box1 topLeft.
  15602.     diag1 at: endPt put: box1 bottomRight.
  15603.     diag2 at: beginPt put: box1 bottomLeft.
  15604.     diag2 at: endPt put: box1 topRight.
  15605.     (self
  15606.         is: box1 topRight
  15607.         onSameSideAs: box2 bottomLeft
  15608.         of: diag1)
  15609.         ifTrue: [side at: beginPt put: box1 topRight]
  15610.         ifFalse: [side at: beginPt put: box1 bottomLeft].
  15611.     (self
  15612.         is: box1 topLeft
  15613.         onSameSideAs: box2 bottomRight
  15614.         of: diag2)
  15615.         ifTrue: [side at: endPt put: box1 topLeft]
  15616.         ifFalse: [side at: endPt put: box1 bottomRight].
  15617.     ^side! !
  15618.  
  15619. !EditingView methodsFor: 'calculations'!
  15620. is: point1 onSameSideAs: point2 of: aLine 
  15621.     "Answer true if the two points are on the same side of the given line. The 
  15622.     line is 
  15623.  
  15624.     an ordered collection of two points."
  15625.  
  15626.     | dx dy dx1 dx2 dy1 dy2 beginPt endPt |
  15627.     beginPt := 1.
  15628.     endPt := 2.
  15629.     dx := (aLine at: endPt) x - (aLine at: beginPt) x.
  15630.     dy := (aLine at: endPt) y - (aLine at: beginPt) y.
  15631.     dx1 := point1 x - (aLine at: beginPt) x.
  15632.     dy1 := point1 y - (aLine at: beginPt) y.
  15633.     dx2 := point2 x - (aLine at: endPt) x.
  15634.     dy2 := point2 y - (aLine at: endPt) y.
  15635.     dx * dy1 - (dy * dx1) * (dx * dy2 - (dy * dx2)) > 0
  15636.         ifTrue: [^true]
  15637.         ifFalse: [^false]! !
  15638.  
  15639. !EditingView methodsFor: 'calculations'!
  15640. midPointOf: pt1 and: pt2 
  15641.     | midx midy newMidPoint |
  15642.     midx := pt1 x + pt2 x.
  15643.     midx := (midx / 2) truncated.
  15644.     midy := pt1 y + pt2 y.
  15645.     midy := (midy / 2) truncated.
  15646.     newMidPoint := Point x: midx y: midy.
  15647.     ^newMidPoint! !
  15648.  
  15649. !EditingView methodsFor: 'arrow drawing'!
  15650. arrowheadFrom: p2 to: p1 
  15651.     "This routine was supplied by Don Laws."
  15652.     "Compressed & renamed by Tim Field."
  15653.     "h = height, b = base."
  15654.  
  15655.     | b h halfBase x1 y1 x2 y2 x4 x5 y5 y4 m rm cx1 cy1 cx2 cy2 x3 y3 p4 p5 arrow |
  15656.     b := 12.
  15657.     h := 12.
  15658.     halfBase := b / 2.
  15659.     x1 := p1 x.
  15660.     y1 := p1 y.
  15661.     x2 := p2 x.
  15662.     y2 := p2 y.
  15663.     x1 = x2
  15664.         ifTrue: 
  15665.             [x4 := x1 - halfBase.
  15666.             x5 := x1 + halfBase.
  15667.             y1 > y2
  15668.                 ifTrue: [y5 := y1 - h]
  15669.                 ifFalse: [y5 := y1 + h].
  15670.             y4 := y5]
  15671.         ifFalse: [y1 = y2
  15672.                 ifTrue: 
  15673.                     [y4 := y1 - halfBase.
  15674.                     y5 := y1 + halfBase.
  15675.                     x1 > x2
  15676.                         ifTrue: [x5 := x1 - h]
  15677.                         ifFalse: [x5 := x1 + h].
  15678.                     x4 := x5]
  15679.                 ifFalse: 
  15680.                     [m := y1 - y2 / (x1 - x2).
  15681.                     rm := m reciprocal.
  15682.                     cx1 := h * (1 + m squared) reciprocal sqrt.
  15683.                     cy1 := h * (1 + m squared reciprocal) reciprocal sqrt.
  15684.                     cx2 := halfBase * (1 + rm squared) reciprocal sqrt.
  15685.                     cy2 := halfBase * (1 + rm squared reciprocal) reciprocal sqrt.
  15686.                     x1 < x2
  15687.                         ifTrue: [x3 := x1 + cx1]
  15688.                         ifFalse: [x3 := x1 - cx1].
  15689.                     y1 > y2
  15690.                         ifTrue: [y3 := y1 - cy1]
  15691.                         ifFalse: [y3 := y1 + cy1].
  15692.                     x1 < x2
  15693.                         ifTrue: 
  15694.                             [y4 := y3 + cy2.
  15695.                             y5 := y3 - cy2]
  15696.                         ifFalse: 
  15697.                             [y4 := y3 - cy2.
  15698.                             y5 := y3 + cy2].
  15699.                     y1 < y2
  15700.                         ifTrue: 
  15701.                             [x4 := x3 - cx2.
  15702.                             x5 := x3 + cx2]
  15703.                         ifFalse: 
  15704.                             [x4 := x3 + cx2.
  15705.                             x5 := x3 - cx2]]].
  15706.     p4 := Point x: x4 y: y4.
  15707.     p5 := Point x: x5 y: y5.
  15708.     arrow := OrderedCollection new.
  15709.     arrow add: p1.
  15710.     arrow add: p4.
  15711.     arrow add: p5.
  15712.     self graphicsContext displayPolygon: arrow! !
  15713.  
  15714. !EditingView methodsFor: 'arrow drawing'!
  15715. dot: p2 color: mycolor 
  15716.     mycolor = #black
  15717.         ifTrue: [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black;
  15718.                 displayWedgeBoundedBy: (Rectangle
  15719.                         left: 0
  15720.                         right: 10
  15721.                         top: 0
  15722.                         bottom: 10)
  15723.                 startAngle: 0
  15724.                 sweepAngle: 359
  15725.                 at: p2 x - 5 @ (p2 y - 5)]
  15726.         ifFalse: 
  15727.             [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black;
  15728.                 displayWedgeBoundedBy: (Rectangle
  15729.                         left: 0
  15730.                         right: 10
  15731.                         top: 0
  15732.                         bottom: 10)
  15733.                 startAngle: 0
  15734.                 sweepAngle: 359
  15735.                 at: p2 x - 5 @ (p2 y - 5).
  15736.             (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue gray;
  15737.                 displayWedgeBoundedBy: (Rectangle
  15738.                         left: 0
  15739.                         right: 8
  15740.                         top: 0
  15741.                         bottom: 8)
  15742.                 startAngle: 0
  15743.                 sweepAngle: 359
  15744.                 at: p2 x - 4 @ (p2 y - 4)]! !
  15745.  
  15746. !EditingView methodsFor: 'arrow drawing'!
  15747. drawTransitionArcFrom: p1 to: p2 via: midPt inStyle: case 
  15748.     "Use a spline to draw on current graphics context"
  15749.     "style case1 = no start dot or end dot. 
  15750.     
  15751.     case2 = no start dot with black disc for end dot. 
  15752.     
  15753.     case3 = white disc for start dot with no end dot. 
  15754.     
  15755.     case4 = white disc for start dot with arrow head end. 
  15756.     
  15757.     case5 = no start dot with arrow head end. 
  15758.     
  15759.     case6 = thinner lineWidth with arrow head end"
  15760.  
  15761.     | aSpline arrowPt |
  15762.     aSpline := Spline2 new.
  15763.     aSpline add: p1.
  15764.     aSpline add: midPt.
  15765.     aSpline add: p2.
  15766.     aSpline computeCurve.
  15767.     case = 6
  15768.         ifTrue: [arrowPt := aSpline displayArcOnContext2: self graphicsContext onView: self]
  15769.         ifFalse: [arrowPt := aSpline displayArcOnContext: self graphicsContext onView: self].
  15770.     case = 1 ifTrue: [^nil].
  15771.     case = 2
  15772.         ifTrue: 
  15773.             [self dot: p2 color: #black.
  15774.             ^nil].
  15775.     case = 3
  15776.         ifTrue: 
  15777.             [self dot: p1 color: #white.
  15778.             ^nil].
  15779.     case = 4 ifTrue: [self dot: p1 color: #white].
  15780.     self arrowheadFrom: arrowPt to: p2! !
  15781.  
  15782. !EditingView methodsFor: 'exposed activities'!
  15783. determineExposedAncestors
  15784.     "Inform every activity of which ancestor closest to itself is exposed"
  15785.  
  15786.     | actPointer temp |
  15787.     actPointer := model ttm activitytree getRoot.
  15788.     [actPointer notNil]
  15789.         whileTrue: 
  15790.             [actPointer exposed == True
  15791.                 ifTrue: 
  15792.                     [actPointer exposedAncestor: True.
  15793.                     temp := actPointer]
  15794.                 ifFalse: 
  15795.                     [actPointer exposedAncestor: nil.
  15796.                     temp := nil].
  15797.             self doChildren: actPointer exposed: temp.
  15798.             actPointer := actPointer right]! !
  15799.  
  15800. !EditingView methodsFor: 'exposed activities'!
  15801. displayAllExposedActivities
  15802.     | count anActivity graphicsInfo child |
  15803.     count := 1.
  15804.     exposedActs := OrderedCollection new.
  15805.     [count > model displayedActs size]
  15806.         whileFalse: 
  15807.             [anActivity := model displayedActs at: count.
  15808.             anActivity exposed: True.
  15809.             (self shouldDisplayChildrenOf: anActivity)
  15810.                 ifTrue: 
  15811.                     [graphicsInfo := self graphicsForChildrenOf: anActivity.
  15812.                     graphicsInfo notNil
  15813.                         ifTrue: 
  15814.                             [child := anActivity left.
  15815.                             [child notNil]
  15816.                                 whileTrue: 
  15817.                                     [exposedActs add: child.
  15818.                                     child parentBox: anActivity myBox.
  15819.                                     child exposed: True.
  15820.                                     child := child right].
  15821.                             self drawBoxesUsing: graphicsInfo from: anActivity]].
  15822.             count := count + 1].
  15823.     self determineExposedAncestors.
  15824.     self drawTransitions! !
  15825.  
  15826. !EditingView methodsFor: 'exposed activities'!
  15827. doChildren: anActivity exposed: eActivity 
  15828.     "Recusively determine the topmost exposed ancestor for each activity. If 
  15829.     activity 
  15830.  
  15831.     is itself exposed then set the exposedAncestor of that 
  15832.     activity to TRUE"
  15833.  
  15834.     | sibling temp |
  15835.     sibling := anActivity left.
  15836.     [sibling notNil]
  15837.         whileTrue: 
  15838.             [sibling exposed == True
  15839.                 ifTrue: 
  15840.                     [sibling exposedAncestor: True.
  15841.                     temp := sibling]
  15842.                 ifFalse: 
  15843.                     [sibling exposedAncestor: eActivity.
  15844.                     temp := eActivity].
  15845.             self doChildren: sibling exposed: temp.
  15846.             sibling := sibling right]! !
  15847.  
  15848. !EditingView methodsFor: 'exposed activities'!
  15849. drawArcsUsing: graphicsInfo from: anActivity 
  15850.     "Given the graphics info generated by the function called 
  15851.     
  15852.     'graphicsForChildrenOf:', draw the trs on the screen."
  15853.  
  15854.     | count tr style s m e index box points |
  15855.     count := 1.
  15856.     style := 5.
  15857.     [count > model ttm transitionlist size]
  15858.         whileFalse: 
  15859.             [tr := model ttm transitionlist at: count.
  15860.             (model displayedActs includes: tr startingAt)
  15861.                 & (exposedActs includes: tr endingAt)
  15862.                 ifTrue: 
  15863.                     [s := tr myArc sourceStart.
  15864.                     m := tr myArc sourceMid.
  15865.                     index := self indexOfExposedAct: tr endingAt.
  15866.                     box := ((graphicsInfo at: index)
  15867.                                 at: 1) copy moveBy: ((graphicsInfo at: index)
  15868.                                     at: 2).
  15869.                     points := self findSideOf: box face: m.
  15870.                     e := self midPointOf: (points at: 1)
  15871.                                 and: (points at: 2).
  15872.                     self
  15873.                         drawTransitionArcFrom: s
  15874.                         to: e
  15875.                         via: m
  15876.                         inStyle: style.
  15877.                     self labelTransition: tr at: m]
  15878.                 ifFalse: [].
  15879.             (exposedActs includes: tr startingAt)
  15880.                 & (model displayedActs includes: tr endingAt)
  15881.                 ifTrue: 
  15882.                     [e := tr myArc destEnd.
  15883.                     m := tr myArc destMid.
  15884.                     index := self indexOfExposedAct: tr startingAt.
  15885.                     box := ((graphicsInfo at: index)
  15886.                                 at: 1) copy moveBy: ((graphicsInfo at: index)
  15887.                                     at: 2).
  15888.                     points := self findSideOf: box face: m.
  15889.                     s := self midPointOf: (points at: 1)
  15890.                                 and: (points at: 2).
  15891.                     self
  15892.                         drawTransitionArcFrom: s
  15893.                         to: e
  15894.                         via: m
  15895.                         inStyle: style.
  15896.                     self labelTransition: tr at: m]
  15897.                 ifFalse: [].
  15898.             count := count + 1]! !
  15899.  
  15900. !EditingView methodsFor: 'exposed activities'!
  15901. drawBoxesUsing: graphicsInfo from: anActivity 
  15902.     "Given the graphics info generated by the function called 
  15903.     
  15904.     
  15905.     'graphicsForChildrenOf:', draw them on the screen."
  15906.  
  15907.     | count graphicsElement d |
  15908.     count := 1.
  15909.     [count > graphicsInfo size]
  15910.         whileFalse: 
  15911.             [graphicsElement := graphicsInfo at: count.
  15912.             anActivity collectionType = #parallel
  15913.                 ifTrue: [d := false]
  15914.                 ifFalse: [d := graphicsElement at: 4].
  15915.             self
  15916.                 drawActivity: (graphicsElement at: 1)
  15917.                 at: (graphicsElement at: 2)
  15918.                 withLabel: (graphicsElement at: 3)
  15919.                 isDefault: d
  15920.                 collect: anActivity collectionType.
  15921.             count := count + 1]! !
  15922.  
  15923. !EditingView methodsFor: 'exposed activities'!
  15924. drawTransitions
  15925.     "Draw all transitions - work in progress"
  15926.  
  15927.     | sourceAct destAct es ed allTransitions graphicsInfo style s m points box e box1 box2 |
  15928.     style := 5.
  15929.     allTransitions := model ttm transitionlist.
  15930.     allTransitions
  15931.         do: 
  15932.             [:aTransition | 
  15933.             sourceAct := aTransition startingAt.
  15934.             destAct := aTransition endingAt.
  15935.             es := sourceAct exposedAncestor.
  15936.             es == True ifTrue: [es := sourceAct].
  15937.             ed := destAct exposedAncestor.
  15938.             ed == True ifTrue: [ed := destAct].
  15939.             es isNil & ed isNil
  15940.                 ifFalse: 
  15941.                     [es isNil & ed notNil
  15942.                         ifTrue: 
  15943.                             [m := aTransition myArc sourceMid.
  15944.                             (model displayedActs includes: ed)
  15945.                                 ifTrue: [aTransition endingAt exposed = True
  15946.                                         ifTrue: [e := aTransition myArc destEnd]
  15947.                                         ifFalse: 
  15948.                                             [box := ed myBox dimensions copy moveBy: ed myBox location.
  15949.                                             points := self findSideOf: box face: m.
  15950.                                             e := self midPointOf: (points at: 1)
  15951.                                                         and: (points at: 2)]]
  15952.                                 ifFalse: [(exposedActs includes: ed)
  15953.                                         ifTrue: 
  15954.                                             [graphicsInfo := ed graphicsInfo.
  15955.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  15956.                                             points := self findSideOf: box face: m.
  15957.                                             e := self midPointOf: (points at: 1)
  15958.                                                         and: (points at: 2)]].
  15959.                             s := self borderPointFrom: e through: m.
  15960.                             self
  15961.                                 drawTransitionArcFrom: s
  15962.                                 to: e
  15963.                                 via: m
  15964.                                 inStyle: 6.
  15965.                             self labelTransition: aTransition at: m].
  15966.                     es notNil & ed isNil
  15967.                         ifTrue: 
  15968.                             [s := aTransition myArc sourceStart.
  15969.                             m := aTransition myArc sourceMid.
  15970.                             e := self borderPointFrom: s through: m.
  15971.                             self
  15972.                                 drawTransitionArcFrom: s
  15973.                                 to: e
  15974.                                 via: m
  15975.                                 inStyle: 2.
  15976.                             self labelTransition: aTransition at: m].
  15977.                     es notNil & ed notNil
  15978.                         ifTrue: 
  15979.                             [(model displayedActs includes: aTransition startingAt)
  15980.                                 & (model displayedActs includes: aTransition endingAt)
  15981.                                 ifTrue: [self drawTransitionArcFor: aTransition]
  15982.                                 ifFalse: [(model displayedActs includes: es)
  15983.                                         & (model displayedActs includes: ed) & (es ~= ed)
  15984.                                         ifTrue: 
  15985.                                             [m := aTransition myArc sourceMid.
  15986.                                             (exposedActs includes: es)
  15987.                                                 ifTrue: [s := aTransition myArc sourceStart]
  15988.                                                 ifFalse: 
  15989.                                                     [box := es myBox dimensions copy moveBy: es myBox location.
  15990.                                                     points := self findSideOf: box face: m.
  15991.                                                     s := self midPointOf: (points at: 1)
  15992.                                                                 and: (points at: 2)].
  15993.                                             (exposedActs includes: ed)
  15994.                                                 ifTrue: [e := aTransition myArc sourceEnd]
  15995.                                                 ifFalse: 
  15996.                                                     [box := ed myBox dimensions copy moveBy: ed myBox location.
  15997.                                                     points := self findSideOf: box face: m.
  15998.                                                     e := self midPointOf: (points at: 1)
  15999.                                                                 and: (points at: 2)].
  16000.                                             self
  16001.                                                 drawTransitionArcFrom: s
  16002.                                                 to: e
  16003.                                                 via: m
  16004.                                                 inStyle: 6.
  16005.                                             self labelTransition: aTransition at: m]].
  16006.                             (model displayedActs includes: es)
  16007.                                 & (exposedActs includes: ed)
  16008.                                 ifTrue: 
  16009.                                     [s := aTransition myArc sourceStart.
  16010.                                     m := aTransition myArc sourceMid.
  16011.                                     graphicsInfo := ed graphicsInfo.
  16012.                                     box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16013.                                     points := self findSideOf: box face: m.
  16014.                                     e := self midPointOf: (points at: 1)
  16015.                                                 and: (points at: 2).
  16016.                                     self
  16017.                                         drawTransitionArcFrom: s
  16018.                                         to: e
  16019.                                         via: m
  16020.                                         inStyle: style.
  16021.                                     self labelTransition: aTransition at: m].
  16022.                             (model displayedActs includes: ed)
  16023.                                 & (exposedActs includes: es)
  16024.                                 ifTrue: 
  16025.                                     [e := aTransition myArc destEnd.
  16026.                                     m := aTransition myArc destMid.
  16027.                                     graphicsInfo := es graphicsInfo.
  16028.                                     box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16029.                                     points := self findSideOf: box face: m.
  16030.                                     s := self midPointOf: (points at: 1)
  16031.                                                 and: (points at: 2).
  16032.                                     self
  16033.                                         drawTransitionArcFrom: s
  16034.                                         to: e
  16035.                                         via: m
  16036.                                         inStyle: style.
  16037.                                     self labelTransition: aTransition at: m].
  16038.                             (exposedActs includes: es)
  16039.                                 & (exposedActs includes: ed)
  16040.                                 ifTrue: 
  16041.                                     [es parentBox = ed parentBox & (es ~= ed | (sourceAct = destAct & (destAct exposed = True)))
  16042.                                         ifTrue: 
  16043.                                             [m := aTransition myArc sourceMid.
  16044.                                             graphicsInfo := es graphicsInfo.
  16045.                                             m := m - es myBox location + (graphicsInfo at: 2).
  16046.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16047.                                             points := self findSideOf: box face: m.
  16048.                                             es = ed
  16049.                                                 ifTrue: [s := points at: 2]
  16050.                                                 ifFalse: [s := self midPointOf: (points at: 1)
  16051.                                                                 and: (points at: 2)].
  16052.                                             graphicsInfo := ed graphicsInfo.
  16053.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16054.                                             points := self findSideOf: box face: m.
  16055.                                             e := self midPointOf: (points at: 1)
  16056.                                                         and: (points at: 2).
  16057.                                             self
  16058.                                                 drawTransitionArcFrom: s
  16059.                                                 to: e
  16060.                                                 via: m
  16061.                                                 inStyle: 6.
  16062.                                             self labelTransition: aTransition at: m].
  16063.                                     es parentBox ~= ed parentBox
  16064.                                         ifTrue: 
  16065.                                             [graphicsInfo := es graphicsInfo.
  16066.                                             box1 := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16067.                                             graphicsInfo := ed graphicsInfo.
  16068.                                             box2 := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  16069.                                             points := self boxPoints: box1 to: box2.
  16070.                                             s := points at: 1.
  16071.                                             e := points at: 2.
  16072.                                             m := self midPointOf: (points at: 1)
  16073.                                                         and: (points at: 2).
  16074.                                             self
  16075.                                                 drawTransitionArcFrom: s
  16076.                                                 to: e
  16077.                                                 via: m
  16078.                                                 inStyle: 6.
  16079.                                             self labelTransition: aTransition at: m]]]]]! !
  16080.  
  16081. !EditingView methodsFor: 'exposed activities'!
  16082. graphicsForChildrenOf: anActivity 
  16083.     "Return the set of graphics info for the children of the given activity 
  16084.     if they 
  16085.     can 
  16086.     
  16087.     all fit inside the given activity, else return NIL. Only call this routine 
  16088.     if 
  16089.     anActivity 
  16090.     
  16091.     is exposed and it has a box and it has a child."
  16092.  
  16093.     | graphicsInfo child graphicsElement left top right bottom currentLeft currentTop currentRight currentBottom deltaX deltaY count location maxRight maxBottom xDim yDim temp |
  16094.     graphicsInfo := OrderedCollection new.
  16095.     left := -1.
  16096.     top := -1.
  16097.     right := -1.
  16098.     bottom := -1.
  16099.     child := anActivity left.
  16100.     [child notNil]
  16101.         whileTrue: 
  16102.             [child myBox isNil ifTrue: [^nil].
  16103.             temp := ''.
  16104.             child left notNil ifTrue: [temp := '@'].
  16105.             graphicsElement := Array
  16106.                         with: (self newActivityBox: child myName)
  16107.                         with: child myBox location copy
  16108.                         with: child myName , temp
  16109.                         with: child default.
  16110.             currentLeft := child myBox location x.
  16111.             currentTop := child myBox location y.
  16112.             currentRight := currentLeft + (graphicsElement at: 1) right.
  16113.             currentBottom := currentTop + (graphicsElement at: 1) bottom.
  16114.             left = -1 | (currentLeft < left) ifTrue: [left := currentLeft].
  16115.             top = -1 | (currentTop < top) ifTrue: [top := currentTop].
  16116.             right = -1 | (currentRight > right) ifTrue: [right := currentRight].
  16117.             bottom = -1 | (currentBottom > bottom) ifTrue: [bottom := currentBottom].
  16118.             child graphicsInfo: graphicsElement.
  16119.             graphicsInfo add: graphicsElement.
  16120.             child := child right].
  16121.     maxRight := anActivity myBox dimensions right.
  16122.     maxBottom := anActivity myBox dimensions bottom - 20.
  16123.     xDim := right - left.
  16124.     yDim := bottom - top.
  16125.     xDim > maxRight | (yDim > maxBottom) ifTrue: [^nil].
  16126.     deltaX := maxRight - xDim.
  16127.     deltaX := (deltaX / 2) rounded + (anActivity myBox location x - left).
  16128.     deltaY := maxBottom - yDim.
  16129.     deltaY := (deltaY / 2) rounded + (anActivity myBox location y - top + 20).
  16130.     count := 1.
  16131.     [count > graphicsInfo size]
  16132.         whileFalse: 
  16133.             [location := (graphicsInfo at: count)
  16134.                         at: 2.
  16135.             location x: location x + deltaX.
  16136.             location y: location y + deltaY.
  16137.             count := count + 1].
  16138.     ^graphicsInfo! !
  16139.  
  16140. !EditingView methodsFor: 'exposed activities'!
  16141. indexOfExposedAct: anActivity 
  16142.     "Return the index number of the activity in the exposedActs collection"
  16143.  
  16144.     | count |
  16145.     count := 1.
  16146.     [count > exposedActs size]
  16147.         whileFalse: 
  16148.             [(exposedActs at: count)
  16149.                 = anActivity ifTrue: [^count].
  16150.             count := count + 1].
  16151.     ^0! !
  16152.  
  16153. !EditingView methodsFor: 'exposed activities'!
  16154. shouldDisplayChildrenOf: anActivity 
  16155.     "return true if the given activity is exposed and 
  16156.  
  16157.     has child activities."
  16158.  
  16159.     anActivity left notNil & anActivity myBox notNil
  16160.         ifTrue: [^anActivity myBox depth = #exposed]
  16161.         ifFalse: [^false]! !
  16162.  
  16163. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  16164.  
  16165. EditingView class
  16166.     instanceVariableNames: ''!
  16167.  
  16168. !EditingView class methodsFor: 'initialization'!
  16169. new
  16170.     ^super new displayFlag: True! !
  16171.  
  16172. Object subclass: #Arc2
  16173.     instanceVariableNames: 'dimensions sourceStart destStart sourceEnd destEnd sourceMid destMid sourceArrow destArrow '
  16174.     classVariableNames: ''
  16175.     poolDictionaries: ''
  16176.     category: 'Build'!
  16177.  
  16178. !Arc2 methodsFor: 'dest accessing'!
  16179. destArrow
  16180.  
  16181.      ^destArrow! !
  16182.  
  16183. !Arc2 methodsFor: 'dest accessing'!
  16184. destArrow: newArrow 
  16185.  
  16186.      destArrow := newArrow! !
  16187.  
  16188. !Arc2 methodsFor: 'dest accessing'!
  16189. destEnd
  16190.  
  16191.      ^destEnd! !
  16192.  
  16193. !Arc2 methodsFor: 'dest accessing'!
  16194. destEnd: newEnd
  16195.  
  16196.      destEnd := newEnd! !
  16197.  
  16198. !Arc2 methodsFor: 'dest accessing'!
  16199. destMid
  16200.  
  16201.      ^destMid! !
  16202.  
  16203. !Arc2 methodsFor: 'dest accessing'!
  16204. destMid: newMid
  16205.  
  16206.      destMid := newMid! !
  16207.  
  16208. !Arc2 methodsFor: 'dest accessing'!
  16209. destStart
  16210.  
  16211.      ^destStart! !
  16212.  
  16213. !Arc2 methodsFor: 'dest accessing'!
  16214. destStart: newStart
  16215.  
  16216.      destStart := newStart! !
  16217.  
  16218. !Arc2 methodsFor: 'source accessing'!
  16219. sourceArrow
  16220.  
  16221. ^sourceArrow! !
  16222.  
  16223. !Arc2 methodsFor: 'source accessing'!
  16224. sourceArrow: newArrow 
  16225.  
  16226.      sourceArrow := newArrow! !
  16227.  
  16228. !Arc2 methodsFor: 'source accessing'!
  16229. sourceEnd
  16230.  
  16231.      ^sourceEnd! !
  16232.  
  16233. !Arc2 methodsFor: 'source accessing'!
  16234. sourceEnd: newend
  16235.  
  16236.      sourceEnd := newend! !
  16237.  
  16238. !Arc2 methodsFor: 'source accessing'!
  16239. sourceMid
  16240.  
  16241.      ^sourceMid! !
  16242.  
  16243. !Arc2 methodsFor: 'source accessing'!
  16244. sourceMid: newmid
  16245.  
  16246.      sourceMid := newmid! !
  16247.  
  16248. !Arc2 methodsFor: 'source accessing'!
  16249. sourceStart
  16250.  
  16251.      ^sourceStart! !
  16252.  
  16253. !Arc2 methodsFor: 'source accessing'!
  16254. sourceStart: newstart
  16255.  
  16256.      sourceStart := newstart! !
  16257.  
  16258. !Arc2 methodsFor: 'accessing'!
  16259. assignFrom: startPt through: midPt to: endPt
  16260.  
  16261.      self sourceStart: startPt.
  16262.  
  16263.       self destStart: startPt.
  16264.  
  16265.      self sourceEnd: endPt.
  16266.  
  16267.       self destEnd: endPt.
  16268.  
  16269.      self sourceMid: midPt.
  16270.  
  16271.       self destMid: midPt.
  16272.  
  16273.       self sourceArrow: 5.
  16274.  
  16275.       self destArrow: 5.! !
  16276.  
  16277. !Arc2 methodsFor: 'accessing'!
  16278. dimensions
  16279.  
  16280.      ^dimensions! !
  16281.  
  16282. !Arc2 methodsFor: 'accessing'!
  16283. dimensions: newDimensions 
  16284.  
  16285.      dimensions := newDimensions! !
  16286.  
  16287. !Arc2 methodsFor: 'copying'!
  16288. makeCopy
  16289.     | temp |
  16290.     temp := self copy.
  16291.     temp sourceArrow: self sourceArrow copy.
  16292.     temp sourceEnd: self sourceEnd copy.
  16293.     temp sourceStart: self sourceStart copy.
  16294.     temp sourceMid: self sourceMid copy.
  16295.     ^temp! !
  16296.  
  16297. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  16298.  
  16299. Arc2 class
  16300.     instanceVariableNames: ''!
  16301.  
  16302. !Arc2 class methodsFor: 'instance creation'!
  16303. start: startingPt end: endingPt mid: midPt 
  16304.     "default values for shade, depth and insides 
  16305.     
  16306.     are supplied automatically."
  16307.  
  16308.     | aBox |
  16309.     aBox := self new.
  16310.     aBox dimensions: nil.
  16311.     aBox
  16312.         assignFrom: startingPt
  16313.         through: midPt
  16314.         to: endingPt.
  16315.     ^aBox! !
  16316.  
  16317. Object subclass: #Incrementer
  16318.     instanceVariableNames: 'position maximumSize aString '
  16319.     classVariableNames: ''
  16320.     poolDictionaries: ''
  16321.     category: 'Build'!
  16322.  
  16323. !Incrementer methodsFor: 'accessing'!
  16324. currentLetter
  16325.  
  16326.      position > maximumSize
  16327.  
  16328.           ifTrue: [^$@]
  16329.  
  16330.           ifFalse: [^aString at: position]! !
  16331.  
  16332. !Incrementer methodsFor: 'accessing'!
  16333. currentPosition
  16334.  
  16335.      ^position! !
  16336.  
  16337. !Incrementer methodsFor: 'accessing'!
  16338. newPosition: value
  16339.  
  16340.      position := value! !
  16341.  
  16342. !Incrementer methodsFor: 'accessing'!
  16343. nextLetter
  16344.  
  16345.      position := position + 1.
  16346.  
  16347.      position > maximumSize
  16348.  
  16349.           ifTrue: [^$@]
  16350.  
  16351.           ifFalse: [^aString at: position]! !
  16352.  
  16353. !Incrementer methodsFor: 'initialize'!
  16354. startWith: whatever 
  16355.  
  16356.      aString := whatever.
  16357.  
  16358.      maximumSize := aString size.
  16359.  
  16360.      position := 1! !
  16361.  
  16362. Object subclass: #Transition
  16363.     instanceVariableNames: 'transitionName startActivity endActivity lowerBound upperBound guard action arc depth name instanceOfName offspring active hasChannelEvent defaultDestinationAssignments defaultSourceAssignments sourceList destinationList tempResult tempDict detailWindow shared '
  16364.     classVariableNames: ''
  16365.     poolDictionaries: ''
  16366.     category: 'Build'!
  16367.  
  16368. !Transition methodsFor: 'determining function'!
  16369. findAV: anActivity withDefault: aDictionary ofTTM: aTTM 
  16370.     | def defAct children ass |
  16371.     (aTTM activitytree parentOf: anActivity) collectionType = #cluster ifTrue: [tempResult add: anActivity].
  16372.     children := aTTM activitytree allImmediateChildrenOf: anActivity.
  16373.     anActivity collectionType = #parallel
  16374.         ifTrue: [children do: [:act2 | self
  16375.                     findAV: act2
  16376.                     withDefault: aDictionary
  16377.                     ofTTM: aTTM]]
  16378.         ifFalse: [children isEmpty
  16379.                 ifFalse: 
  16380.                     [(defAct := aDictionary at: ((children at: 1) av at: 1)
  16381.                                 ifAbsent: []) isNil
  16382.                         ifTrue: [children do: [:x | x default ifTrue: [def := x]]]
  16383.                         ifFalse: 
  16384.                             [def := defAct.
  16385.                             ass := Association new.
  16386.                             ass key: (def av at: 1)
  16387.                                 value: def.
  16388.                             tempDict add: ass].
  16389.                     def isNil
  16390.                         ifTrue: [^nil]
  16391.                         ifFalse: [self
  16392.                                 findAV: def
  16393.                                 withDefault: aDictionary
  16394.                                 ofTTM: aTTM]]]! !
  16395.  
  16396. !Transition methodsFor: 'determining function'!
  16397. findAVSource: anActivity withDefault: aDictionary ofTTM: aTTM 
  16398.     |  defAct children p flag  |
  16399.     p := aTTM activitytree parentOf: anActivity.
  16400.     p notNil
  16401.         ifTrue: [flag := p collectionType = #cluster]
  16402.         ifFalse: [flag := true].
  16403.     flag = true ifTrue: [tempResult add: anActivity].
  16404.     anActivity collectionType = #cluster
  16405.         ifTrue: [(defAct := aDictionary at: (anActivity selfAV at: 1)
  16406.                         ifAbsent: [^nil]) isNil ifFalse: [self
  16407.                     findAVSource: defAct
  16408.                     withDefault: aDictionary
  16409.                     ofTTM: aTTM]]
  16410.         ifFalse: 
  16411.             [children := aTTM activitytree allImmediateChildrenOf: anActivity.
  16412.             children do: [:act2 | self
  16413.                     findAVSource: act2
  16414.                     withDefault: aDictionary
  16415.                     ofTTM: aTTM]]! !
  16416.  
  16417. !Transition methodsFor: 'determining function'!
  16418. newGuard
  16419.     | temp sList |
  16420.     sList := OrderedCollection new.
  16421.     (defaultSourceAssignments size) = 0
  16422.         ifTrue: [^nil]
  16423.         ifFalse: [sList := defaultSourceAssignments values].
  16424.     temp := ((sList at: 1) av at: 1)
  16425.                 , '=' , (sList at: 1) myName.
  16426.     2 to: sList size do: [:x | temp := temp , ',' , ((sList at: x) av at: 1) , '=' , (sList at: x) myName].
  16427.     ^temp! !
  16428.  
  16429. !Transition methodsFor: 'determining function'!
  16430. transformationFunction! !
  16431.  
  16432. !Transition methodsFor: 'determining function'!
  16433. transformationFunctionInTTM: aTTM 
  16434.     | temp dList |
  16435.     tempResult := OrderedCollection new.
  16436.     tempDict := Dictionary new.
  16437.     defaultDestinationAssignments isNil ifTrue: [defaultDestinationAssignments := Dictionary new].
  16438.     self
  16439.         findAV: endActivity
  16440.         withDefault: defaultDestinationAssignments
  16441.         ofTTM: aTTM.
  16442.     dList := tempResult.
  16443.     temp := ((dList at: 1) av at: 1)
  16444.                 , ':' , (dList at: 1) myName.
  16445.     2 to: dList size do: [:x | temp := temp , ',' , ((dList at: x) av at: 1) , ':' , (dList at: x) myName].
  16446.     ^temp! !
  16447.  
  16448. !Transition methodsFor: 'accessing'!
  16449. activate
  16450.  
  16451.      active := True! !
  16452.  
  16453. !Transition methodsFor: 'accessing'!
  16454. active
  16455.  
  16456.      ^active! !
  16457.  
  16458. !Transition methodsFor: 'accessing'!
  16459. boundLower
  16460.     "Return the lower bound for the transition."
  16461.  
  16462.     ^lowerBound! !
  16463.  
  16464. !Transition methodsFor: 'accessing'!
  16465. boundLower: time 
  16466.     "Assign the lower bound for the transition."
  16467.  
  16468.     lowerBound := time! !
  16469.  
  16470. !Transition methodsFor: 'accessing'!
  16471. boundUpper
  16472.     "Return the upper bound for the transition."
  16473.  
  16474.     ^upperBound! !
  16475.  
  16476. !Transition methodsFor: 'accessing'!
  16477. boundUpper: time 
  16478.     "Assign the upper bound for the transition."
  16479.  
  16480.     upperBound := time! !
  16481.  
  16482. !Transition methodsFor: 'accessing'!
  16483. deactivate
  16484.  
  16485.      active := False! !
  16486.  
  16487. !Transition methodsFor: 'accessing'!
  16488. defaultDestinationAssignments
  16489.     ^defaultDestinationAssignments! !
  16490.  
  16491. !Transition methodsFor: 'accessing'!
  16492. defaultDestinationAssignments: aDictionary 
  16493.     defaultDestinationAssignments := aDictionary! !
  16494.  
  16495. !Transition methodsFor: 'accessing'!
  16496. defaultSourceAssignments
  16497.     ^defaultSourceAssignments! !
  16498.  
  16499. !Transition methodsFor: 'accessing'!
  16500. defaultSourceAssignments: aDictionary 
  16501.     defaultSourceAssignments := aDictionary! !
  16502.  
  16503. !Transition methodsFor: 'accessing'!
  16504. depth
  16505.  
  16506.      ^depth! !
  16507.  
  16508. !Transition methodsFor: 'accessing'!
  16509. depth: newDepth 
  16510.  
  16511.      depth := newDepth! !
  16512.  
  16513. !Transition methodsFor: 'accessing'!
  16514. destinationList
  16515.  
  16516.      ^destinationList! !
  16517.  
  16518. !Transition methodsFor: 'accessing'!
  16519. destinationList: this 
  16520.  
  16521.      destinationList := this! !
  16522.  
  16523. !Transition methodsFor: 'accessing'!
  16524. detailWindow
  16525.     ^detailWindow! !
  16526.  
  16527. !Transition methodsFor: 'accessing'!
  16528. detailWindow: aDetailWindow 
  16529.     detailWindow := aDetailWindow! !
  16530.  
  16531. !Transition methodsFor: 'accessing'!
  16532. endingAt
  16533.  
  16534.      "Return the activity that the transition ends at."
  16535.  
  16536.  
  16537.  
  16538.      ^endActivity! !
  16539.  
  16540. !Transition methodsFor: 'accessing'!
  16541. endingAt: anActivity
  16542.  
  16543.      "Assign the activity that the transition ends at."
  16544.  
  16545.  
  16546.  
  16547.      endActivity := anActivity.! !
  16548.  
  16549. !Transition methodsFor: 'accessing'!
  16550. getDestForAV: anAVName 
  16551.  
  16552.      destinationList do: [:x | (x at: 1)
  16553.  
  16554.                = anAVName ifTrue: [^x at: 2]].
  16555.  
  16556.      ^nil! !
  16557.  
  16558. !Transition methodsFor: 'accessing'!
  16559. instanceOfName
  16560.  
  16561.      ^instanceOfName! !
  16562.  
  16563. !Transition methodsFor: 'accessing'!
  16564. instanceOfName: aNumber 
  16565.  
  16566.      instanceOfName := aNumber! !
  16567.  
  16568. !Transition methodsFor: 'accessing'!
  16569. myAction
  16570.  
  16571.      "Return the action for the current Transition"
  16572.  
  16573.  
  16574.  
  16575.      ^action! !
  16576.  
  16577. !Transition methodsFor: 'accessing'!
  16578. myAction: newAction
  16579.  
  16580.      "Assign the action for the current Transition"
  16581.  
  16582.  
  16583.  
  16584.      action := newAction.! !
  16585.  
  16586. !Transition methodsFor: 'accessing'!
  16587. myArc
  16588.  
  16589.      ^arc! !
  16590.  
  16591. !Transition methodsFor: 'accessing'!
  16592. myArc: newArc 
  16593.  
  16594.      arc := newArc! !
  16595.  
  16596. !Transition methodsFor: 'accessing'!
  16597. myGuard
  16598.  
  16599.      "Return the guard for the current Transition"
  16600.  
  16601.  
  16602.  
  16603.      ^guard! !
  16604.  
  16605. !Transition methodsFor: 'accessing'!
  16606. myGuard: newGuard
  16607.  
  16608.      "Assign the guard for the current Transition"
  16609.  
  16610.  
  16611.  
  16612.      guard := newGuard.! !
  16613.  
  16614. !Transition methodsFor: 'accessing'!
  16615. myName
  16616.  
  16617.      "Return the name of the current Transition"
  16618.  
  16619.  
  16620.  
  16621.      ^transitionName! !
  16622.  
  16623. !Transition methodsFor: 'accessing'!
  16624. myName: givenName
  16625.  
  16626.      "Assign the name of the current Transition"
  16627.  
  16628.  
  16629.  
  16630.      transitionName := givenName.! !
  16631.  
  16632. !Transition methodsFor: 'accessing'!
  16633. shared
  16634.     ^shared! !
  16635.  
  16636. !Transition methodsFor: 'accessing'!
  16637. shared: aBoolean 
  16638.     shared := aBoolean! !
  16639.  
  16640. !Transition methodsFor: 'accessing'!
  16641. sourceList
  16642.  
  16643.      ^sourceList! !
  16644.  
  16645. !Transition methodsFor: 'accessing'!
  16646. sourceList: this 
  16647.  
  16648.      sourceList := this! !
  16649.  
  16650. !Transition methodsFor: 'accessing'!
  16651. startingAt
  16652.  
  16653.      "Return the activity that the transition starts at."
  16654.  
  16655.  
  16656.  
  16657.      ^startActivity! !
  16658.  
  16659. !Transition methodsFor: 'accessing'!
  16660. startingAt: anActivity
  16661.  
  16662.      "Assign the activity that the transition starts at."
  16663.  
  16664.  
  16665.  
  16666.      startActivity := anActivity.! !
  16667.  
  16668. !Transition methodsFor: 'cross product'!
  16669. commonModifiedVariablesWith: aTransition
  16670.     | c1 c2 s1 s2 ind result |
  16671.     result := SortedCollection new.
  16672.     c1 := self modifiedVariables.
  16673.     c2 := aTransition modifiedVariables.
  16674.     s1 := c1 size.
  16675.     s2 := c2 size.
  16676.     s2 == 0 | (s1 == 0) ifTrue: [^nil].
  16677.     ind := 1.
  16678.     c1
  16679.         do: 
  16680.             [:t1 | 
  16681.             [t1 > (c2 at: ind)]
  16682.                 whileTrue: 
  16683.                     [ind := ind + 1.
  16684.                     ind > s2 ifTrue: [^result]].
  16685.             t1 = (c2 at: ind) ifTrue: [result add: t1]].
  16686.     ^result! !
  16687.  
  16688. !Transition methodsFor: 'cross product'!
  16689. crossWith: aTransition 
  16690.     | newGuard newTransformationFunction newName result temp t1 t2 newUp newLow |
  16691.     temp := self commonModifiedVariablesWith: aTransition.
  16692.     newGuard := self myGuard , ',' , aTransition myGuard.
  16693.     newName := 'test'.
  16694.     newTransformationFunction := self myAction , ',' , aTransition myAction.
  16695.     t1 := self boundUpper.
  16696.     t2 := aTransition boundUpper.
  16697.     t1 = 'infinity'
  16698.         ifTrue: [t2 ~= 'infinity'
  16699.                 ifTrue: [newUp := t2]
  16700.                 ifFalse: [newUp := 'infinity']]
  16701.         ifFalse: [t2 = 'infinity'
  16702.                 ifTrue: [newUp := t1]
  16703.                 ifFalse: [t2 < t1
  16704.                         ifTrue: [newUp := t2]
  16705.                         ifFalse: [newUp := t1]]].
  16706.     t1 := self boundLower.
  16707.     t2 := aTransition boundLower.
  16708.     t1 < t2
  16709.         ifTrue: [newLow := t2]
  16710.         ifFalse: [newLow := t1].
  16711.     result := Transition
  16712.                 name: newName
  16713.                 startAt: nil
  16714.                 endAt: nil
  16715.                 upper: newUp
  16716.                 lower: newLow
  16717.                 guard: newGuard
  16718.                 action: newTransformationFunction.
  16719.     self deactivate.
  16720.     aTransition deactivate.
  16721.     ^result! !
  16722.  
  16723. !Transition methodsFor: 'cross product'!
  16724. modifiedVariables
  16725.     "return the names of the modified variables in the 
  16726.     
  16727.     transformation 
  16728.     
  16729.     function"
  16730.  
  16731.     | temp result |
  16732.     result := SortedCollection new.
  16733.     temp := ''.
  16734.     action do: [:x | x == $:
  16735.             ifTrue: 
  16736.                 [result add: temp.
  16737.                 temp := '']
  16738.             ifFalse: [x == $, ifFalse: [temp := temp , x asSymbol asString]
  16739.                     ifTrue: [temp := '']]].
  16740.     ^result! !
  16741.  
  16742. !Transition methodsFor: 'testing'!
  16743. containsThis: argument 
  16744.     | found |
  16745.     found := (self myGuard asString findString: argument startingAt: 1)
  16746.                 ~= 0.
  16747.     found = false ifTrue: [found := (self myAction asString findString: argument startingAt: 1)
  16748.                     ~= 0].
  16749.     ^found! !
  16750.  
  16751. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  16752.  
  16753. Transition class
  16754.     instanceVariableNames: ''!
  16755.  
  16756. !Transition class methodsFor: 'instance creation'!
  16757. name: givenName startAt: activity1 endAt: activity2 upper: uTime lower: lTime guard: newGuard action: newAction 
  16758.     "Create an instance of a Transition with the arguments 
  16759.     
  16760.     name, activity1, and activity2 as the transition name, 
  16761.     
  16762.     starting activity and ending activity respectively. 
  16763.     
  16764.     The upper and lower bounds, the guard and the action 
  16765.     
  16766.     are assigned defaults 
  16767.     
  16768.     for now."
  16769.  
  16770.     | newTransition |
  16771.     newTransition := self new.
  16772.     newTransition myName: givenName.
  16773.     newTransition startingAt: activity1.
  16774.     newTransition endingAt: activity2.
  16775.     newTransition boundLower: lTime.
  16776.     newTransition boundUpper: uTime.
  16777.     newTransition myGuard: newGuard.
  16778.     newTransition myAction: newAction.
  16779.     newTransition myArc: nil.
  16780.     newTransition depth: #hidden.
  16781.     newTransition shared: false.
  16782.     ^newTransition! !
  16783.  
  16784. Model subclass: #TTM
  16785.     instanceVariableNames: 'ttmName note activityTree transitionList activityVariables dataVariables initialCondition specificIC commChannels stateFormulas currentAVCs openWindows temporary currentlyDisplayedSimulateVariables simulateWindow hiddenTransitions tempResult transitionDictionary '
  16786.     classVariableNames: ''
  16787.     poolDictionaries: ''
  16788.     category: 'Build'!
  16789. TTM comment:
  16790. 'Some Notes on the instance variables for this class:
  16791.  
  16792.    currentAVCS = a list used in processing transitions to keep
  16793.  
  16794. track of those
  16795.  
  16796.  guards/functions that have already been used in a previous
  16797.  
  16798. transition of
  16799.  
  16800.  a set of shared transitions. We do this to avoid duplication in
  16801.  
  16802. code
  16803.  
  16804.  generation of certain guard/function elements pertaining to
  16805.  
  16806. activity
  16807.  
  16808.  variables.'!
  16809.  
  16810. TTM comment:
  16811. 'Some Notes on the instance variables for this class:
  16812.  
  16813.    currentAVCS = a list used in processing transitions to keep
  16814.  
  16815. track of those
  16816.  
  16817.  guards/functions that have already been used in a previous
  16818.  
  16819. transition of
  16820.  
  16821.  a set of shared transitions. We do this to avoid duplication in
  16822.  
  16823. code
  16824.  
  16825.  generation of certain guard/function elements pertaining to
  16826.  
  16827. activity
  16828.  
  16829.  variables.'!
  16830.  
  16831. !TTM methodsFor: 'initialize-release'!
  16832. initialize: givenName with: variable 
  16833.     "Initialize the components of the newly created TTM"
  16834.  
  16835.     self named: givenName.
  16836.     activityTree := ActivityTree new.
  16837.     activityTree createRoot: givenName.
  16838.     transitionList := TransitionList new.
  16839.     activityVariables := OrderedCollection new.
  16840.     self activityvariable: variable initial: 'True'.
  16841.     activityTree getRoot av: (self activityvariable at: 1).
  16842.     activityTree getRoot selfAV: (self activityvariable at: 1).
  16843.       activityTree getRoot hasAV: true.
  16844.     self initialcondition: 'nil'.
  16845.     self note: String new.
  16846.     dataVariables := OrderedCollection new.
  16847.     commChannels := OrderedCollection new.
  16848.     stateFormulas := OrderedCollection new.
  16849.     specificIC := OrderedCollection new.
  16850.     openWindows := Array
  16851.                 with: 0
  16852.                 with: 0
  16853.                 with: 0
  16854.                 with: 0! !
  16855.  
  16856. !TTM methodsFor: 'obsolete'!
  16857. avValuesAt: source 
  16858.     "Return the set of activity variables and values for 
  16859.     
  16860.     the given activity called source. There may be 
  16861.     
  16862.     repetitions and there may be multiple values 
  16863.     
  16864.     possible for a given activity variable."
  16865.  
  16866.     | typeOfAV count current ancestorList currentAncestor completeSetOfValues |
  16867.     completeSetOfValues := OrderedCollection new.
  16868.     ancestorList := self activitytree ancestorListOf: source.
  16869.     ancestorList removeLast.
  16870.     count := ancestorList size.
  16871.     [count > 0]
  16872.         whileTrue: 
  16873.             [currentAncestor := ancestorList at: count.
  16874.             typeOfAV := self typeForAV: currentAncestor av.
  16875.             (typeOfAV includes: currentAncestor)
  16876.                 ifTrue: [completeSetOfValues add: (Array with: currentAncestor av with: currentAncestor myName)].
  16877.             count := count - 1].
  16878.     typeOfAV := self typeForAV: source av.
  16879.     (typeOfAV includes: source)
  16880.         ifTrue: [completeSetOfValues add: (Array with: source av with: source myName)]
  16881.         ifFalse: 
  16882.             [count := 1.
  16883.             [count > typeOfAV size]
  16884.                 whileFalse: 
  16885.                     [current := typeOfAV at: count.
  16886.                     (self activitytree is: source anAncestorOf: current)
  16887.                         ifTrue: [completeSetOfValues add: (Array with: source av with: current myName)].
  16888.                     count := count + 1]].
  16889.     ^completeSetOfValues! !
  16890.  
  16891. !TTM methodsFor: 'accessing'!
  16892. activitytree
  16893.  
  16894.      ^activityTree! !
  16895.  
  16896. !TTM methodsFor: 'accessing'!
  16897. activitytree: newTree
  16898.  
  16899.      activityTree := newTree! !
  16900.  
  16901. !TTM methodsFor: 'accessing'!
  16902. activityvariable
  16903.  
  16904.      "Return the activity variable of the TTM, self."
  16905.  
  16906.  
  16907.  
  16908.      ^activityVariables! !
  16909.  
  16910. !TTM methodsFor: 'accessing'!
  16911. activityvariable: wholeSet 
  16912.  
  16913.      activityVariables := wholeSet! !
  16914.  
  16915. !TTM methodsFor: 'accessing'!
  16916. activityvariable: newVariable initial: initialValue 
  16917.     "Assign a activity variable of the TTM, self."
  16918.  
  16919.     activityVariables add: (Array with: newVariable with: initialValue)! !
  16920.  
  16921. !TTM methodsFor: 'accessing'!
  16922. commchannel
  16923.  
  16924.      ^commChannels! !
  16925.  
  16926. !TTM methodsFor: 'accessing'!
  16927. commchannel: newChannel 
  16928.  
  16929.      commChannels add: (Array with: newChannel)! !
  16930.  
  16931. !TTM methodsFor: 'accessing'!
  16932. currentlyDisplayedSimulateVariables
  16933.  
  16934.      ^currentlyDisplayedSimulateVariables! !
  16935.  
  16936. !TTM methodsFor: 'accessing'!
  16937. currentlyDisplayedSimulateVariables: anArray 
  16938.  
  16939.      currentlyDisplayedSimulateVariables := anArray! !
  16940.  
  16941. !TTM methodsFor: 'accessing'!
  16942. datavariable
  16943.  
  16944.      "Return the data variables of the TTM, self."
  16945.  
  16946.  
  16947.  
  16948.      ^dataVariables! !
  16949.  
  16950. !TTM methodsFor: 'accessing'!
  16951. datavariable: wholeSet 
  16952.  
  16953.      dataVariables := wholeSet! !
  16954.  
  16955. !TTM methodsFor: 'accessing'!
  16956. datavariable: newVariable lrange: low hrange: high initial:
  16957.  
  16958. initialValue 
  16959.  
  16960.      "Assign a data variable of the TTM, self."
  16961.  
  16962.  
  16963.  
  16964.      dataVariables add: (Array
  16965.  
  16966.                with: newVariable
  16967.  
  16968.                with: low
  16969.  
  16970.                with: high
  16971.  
  16972.                   with: initialValue)! !
  16973.  
  16974. !TTM methodsFor: 'accessing'!
  16975. defaultOfAV: existingAV 
  16976.     | p |
  16977.     p := self anExistingAVsPosition: existingAV.
  16978.     (self typeForAV: (activityVariables at: p))
  16979.         do: [:x | x default = true ifTrue: [^x myName]].
  16980.     ^nil! !
  16981.  
  16982. !TTM methodsFor: 'accessing'!
  16983. initialcondition
  16984.  
  16985.      ^initialCondition! !
  16986.  
  16987. !TTM methodsFor: 'accessing'!
  16988. initialcondition: newcondition 
  16989.  
  16990.      initialCondition := newcondition! !
  16991.  
  16992. !TTM methodsFor: 'accessing'!
  16993. named
  16994.     "Return the name of the TTM, self."
  16995.  
  16996.     ^ttmName! !
  16997.  
  16998. !TTM methodsFor: 'accessing'!
  16999. named: newName
  17000.  
  17001.      "Assign the name of the TTM, self."
  17002.  
  17003.  
  17004.  
  17005.      ttmName := newName.! !
  17006.  
  17007. !TTM methodsFor: 'accessing'!
  17008. note
  17009.     ^note! !
  17010.  
  17011. !TTM methodsFor: 'accessing'!
  17012. note: aNote 
  17013.  
  17014.      note := aNote! !
  17015.  
  17016. !TTM methodsFor: 'accessing'!
  17017. openWindows
  17018.     ^openWindows! !
  17019.  
  17020. !TTM methodsFor: 'accessing'!
  17021. openWindows: newWindows
  17022.  
  17023.      openWindows := newWindows! !
  17024.  
  17025. !TTM methodsFor: 'accessing'!
  17026. simulateWindow
  17027.  
  17028.      ^simulateWindow! !
  17029.  
  17030. !TTM methodsFor: 'accessing'!
  17031. simulateWindow: aWindow 
  17032.  
  17033.      simulateWindow := aWindow! !
  17034.  
  17035. !TTM methodsFor: 'accessing'!
  17036. specificIC
  17037.  
  17038.      ^specificIC! !
  17039.  
  17040. !TTM methodsFor: 'accessing'!
  17041. specificIC: newIC
  17042.  
  17043.      specificIC := newIC! !
  17044.  
  17045. !TTM methodsFor: 'accessing'!
  17046. stateFormulas
  17047.  
  17048.      ^stateFormulas! !
  17049.  
  17050. !TTM methodsFor: 'accessing'!
  17051. stateFormulas: completelyNew 
  17052.  
  17053.      stateFormulas := completelyNew! !
  17054.  
  17055. !TTM methodsFor: 'accessing'!
  17056. stateFormulas: sfNumber holding: newFormula
  17057.  
  17058.      stateFormulas add: (Array with: sfNumber with: newFormula)! !
  17059.  
  17060. !TTM methodsFor: 'accessing'!
  17061. transitionlist
  17062.  
  17063. ^transitionList! !
  17064.  
  17065. !TTM methodsFor: 'accessing'!
  17066. transitionlist: newList 
  17067.  
  17068.      transitionList := newList! !
  17069.  
  17070. !TTM methodsFor: 'variable maintenance'!
  17071. anExistingActivityName: aString 
  17072.     ^activityTree activityNames includes: aString! !
  17073.  
  17074. !TTM methodsFor: 'variable maintenance'!
  17075. anExistingAV2: aString 
  17076.     "Return true if aString is one of the existing activity 
  17077.     
  17078.     variables of the TTM."
  17079.  
  17080.     self activityvariable do: [:x | aString = (x at: 1) ifTrue: [^true]].
  17081.     ^false! !
  17082.  
  17083. !TTM methodsFor: 'variable maintenance'!
  17084. anExistingAV: aString 
  17085.     "Return true if aString is one of the existing activity 
  17086.     
  17087.     variables of the TTM."
  17088.  
  17089.     | found count existingAV |
  17090.     found := false.
  17091.     self activityvariable size = 0
  17092.         ifFalse: 
  17093.             [count := 1.
  17094.             self activityvariable size
  17095.                 timesRepeat: 
  17096.                     [existingAV := self activityvariable at: count.
  17097.                     aString = (existingAV at: 1) ifTrue: [found := true].
  17098.                     count := count + 1]].
  17099.     ^found! !
  17100.  
  17101. !TTM methodsFor: 'variable maintenance'!
  17102. anExistingAVsPosition: aString 
  17103.     | count existingAV |
  17104.     self activityvariable size = 0
  17105.         ifFalse: 
  17106.             [count := 1.
  17107.             self activityvariable size
  17108.                 timesRepeat: 
  17109.                     [existingAV := self activityvariable at: count.
  17110.                     aString = (existingAV at: 1) ifTrue: [^count].
  17111.                     count := count + 1]].
  17112.     ^nil! !
  17113.  
  17114. !TTM methodsFor: 'variable maintenance'!
  17115. anExistingCh: aString 
  17116.     "Return true if aString is one of the existing comm. 
  17117.     
  17118.     channels of the TTM."
  17119.  
  17120.     | found count existingCh |
  17121.     found := false.
  17122.     self commchannel size = 0
  17123.         ifFalse: 
  17124.             [count := 1.
  17125.             self commchannel size
  17126.                 timesRepeat: 
  17127.                     [existingCh := self commchannel at: count.
  17128.                     aString = (existingCh at: 1) ifTrue: [found := true].
  17129.                     count := count + 1]].
  17130.     ^found! !
  17131.  
  17132. !TTM methodsFor: 'variable maintenance'!
  17133. anExistingDV2: aString 
  17134.     "Return true if aString is one of the existing activity 
  17135.     
  17136.     variables of the TTM."
  17137.  
  17138.     self datavariable do: [:x | aString = (x at: 1) ifTrue: [^true]].
  17139.     ^false! !
  17140.  
  17141. !TTM methodsFor: 'variable maintenance'!
  17142. anExistingDV: aString 
  17143.     "Return true if aString is one of the existing data 
  17144.     
  17145.     variables of the TTM."
  17146.  
  17147.     | found count existingDV |
  17148.     found := false.
  17149.     self datavariable size = 0
  17150.         ifFalse: 
  17151.             [count := 1.
  17152.             self datavariable size
  17153.                 timesRepeat: 
  17154.                     [existingDV := self datavariable at: count.
  17155.                     aString = (existingDV at: 1) ifTrue: [found := true].
  17156.                     count := count + 1]].
  17157.     ^found! !
  17158.  
  17159. !TTM methodsFor: 'variable maintenance'!
  17160. anExistingDVsPosition: aString 
  17161.  
  17162.     "Return position if aString is one of the existing data 
  17163.  
  17164.     variables of the TTM."
  17165.  
  17166.  
  17167.  
  17168.     | count existingDV |
  17169.  
  17170.     self datavariable size = 0
  17171.  
  17172.         ifFalse: 
  17173.  
  17174.             [count := 1.
  17175.  
  17176.             self datavariable size
  17177.  
  17178.                 timesRepeat: 
  17179.  
  17180.                     [existingDV := self datavariable at: count.
  17181.  
  17182.                     aString = (existingDV at: 1) ifTrue: [^count].
  17183.  
  17184.                     count := count + 1]].
  17185.  
  17186.     ^nil! !
  17187.  
  17188. !TTM methodsFor: 'variable maintenance'!
  17189. anExistingSF: aString 
  17190.     | found count existingSF |
  17191.     found := false.
  17192.     self stateFormulas size = 0
  17193.         ifFalse: 
  17194.             [count := 1.
  17195.             self stateFormulas size
  17196.                 timesRepeat: 
  17197.                     [existingSF := self stateFormulas at: count.
  17198.                     aString = (existingSF at: 1) ifTrue: [found := true].
  17199.                     count := count + 1]].
  17200.     ^found! !
  17201.  
  17202. !TTM methodsFor: 'variable maintenance'!
  17203. anExistingV: aString 
  17204.     "Return true if aString is one of the existing 
  17205.     
  17206.     variables of the TTM."
  17207.  
  17208.     (self anExistingAV: aString)
  17209.         ifTrue: [^true]
  17210.         ifFalse: [^self anExistingDV: aString]! !
  17211.  
  17212. !TTM methodsFor: 'variable maintenance'!
  17213. changeAllAVsAt: start from: oldAV to: newAV 
  17214.     "Because each activity has a pointer to an object 
  17215.     
  17216.     and not an object itself, we must replace all of 
  17217.     
  17218.     those pointers."
  17219.  
  17220.     start left ~= nil ifTrue: [self
  17221.             changeAllAVsAt: start left
  17222.             from: oldAV
  17223.             to: newAV].
  17224.     start right ~= nil ifTrue: [self
  17225.             changeAllAVsAt: start right
  17226.             from: oldAV
  17227.             to: newAV].
  17228.     start av = oldAV ifTrue: [start av: newAV]! !
  17229.  
  17230. !TTM methodsFor: 'variable maintenance'!
  17231. changeDefaultForAV: anAV to: anActivity 
  17232.     activityVariables do: [:x | (x at: 1)  = anAV 
  17233.             ifTrue: 
  17234.                 [x at: 2 put: anActivity myName.
  17235.                 ^nil]]! !
  17236.  
  17237. !TTM methodsFor: 'variable maintenance'!
  17238. checkAllAVsStillUsed
  17239.     | count currentAV |
  17240.     count := 1.
  17241.     [count > self activityvariable size]
  17242.         whileFalse: 
  17243.             [currentAV := (self activityvariable at: count)
  17244.                         at: 1.
  17245.             temporary := false.
  17246.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  17247.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  17248.                 ifTrue: [count := count + 1] ]! !
  17249.  
  17250. !TTM methodsFor: 'variable maintenance'!
  17251. checkAllAVsStillUsedNew
  17252.     | count currentAV |
  17253.     count := 1.
  17254.     [count > self activityvariable size]
  17255.         whileFalse: 
  17256.             [currentAV := (self activityvariable at: count)
  17257.                         at: 1.
  17258.             temporary := false.
  17259.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  17260.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  17261.                 ifTrue: [count := count + 1] ]! !
  17262.  
  17263. !TTM methodsFor: 'variable maintenance'!
  17264. checkAllAVsStillUsedOld
  17265.     | count currentAV |
  17266.     count := 1.
  17267.     [count > self activityvariable size]
  17268.         whileFalse: 
  17269.             [currentAV := (self activityvariable at: count)
  17270.                         at: 1.
  17271.             temporary := false.
  17272.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  17273.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  17274.                 ifTrue: [count := count + 1] ]! !
  17275.  
  17276. !TTM methodsFor: 'variable maintenance'!
  17277. isInAVRange: aString of: anAVname 
  17278.  
  17279.     | position |
  17280.  
  17281.     position := self anExistingAVsPosition: anAVname.
  17282.  
  17283.     position notNil ifTrue: [^self name: aString alreadyExistsFor: (self activityvariable at: position)].
  17284.  
  17285.     ^false! !
  17286.  
  17287. !TTM methodsFor: 'variable maintenance'!
  17288. isInDVRange: initial of: aDVname 
  17289.  
  17290.     | position newval lowRange highRange lowval highval |
  17291.  
  17292.     position := self anExistingDVsPosition: aDVname.
  17293.  
  17294.     position notNil ifFalse: [^false]
  17295.  
  17296.         ifTrue: 
  17297.  
  17298.             [initial ~= 'infinity' & (initial ~= '-infinity' & (TTMList aValidNumber: initial)) ifFalse: [^false].
  17299.  
  17300.             newval := TTMList convertToNumber: initial.
  17301.  
  17302.             lowRange := (self datavariable at: position)
  17303.  
  17304.                         at: 2.
  17305.  
  17306.             highRange := (self datavariable at: position)
  17307.  
  17308.                         at: 3.
  17309.  
  17310.             lowRange ~= '-infinity'
  17311.  
  17312.                 ifTrue: 
  17313.  
  17314.                     [lowval := TTMList convertToNumber: lowRange.
  17315.  
  17316.                     lowval > newval ifTrue: [^false]].
  17317.  
  17318.             highRange ~= 'infinity'
  17319.  
  17320.                 ifTrue: 
  17321.  
  17322.                     [highval := TTMList convertToNumber: highRange.
  17323.  
  17324.                     highval < newval ifTrue: [^false]]].
  17325.  
  17326.     ^true! !
  17327.  
  17328. !TTM methodsFor: 'variable maintenance'!
  17329. markActivitiesUnexposed
  17330.  
  17331.     | temp |
  17332.  
  17333.     temp := self activitytree getRoot.
  17334.  
  17335.     [temp notNil]
  17336.  
  17337.         whileTrue: 
  17338.  
  17339.             [temp exposed: False.
  17340.  
  17341.             self markKidsUnexposed: temp.
  17342.  
  17343.             temp := temp right]! !
  17344.  
  17345. !TTM methodsFor: 'variable maintenance'!
  17346. markKidsUnexposed: anActivity 
  17347.  
  17348.     | temp |
  17349.  
  17350.     temp := anActivity left.
  17351.  
  17352.     [temp notNil]
  17353.  
  17354.         whileTrue: 
  17355.  
  17356.             [temp exposed: False.
  17357.  
  17358.             self markSiblingsUnexposed: temp.
  17359.  
  17360.             temp := temp left]! !
  17361.  
  17362. !TTM methodsFor: 'variable maintenance'!
  17363. markSiblingsUnexposed: anActivity 
  17364.  
  17365.     | temp |
  17366.  
  17367.     temp := anActivity right.
  17368.  
  17369.     [temp notNil]
  17370.  
  17371.         whileTrue: 
  17372.  
  17373.             [temp exposed: False.
  17374.  
  17375.             self markKidsUnexposed: temp.
  17376.  
  17377.             temp := temp right]! !
  17378.  
  17379. !TTM methodsFor: 'variable maintenance'!
  17380. removeActivityVariableNamed: aName 
  17381.     | newAVs |
  17382.     aName isNil ifTrue: [^nil].
  17383.     newAVs := OrderedCollection new.
  17384.     activityVariables do: [:x | (x at: 1)
  17385.             ~= aName ifTrue: [newAVs add: x]].
  17386.     activityVariables := newAVs.
  17387.     activityTree listOfActivities do: [:x | ((x selfAV) at: 1) = aName ifTrue: [ x hasAV: false]]! !
  17388.  
  17389. !TTM methodsFor: 'variable maintenance'!
  17390. specificIC: currentIC contains: oldName 
  17391.     "If true, it returns the value. If false 
  17392.     
  17393.     it returns nil"
  17394.  
  17395.     | c found value |
  17396.     c := 1.
  17397.     found := false.
  17398.     [c > currentIC size]
  17399.         whileFalse: 
  17400.             [((currentIC at: c)
  17401.                 at: 1)
  17402.                 = oldName
  17403.                 ifTrue: 
  17404.                     [value := (currentIC at: c)
  17405.                                 at: 2.
  17406.                     found := true].
  17407.             c := c + 1].
  17408.     found = false
  17409.         ifTrue: [^nil]
  17410.         ifFalse: [^value]! !
  17411.  
  17412. !TTM methodsFor: 'variable maintenance'!
  17413. typeForAV: anAV 
  17414.     "Return the set of activities that belong to this AV"
  17415.  
  17416.     | start |
  17417.     temporary := nil.
  17418.     self firstActivitywith: anAV from: self activitytree getRoot.
  17419.     start := temporary.
  17420.     start isNil ifTrue: [^nil].
  17421.     temporary := OrderedCollection new.
  17422.     self avElement: start usingOnly: anAV.
  17423.     temporary size = 0
  17424.         ifTrue: [^nil]
  17425.         ifFalse: [^temporary]! !
  17426.  
  17427. !TTM methodsFor: 'variable maintenance'!
  17428. typeForAVNamed2: aString 
  17429.  
  17430.     "Return the set of activities that belong to this AV"
  17431.  
  17432.  
  17433.  
  17434.     | p t list |
  17435.  
  17436.     list := OrderedCollection new.
  17437.  
  17438.     p := self anExistingAVsPosition: aString.
  17439.  
  17440.     t := self typeForAV: (activityVariables at: p).
  17441.  
  17442.     t do: [:act | list add: act].
  17443.  
  17444.     ^list! !
  17445.  
  17446. !TTM methodsFor: 'variable maintenance'!
  17447. typeForAVNamed3: aString 
  17448.     "Return the set of names of activities that belong to this 
  17449.     
  17450.     AV"
  17451.  
  17452.     | p t list |
  17453.     list := SortedCollection new.
  17454.     list sortBlock: [:x :y | x myName < y myName].
  17455.     p := self anExistingAVsPosition: aString.
  17456.     t := self typeForAV: (activityVariables at: p).
  17457.     t do: [:act | list add: act].
  17458.     ^list! !
  17459.  
  17460. !TTM methodsFor: 'variable maintenance'!
  17461. typeForAVNamed: aString 
  17462.     "Return the set of names of activities that belong to this 
  17463.     
  17464.     AV"
  17465.  
  17466.     | p t list |
  17467.     list := OrderedCollection new.
  17468.     p := self anExistingAVsPosition: aString.
  17469.     t := self typeForAV: (activityVariables at: p).
  17470.     t do: [:act | list add: act myName].
  17471.     ^list! !
  17472.  
  17473. !TTM methodsFor: 'variable maintenance'!
  17474. updateSpecificIC
  17475.     "This is called after deletion or addition of 
  17476.     
  17477.     a variable."
  17478.  
  17479.     | dataCount count currentIC oldName initialValue value actCount newCurrentIC temp |
  17480.     count := 1.
  17481.     [count > self specificIC size]
  17482.         whileFalse: 
  17483.             [currentIC := (self specificIC at: count)
  17484.                         at: 2.
  17485.             newCurrentIC := OrderedCollection new.
  17486.             actCount := 1.
  17487.             [actCount > self activityvariable size]
  17488.                 whileFalse: 
  17489.                     [oldName := (self activityvariable at: actCount)
  17490.                                 at: 1.
  17491.                     (temp := self typeForAV: (self activityvariable at: actCount)) notNil ifTrue: [initialValue := temp last myName].
  17492.                     value := self specificIC: currentIC contains: oldName.
  17493.                     value isNil ifTrue: [value := initialValue].
  17494.                     newCurrentIC add: (Array with: oldName with: value).
  17495.                     actCount := actCount + 1].
  17496.             dataCount := 1.
  17497.             [dataCount > self datavariable size]
  17498.                 whileFalse: 
  17499.                     [oldName := (self datavariable at: dataCount)
  17500.                                 at: 1.
  17501.                     initialValue := (self datavariable at: dataCount)
  17502.                                 at: 4.
  17503.                     value := self specificIC: currentIC contains: oldName.
  17504.                     value isNil ifTrue: [value := initialValue].
  17505.                     newCurrentIC add: (Array with: oldName with: value).
  17506.                     dataCount := dataCount + 1].
  17507.             (self specificIC at: count)
  17508.                 at: 2 put: newCurrentIC.
  17509.             count := count + 1]! !
  17510.  
  17511. !TTM methodsFor: 'variable maintenance'!
  17512. variableIsBeingUsed: vName 
  17513.  
  17514.     "Return true if the given variable is used within 
  17515.  
  17516.     initial condition, guard, or function of the TTM."
  17517.  
  17518.  
  17519.  
  17520.     | result count currentTr currentSF |
  17521.  
  17522.     result := false.
  17523.  
  17524.     (self initialcondition asString findString: vName startingAt: 1)
  17525.  
  17526.         ~= 0 ifTrue: [result := true].
  17527.  
  17528.     result = false
  17529.  
  17530.         ifTrue: 
  17531.  
  17532.             [count := 1.
  17533.  
  17534.             [count > self stateFormulas size]
  17535.  
  17536.                 whileFalse: 
  17537.  
  17538.                     [currentSF := (self stateFormulas at: count)
  17539.  
  17540.                                 at: 2.
  17541.  
  17542.                     (currentSF findString: vName startingAt: 1)
  17543.  
  17544.                         ~= 0 ifTrue: [result := true].
  17545.  
  17546.                     count := count + 1]].
  17547.  
  17548.     result = false
  17549.  
  17550.         ifTrue: 
  17551.  
  17552.             [count := 1.
  17553.  
  17554.             [count > self transitionlist size]
  17555.  
  17556.                 whileFalse: 
  17557.  
  17558.                     [currentTr := self transitionlist at: count.
  17559.  
  17560.                     (currentTr myGuard asString findString: vName startingAt: 1)
  17561.  
  17562.                         ~= 0 ifTrue: [result := true].
  17563.  
  17564.                     (currentTr myAction asString findString: vName startingAt: 1)
  17565.  
  17566.                         ~= 0 ifTrue: [result := true].
  17567.  
  17568.                     count := count + 1]].
  17569.  
  17570.     ^result! !
  17571.  
  17572. !TTM methodsFor: 'renaming support'!
  17573. collectTokensFrom: aString usingParser: aParser 
  17574.     | x t r |
  17575.     r := OrderedCollection new.
  17576.     x := aParser.
  17577.     x initScannerSource: aString.
  17578.     [(t := x nextTokenValue) ~= x endOfInputToken]
  17579.         whileTrue: 
  17580.             [r add: t.
  17581.             x scanner scanToken].
  17582.     ^r! !
  17583.  
  17584. !TTM methodsFor: 'ttm copier'!
  17585. aCopy
  17586.     | newTTM reformattedlist count dict currentTr newStart newEnd newTr newTree newAVs currentAV newAV newSIC temp1 temp2 |
  17587.     newTTM := self copy.
  17588.     newTree := self activitytree copy.
  17589.     newTree newRoot: self activitytree makeCopy.
  17590.     dict := newTree listOfActivities.
  17591.     temporary := self activitytree listOfActivities.
  17592.     newAVs := self copyActivityVariables.
  17593.     count := 1.
  17594.     [count > self activityvariable size]
  17595.         whileFalse: 
  17596.             [currentAV := self activityvariable at: count.
  17597.             newAV := newAVs at: count.
  17598.             self
  17599.                 change: currentAV
  17600.                 to: newAV
  17601.                 inSetOf: dict.
  17602.             count := count + 1].
  17603.     reformattedlist := TransitionList new.
  17604.     count := 1.
  17605.     [count > self transitionlist size]
  17606.         whileFalse: 
  17607.             [currentTr := self transitionlist at: count.
  17608.             newStart := dict at: (self copyNumberFor: currentTr startingAt).
  17609.             newEnd := dict at: (self copyNumberFor: currentTr endingAt).
  17610.             newTr := Transition
  17611.                         name: currentTr myName copy
  17612.                         startAt: newStart
  17613.                         endAt: newEnd
  17614.                         upper: currentTr boundUpper copy
  17615.                         lower: currentTr boundLower copy
  17616.                         guard: currentTr myGuard copy
  17617.                         action: currentTr myAction copy.
  17618.             newTr myArc: currentTr myArc makeCopy.
  17619.             newTr depth: currentTr depth copy.
  17620.             newTr shared: currentTr shared copy.
  17621.             newTr defaultDestinationAssignments: Dictionary new.
  17622.             newTr defaultSourceAssignments: Dictionary new.
  17623.             currentTr defaultDestinationAssignments notNil ifTrue: [currentTr defaultDestinationAssignments associations do: [:x | newTr defaultDestinationAssignments add: x key -> (dict at: (self copyNumberFor: x value))]].
  17624.             currentTr defaultSourceAssignments notNil ifTrue: [currentTr defaultSourceAssignments associations do: [:x | newTr defaultSourceAssignments add: x key -> (dict at: (self copyNumberFor: x value))]].
  17625.             reformattedlist add: newTr.
  17626.             count := count + 1].
  17627.     newTTM named: newTTM named copy.
  17628.     newTTM transitionlist: reformattedlist.
  17629.     newTTM activitytree: newTree.
  17630.     newTTM activityvariable: newAVs.
  17631.     newTTM datavariable: self copyDataVariables.
  17632.     newTTM initialcondition: self initialcondition copy.
  17633.     newTTM note: self note copy.
  17634.     newSIC := OrderedCollection new.
  17635.     self specificIC
  17636.         do: 
  17637.             [:x | 
  17638.             temp1 := Array new: 2.
  17639.             temp1 at: 1 put: (x at: 1) copy.
  17640.             temp2 := OrderedCollection new.
  17641.             (x at: 2)
  17642.                 do: [:y | temp2 add: y copy].
  17643.             temp1 at: 2 put: temp2.
  17644.             newSIC add: temp1].
  17645.     newTTM specificIC: newSIC.
  17646.     ^newTTM! !
  17647.  
  17648. !TTM methodsFor: 'ttm copier'!
  17649. change: oldav to: newav inSetOf: activities 
  17650.     | count current |
  17651.     count := 1.
  17652.     [count > activities size]
  17653.         whileFalse: 
  17654.             [current := activities at: count.
  17655.             (current av at: 1)
  17656.                 = (oldav at: 1) ifTrue: [current av: newav].
  17657.             count := count + 1]! !
  17658.  
  17659. !TTM methodsFor: 'ttm copier'!
  17660. copyActivityVariables
  17661.     "Return a new set of activity variables"
  17662.  
  17663.     | oldset count newset current e1 e2 element |
  17664.     oldset := self activityvariable.
  17665.     count := 1.
  17666.     newset := OrderedCollection new.
  17667.     [count > oldset size]
  17668.         whileFalse: 
  17669.             [current := oldset at: count.
  17670.             e1 := (current at: 1) copy.
  17671.             e2 := (current at: 2) copy.
  17672.             element := Array with: e1 with: e2.
  17673.             newset add: element.
  17674.             count := count + 1].
  17675.     ^newset! !
  17676.  
  17677. !TTM methodsFor: 'ttm copier'!
  17678. copyDataVariables
  17679.     "Return a new set of data variables"
  17680.  
  17681.     | oldset count newset current e1 e2 e3 e4 element |
  17682.     oldset := self datavariable.
  17683.     count := 1.
  17684.     newset := OrderedCollection new.
  17685.     [count > oldset size]
  17686.         whileFalse: 
  17687.             [current := oldset at: count.
  17688.             e1 := (current at: 1) copy.
  17689.             e2 := (current at: 2) copy.
  17690.             e3 := (current at: 3) copy.
  17691.             e4 := (current at: 4) copy.
  17692.             element := Array
  17693.                         with: e1
  17694.                         with: e2
  17695.                         with: e3
  17696.                         with: e4.
  17697.             newset add: element.
  17698.             count := count + 1].
  17699.     ^newset! !
  17700.  
  17701. !TTM methodsFor: 'ttm copier'!
  17702. copyNumberFor: anActivity 
  17703.     "Return the index number for the activity"
  17704.  
  17705.     | count found |
  17706.     count := 1.
  17707.     found := false.
  17708.     [count > temporary size | (found = true)]
  17709.         whileFalse: 
  17710.             [found := (temporary at: count)
  17711.                         = anActivity.
  17712.             found = true ifFalse: [count := count + 1]].
  17713.     found = true
  17714.         ifTrue: [^count]
  17715.         ifFalse: [^0]! !
  17716.  
  17717. !TTM methodsFor: 'ttm copier'!
  17718. renameActivityVariable: avName to: newName 
  17719.     | t1 t2 temp |
  17720.     transitionList
  17721.         do: 
  17722.             [:x | 
  17723.             (t1 := x defaultDestinationAssignments) notNil
  17724.                 ifTrue: 
  17725.                     [temp := t1 removeKey: avName ifAbsent: [nil].
  17726.                     temp notNil ifTrue: [t1 add: newName -> temp]].
  17727.             (t2 := x defaultSourceAssignments) notNil
  17728.                 ifTrue: 
  17729.                     [temp := t2 removeKey: avName ifAbsent: [nil].
  17730.                     temp notNil ifTrue: [t2 add: newName -> temp]]].
  17731.     activityTree listOfActivities do: [:x | x hasAV ifTrue: [(x selfAV at: 1)
  17732.                 = avName ifTrue: [x selfAV at: 1 put: newName]]]! !
  17733.  
  17734. !TTM methodsFor: 'ttm copier'!
  17735. restoreNecessarySelfReferences: aTTMList 
  17736.     | t |
  17737.     t := aTTMList tempStack.
  17738.     simulateWindow := t last! !
  17739.  
  17740. !TTM methodsFor: 'ttm copier'!
  17741. saveNecessarySelfReferences: aTTMList 
  17742.     | t |
  17743.     aTTMList tempStack: OrderedCollection new.
  17744.     t := aTTMList tempStack.
  17745.     t addLast: simulateWindow.
  17746.     simulateWindow := nil! !
  17747.  
  17748. !TTM methodsFor: 'file out'!
  17749. fileHeading: aHeading on: aStream 
  17750.     aStream nextPutAll: '%'; cr; nextPutAll: '%'; cr.
  17751.     aStream nextPutAll: '%  ' , aHeading.
  17752.     aStream cr; nextPutAll: '%'; cr; nextPutAll: '%'; cr! !
  17753.  
  17754. !TTM methodsFor: 'file out'!
  17755. fileLine: current on: aStream 
  17756.  
  17757.      aStream nextPutAll: current.
  17758.  
  17759.      aStream cr! !
  17760.  
  17761. !TTM methodsFor: 'file out'!
  17762. fileNotePadOn: aStream 
  17763.     | noteTable count line noteText location |
  17764.     noteTable := OrderedCollection new.
  17765.     noteText := self note asString.
  17766.     noteText size > 0
  17767.         ifTrue: 
  17768.             [count := 1.
  17769.             location := noteText findString: (String with: Character cr)
  17770.                         startingAt: count.
  17771.             location ~= 0 ifFalse: [noteTable add: '% ' , noteText]
  17772.                 ifTrue: 
  17773.                     [[location ~= 0 & (count > noteText size) not]
  17774.                         whileTrue: 
  17775.                             [line := noteText copyFrom: count to: location - 1.
  17776.                             noteTable add: '% ' , line.
  17777.                             count := location + 1.
  17778.                             count > noteText size ifFalse: [location := noteText findString: (String with: Character cr)
  17779.                                             startingAt: count]].
  17780.                     count >= noteText size
  17781.                         ifFalse: 
  17782.                             [line := noteText copyFrom: count to: noteText size.
  17783.                             noteTable add: '% ' , line]].
  17784.             self fileThis: noteTable on: aStream]! !
  17785.  
  17786. !TTM methodsFor: 'file out'!
  17787. fileThis: aTable on: aStream 
  17788.     "Given a table of lines we want to write them to 
  17789.     
  17790.     the given stream."
  17791.  
  17792.     | count current |
  17793.     count := 1.
  17794.     aTable isNil ifFalse: [[count > aTable size]
  17795.             whileFalse: 
  17796.                 [current := aTable at: count.
  17797.                 aStream nextPutAll: current.
  17798.                 aStream cr.
  17799.                 count := count + 1]]! !
  17800.  
  17801. !TTM methodsFor: 'file out'!
  17802. fileTitle: aHeading on: aStream 
  17803.     | blank newHeading length leftmargin |
  17804.     blank := ''.
  17805.     75
  17806.         timesRepeat: 
  17807.             [aStream nextPutAll: '%'.
  17808.             blank := blank , ' '].
  17809.     aStream cr.
  17810.     blank at: 1 put: $%.
  17811.     blank at: 75 put: $%.
  17812.     aStream nextPutAll: blank; cr; nextPutAll: blank; cr.
  17813.     newHeading := blank copy.
  17814.     length := aHeading size.
  17815.     length <= 70
  17816.         ifTrue: 
  17817.             [leftmargin := (71 - length / 2) floor + 2.
  17818.             newHeading
  17819.                 replaceFrom: leftmargin
  17820.                 to: leftmargin + length - 1
  17821.                 with: aHeading]
  17822.         ifFalse: [newHeading := '%' , aHeading].
  17823.     aStream nextPutAll: newHeading; cr.
  17824.     aStream nextPutAll: blank; cr; nextPutAll: blank; cr.
  17825.     75 timesRepeat: [aStream nextPutAll: '%'].
  17826.     aStream cr! !
  17827.  
  17828. !TTM methodsFor: 'file out'!
  17829. getDirectory
  17830.     | temp |
  17831.     (temp := TTMList currentDirectory) isNil
  17832.         ifTrue: [^Filename currentDirectory]
  17833.         ifFalse: [^temp]! !
  17834.  
  17835. !TTM methodsFor: 'private'!
  17836. avElement: start usingOnly: anAV 
  17837.     start left ~= nil ifTrue: [self avElement: start left usingOnly: anAV].
  17838.     start right ~= nil ifTrue: [self avElement: start right usingOnly: anAV].
  17839.     start left isNil
  17840.         ifTrue: [(start av at: 1)
  17841.                 = (anAV at: 1) ifTrue: [temporary add: start]]
  17842.         ifFalse: [(start av at: 1)
  17843.                 = (anAV at: 1) & ((start left av at: 1)
  17844.                     ~= (anAV at: 1)) ifTrue: [temporary add: start]]! !
  17845.  
  17846. !TTM methodsFor: 'private'!
  17847. firstActivitywith: targetAV from: start 
  17848.     (start av at: 1)
  17849.         = (targetAV at: 1) & temporary isNil ifTrue: [temporary := start].
  17850.     temporary isNil & (start right ~= nil) ifTrue: [self firstActivitywith: targetAV from: start right].
  17851.     temporary isNil & (start left ~= nil) ifTrue: [self firstActivitywith: targetAV from: start left]! !
  17852.  
  17853. !TTM methodsFor: 'private'!
  17854. thisAVIsUsed: currentAV from: start 
  17855.     start left ~= nil & (temporary = false) ifTrue: [self thisAVIsUsed: currentAV from: start left].
  17856.     start right ~= nil & (temporary = false) ifTrue: [self thisAVIsUsed: currentAV from: start right].
  17857.     (start av at: 1)
  17858.         = currentAV & (temporary = false) ifTrue: [temporary := true]! !
  17859.  
  17860. !TTM methodsFor: 'label maintenance'!
  17861. aValidVariableName: aString 
  17862.     "Return true if aString is a valid new variable name."
  17863.  
  17864.     | valid count |
  17865.     valid := false.
  17866.     aString size = 0 ifFalse: [(aString at: 1) isLetter & (aString at: 1) isUppercase
  17867.             ifTrue: 
  17868.                 [valid := true.
  17869.                 count := 1.
  17870.                 aString size
  17871.                     timesRepeat: 
  17872.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  17873.                                 = $_) ifFalse: [valid := false].
  17874.                         count := count + 1]]].
  17875.     valid = true ifTrue: [(self anExistingV: aString)
  17876.             ifFalse: [(self anExistingCh: aString)
  17877.                     ifFalse: [valid := true]]].
  17878.     ^valid! !
  17879.  
  17880. !TTM methodsFor: 'label maintenance'!
  17881. check: aLabel asNewActivityNameFor: av canBe: old 
  17882.     "Given a label, this checks to see if it already 
  17883.     
  17884.     exists as an activity belonging to the given av. 
  17885.     
  17886.     If so, it makes the user supply another one. 
  17887.     
  17888.     If not, it returns the given label."
  17889.  
  17890.     | newLabel continue errorname aRequest choice |
  17891.     newLabel := aLabel.
  17892.     (self name: newLabel alreadyExistsFor: av)
  17893.         & (newLabel ~= old)
  17894.         ifTrue: 
  17895.             [continue := false.
  17896.             errorname := newLabel.
  17897.             [continue = false]
  17898.                 whileTrue: 
  17899.                     [aRequest := 'An activity named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  17900.                     choice := DialogView request: aRequest.
  17901.                     choice isEmpty ifFalse: [(TTMList aUsefulActLabel: choice asString)
  17902.                             ifTrue: 
  17903.                                 [continue := (self name: choice alreadyExistsFor: av) not | (choice = old).
  17904.                                 continue = false ifTrue: [errorname := choice]]]].
  17905.             newLabel := choice].
  17906.     ^newLabel! !
  17907.  
  17908. !TTM methodsFor: 'label maintenance'!
  17909. name: aLabel alreadyExistsFor: av 
  17910.     "aLabel is a possible activity name. Is it 
  17911.     
  17912.     already in use?"
  17913.  
  17914.     | set result count currentActivity |
  17915.     set := self activitytree listOfActivities.
  17916.     set isNil ifTrue: [^false].
  17917.     result := false.
  17918.     count := 1.
  17919.     [count > set size]
  17920.         whileFalse: 
  17921.             [currentActivity := set at: count.
  17922.             currentActivity myName = aLabel ifTrue: [result := true].
  17923.             count := count + 1].
  17924.     ^result! !
  17925.  
  17926. !TTM methodsFor: 'label maintenance'!
  17927. name: aLabel isChildOfClusterActivity: anActivity 
  17928.     | set |
  17929.     anActivity collectionType = #parallel ifTrue: [^false].
  17930.     set := self activitytree allImmediateChildrenOf: anActivity.
  17931.     set isNil ifTrue: [^false].
  17932.     set do: [:x | x myName = aLabel ifTrue: [^true]].
  17933.     ^false! !
  17934.  
  17935. !TTM methodsFor: 'label maintenance'!
  17936. renameVariable: oldName to: newName 
  17937.     "change all guards, functions, and initial condition 
  17938.     
  17939.     that refer to this variable so that they now refer to it 
  17940.     
  17941.     with 
  17942.     
  17943.     its real name."
  17944.  
  17945.     | count currentTr guard action currentSF currentIC c found |
  17946.     self initialcondition: (TTMList
  17947.             replace: self initialcondition asString
  17948.             instance: oldName
  17949.             to: newName).
  17950.     count := 1.
  17951.     [count > self specificIC size]
  17952.         whileFalse: 
  17953.             [currentIC := (self specificIC at: count)
  17954.                         at: 2.
  17955.             c := 1.
  17956.             found := false.
  17957.             [c > currentIC size | (found = true)]
  17958.                 whileFalse: 
  17959.                     [((currentIC at: c)
  17960.                         at: 1)
  17961.                         = oldName
  17962.                         ifTrue: 
  17963.                             [(currentIC at: c)
  17964.                                 at: 1 put: newName.
  17965.                             found := true].
  17966.                     c := c + 1].
  17967.             count := count + 1].
  17968.     count := 1.
  17969.     [count > self stateFormulas size]
  17970.         whileFalse: 
  17971.             [currentSF := ((self stateFormulas at: count)
  17972.                         at: 2) asString.
  17973.             (self stateFormulas at: count)
  17974.                 at: 2 put: (TTMList
  17975.                     replace: currentSF
  17976.                     instance: oldName
  17977.                     to: newName).
  17978.             count := count + 1].
  17979.     count := 1.
  17980.     [count > self transitionlist size]
  17981.         whileFalse: 
  17982.             [currentTr := self transitionlist at: count.
  17983.             guard := currentTr myGuard asString.
  17984.             currentTr myGuard: (TTMList
  17985.                     replace: guard
  17986.                     instance: oldName
  17987.                     to: newName).
  17988.             action := currentTr myAction asString.
  17989.             currentTr myAction: (TTMList
  17990.                     replace: action
  17991.                     instance: oldName
  17992.                     to: newName).
  17993.             count := count + 1]! !
  17994.  
  17995. !TTM methodsFor: 'processing trs'!
  17996. avEnablingFor: aTransition 
  17997.     "We keep track of the previous elements 
  17998.     
  17999.     added to currentAVCs to avoid duplication 
  18000.     
  18001.     in code generation."
  18002.  
  18003.     | source typeOfAV enablingStates count current starting ending fullCondition ancestorList currentAncestor element accept |
  18004.     enablingStates := OrderedCollection new.
  18005.     starting := ''.
  18006.     source := aTransition startingAt.
  18007.     ancestorList := self activitytree ancestorListOf: source.
  18008.     ancestorList removeLast.
  18009.     count := ancestorList size.
  18010.     [count > 0]
  18011.         whileTrue: 
  18012.             [currentAncestor := ancestorList at: count.
  18013.             typeOfAV := self typeForAV: currentAncestor av.
  18014.             (typeOfAV includes: currentAncestor)
  18015.                 ifTrue: 
  18016.                     [element := (currentAncestor av at: 1)
  18017.                                 , '=' , currentAncestor myName.
  18018.                     accept := true.
  18019.                     currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  18020.                             ifTrue: [accept := false]].
  18021.                     accept = true
  18022.                         ifTrue: 
  18023.                             [currentAVCs add: element.
  18024.                             starting = ''
  18025.                                 ifTrue: [starting := element]
  18026.                                 ifFalse: [starting := starting , ',' , element]]].
  18027.             count := count - 1].
  18028.     typeOfAV := self typeForAV: source av.
  18029.     (typeOfAV includes: source)
  18030.         ifTrue: [enablingStates add: source]
  18031.         ifFalse: 
  18032.             [count := 1.
  18033.             [count > typeOfAV size]
  18034.                 whileFalse: 
  18035.                     [current := typeOfAV at: count.
  18036.                     (self activitytree is: source anAncestorOf: current)
  18037.                         ifTrue: [enablingStates add: current].
  18038.                     count := count + 1]].
  18039.     enablingStates size = 0 & starting isEmpty
  18040.         ifTrue: [^'nil']
  18041.         ifFalse: 
  18042.             [enablingStates size = 0
  18043.                 ifTrue: [ending := '']
  18044.                 ifFalse: [ending := self translate: enablingStates toStringUsing: source av].
  18045.             starting isEmpty ifFalse: [ending := ',(' , ending , ')'].
  18046.             fullCondition := starting , ending.
  18047.             ^fullCondition]! !
  18048.  
  18049. !TTM methodsFor: 'processing trs'!
  18050. avFunctionFor: aTransition 
  18051.     "We keep track of the previous elements 
  18052.     
  18053.     added to currentAVCs to avoid duplication 
  18054.     
  18055.     in code generation."
  18056.  
  18057.     | dest ancestorList starting count currentAncestor typeOfAV element ending changeState current accept |
  18058.     dest := aTransition endingAt.
  18059.     ancestorList := self activitytree ancestorListOf: dest.
  18060.     ancestorList removeLast.
  18061.     starting := ''.
  18062.     count := ancestorList size.
  18063.     [count > 0]
  18064.         whileTrue: 
  18065.             [currentAncestor := ancestorList at: count.
  18066.             typeOfAV := self typeForAV: currentAncestor av.
  18067.             (typeOfAV includes: currentAncestor)
  18068.                 ifTrue: [(currentAncestor av at: 1)
  18069.                         = ''
  18070.                         ifFalse: 
  18071.                             [element := (currentAncestor av at: 1)
  18072.                                         , ':' , currentAncestor myName.
  18073.                             accept := true.
  18074.                             currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  18075.                                     ifTrue: [accept := false]].
  18076.                             accept = true
  18077.                                 ifTrue: 
  18078.                                     [currentAVCs add: element.
  18079.                                     starting = ''
  18080.                                         ifTrue: [starting := element]
  18081.                                         ifFalse: [starting := starting , ',' , element]]]].
  18082.             count := count - 1].
  18083.     changeState := nil.
  18084.     typeOfAV := self typeForAV: dest av.
  18085.     (typeOfAV includes: dest)
  18086.         ifTrue: [changeState := dest]
  18087.         ifFalse: 
  18088.             [count := 1.
  18089.             [count > typeOfAV size]
  18090.                 whileFalse: 
  18091.                     [current := typeOfAV at: count.
  18092.                     current default = true & (self activitytree is: dest anAncestorOf: current) ifTrue: [changeState := current].
  18093.                     count := count + 1]].
  18094.     ending := (changeState av at: 1)
  18095.                 , ':' , changeState myName.
  18096.     starting = ''
  18097.         ifTrue: [^ending]
  18098.         ifFalse: [^starting , ',' , ending]! !
  18099.  
  18100. !TTM methodsFor: 'processing trs'!
  18101. avFunctionForOld: aTransition 
  18102.  
  18103.     "We keep track of the previous elements 
  18104.  
  18105.     added to currentAVCs to avoid duplication 
  18106.  
  18107.     in code generation."
  18108.  
  18109.  
  18110.  
  18111.     | dest ancestorList starting count currentAncestor typeOfAV element ending changeState current accept |
  18112.  
  18113.     dest := aTransition endingAt.
  18114.  
  18115.     ancestorList := self activitytree ancestorListOf: dest.
  18116.  
  18117.     ancestorList removeLast.
  18118.  
  18119.     starting := ''.
  18120.  
  18121.     count := ancestorList size.
  18122.  
  18123.     [count > 0]
  18124.  
  18125.         whileTrue: 
  18126.  
  18127.             [currentAncestor := ancestorList at: count.
  18128.  
  18129.             typeOfAV := self typeForAV: currentAncestor av.
  18130.  
  18131.             (typeOfAV includes: currentAncestor)
  18132.  
  18133.                 ifTrue: 
  18134.  
  18135.                     [element := (currentAncestor av at: 1)
  18136.  
  18137.                                 , ':' , currentAncestor myName.
  18138.  
  18139.                     accept := true.
  18140.  
  18141.                     currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  18142.  
  18143.                             ifTrue: [accept := false]].
  18144.  
  18145.                     accept = true
  18146.  
  18147.                         ifTrue: 
  18148.  
  18149.                             [currentAVCs add: element.
  18150.  
  18151.                             starting = ''
  18152.  
  18153.                                 ifTrue: [starting := element]
  18154.  
  18155.                                 ifFalse: [starting := starting , ',' , element]]].
  18156.  
  18157.             count := count - 1].
  18158.  
  18159.     changeState := nil.
  18160.  
  18161.     typeOfAV := self typeForAV: dest av.
  18162.  
  18163.     (typeOfAV includes: dest)
  18164.  
  18165.         ifTrue: [changeState := dest]
  18166.  
  18167.         ifFalse: 
  18168.  
  18169.             [count := 1.
  18170.  
  18171.             [count > typeOfAV size]
  18172.  
  18173.                 whileFalse: 
  18174.  
  18175.                     [current := typeOfAV at: count.
  18176.  
  18177.                     current default = true & (self activitytree is: dest anAncestorOf: current) ifTrue: [changeState := current].
  18178.  
  18179.                     count := count + 1]].
  18180.  
  18181.     ending := (changeState av at: 1)
  18182.  
  18183.                 , ':' , changeState myName.
  18184.  
  18185.     starting = ''
  18186.  
  18187.         ifTrue: [^ending]
  18188.  
  18189.         ifFalse: [^starting , ',' , ending]! !
  18190.  
  18191. !TTM methodsFor: 'processing trs'!
  18192. findAV: anActivity withIndent: anInteger 
  18193.  
  18194.     | def temp |
  18195.  
  18196.     temp := Array new: 2.
  18197.  
  18198.     temp at: 1 put: anActivity.
  18199.  
  18200.     temp at: 2 put: anInteger.
  18201.  
  18202.     tempResult add: temp.
  18203.  
  18204.     anActivity collectionType = #parallel
  18205.  
  18206.         ifTrue: [(self activitytree allImmediateChildrenOf: anActivity)
  18207.  
  18208.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]
  18209.  
  18210.         ifFalse: 
  18211.  
  18212.             [(self activitytree allImmediateChildrenOf: anActivity)
  18213.  
  18214.                 do: [:x | x default ifTrue: [def := x]].
  18215.  
  18216.             def isNil
  18217.  
  18218.                 ifTrue: [^self]
  18219.  
  18220.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]! !
  18221.  
  18222. !TTM methodsFor: 'processing trs'!
  18223. getSubStructureFor: anActivity 
  18224.     tempResult := OrderedCollection new.
  18225.     self findAV: anActivity withIndent: 1.
  18226.     ^tempResult! !
  18227.  
  18228. !TTM methodsFor: 'processing trs'!
  18229. processFunction: aFunction from: aTransition 
  18230.     "Return formatted string"
  18231.  
  18232.     | samplefunction temp |
  18233.     temp := ''.
  18234.     samplefunction := aFunction.    ""
  18235.     temp := aTransition transformationFunctionInTTM: self.
  18236.     samplefunction = 'nil'
  18237.         ifTrue: [samplefunction := temp]
  18238.         ifFalse: [samplefunction := temp , ',' , samplefunction].
  18239.     samplefunction = 'nil' ifTrue: [^samplefunction].
  18240.     ^TTMList removeAllBlanksFrom: samplefunction! !
  18241.  
  18242. !TTM methodsFor: 'processing trs'!
  18243. processFunction: aFunction fromLast: aTransition 
  18244.     "Return formatted string"
  18245.  
  18246.     | samplefunction avfunction temp |
  18247.     temp := ''.
  18248.     samplefunction := aFunction.
  18249.     (self getSubStructureFor: aTransition endingAt)
  18250.         do: 
  18251.             [:x | 
  18252.             "avfunction := self avFunctionFor: aTransition."
  18253.             temp = '' ifFalse: [temp := temp , ','].
  18254.             temp := temp , ((x at: 1) av at: 1) , ' : ' , (x at: 1) myName].
  18255.     samplefunction = 'nil'
  18256.         ifTrue: ["avfunction := avfunction , temp."
  18257.             samplefunction := temp]
  18258.         ifFalse: [samplefunction := temp , ',' , samplefunction].
  18259.     samplefunction = 'nil' ifTrue: [^samplefunction].
  18260.     ^TTMList removeAllBlanksFrom: samplefunction! !
  18261.  
  18262. !TTM methodsFor: 'processing trs'!
  18263. processFunctionOld: aFunction from: aTransition 
  18264.  
  18265.     "Return formatted string"
  18266.  
  18267.  
  18268.  
  18269.     | samplefunction avfunction |
  18270.  
  18271.     samplefunction := aFunction.
  18272.  
  18273.     avfunction := self avFunctionFor: aTransition.
  18274.  
  18275.     samplefunction = 'nil'
  18276.  
  18277.         ifTrue: [samplefunction := avfunction]
  18278.  
  18279.         ifFalse: [samplefunction := avfunction , ',' , samplefunction].
  18280.  
  18281.     samplefunction = 'nil' ifTrue: [^samplefunction].
  18282.  
  18283.     ^TTMList removeAllBlanksFrom: samplefunction! !
  18284.  
  18285. !TTM methodsFor: 'processing trs'!
  18286. processGuard: aGuard from: aTransition 
  18287.     "Return formatted string"
  18288.  
  18289.     | sampleguard avguard temp |
  18290.     sampleguard := aGuard.
  18291.     currentAVCs := OrderedCollection new.
  18292.     avguard := self avEnablingFor: aTransition.
  18293.     temp := aTransition newGuard.
  18294.     temp notNil ifTrue: [avguard := avguard , ',' , temp].
  18295.     sampleguard = 'nil'
  18296.         ifTrue: [sampleguard := avguard]
  18297.         ifFalse: [sampleguard := avguard , ', (' , sampleguard , ')'].
  18298.     sampleguard = 'nil' ifTrue: [^sampleguard].
  18299.     ^TTMList removeAllBlanksFrom: sampleguard! !
  18300.  
  18301. !TTM methodsFor: 'processing trs'!
  18302. processSharedTransitions: shared 
  18303.     "Given a set of shared transitions, this returns the name, guard, 
  18304.     transformation, and time 
  18305.  bounds composed from them. Note that we 
  18306.     have to look for branches. 
  18307.     We can identify them by the fact that their source activities belong to the 
  18308.     same activity variable."
  18309.  
  18310.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  18311.     name := (shared at: 1) myName.
  18312.     guard := ''.
  18313.     transformation := ''.
  18314.     lower := (shared at: 1) boundLower.
  18315.     upper := (shared at: 1) boundUpper.
  18316.     avCount := 1.
  18317.     [avCount > self activityvariable size]
  18318.         whileFalse: 
  18319.             [count := 1.
  18320.             currentAVCs := OrderedCollection new.
  18321.             thisAVempty := true.
  18322.             closeBracket := false.
  18323.             [count > shared size]
  18324.                 whileFalse: 
  18325.                     [thisInstance := shared at: count.
  18326.                     (thisInstance startingAt av at: 1)
  18327.                         = ((self activityvariable at: avCount)
  18328.                                 at: 1)
  18329.                         ifTrue: 
  18330.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  18331.                             closeBracket := true.
  18332.                             guard isEmpty
  18333.                                 ifTrue: 
  18334.                                     [guard := '(' , currentGuard.
  18335.                                     thisAVempty := false]
  18336.                                 ifFalse: [thisAVempty = true
  18337.                                         ifTrue: 
  18338.                                             [guard := guard , ' (' , currentGuard.
  18339.                                             thisAVempty := false]
  18340.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  18341.                     count := count + 1].
  18342.             closeBracket = true ifTrue: [guard := guard , '),'].
  18343.             avCount := avCount + 1].
  18344.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  18345.     count := 1.
  18346.     currentAVCs := OrderedCollection new.
  18347.     checkedAVs := OrderedCollection new.
  18348.     [count > shared size]
  18349.         whileFalse: 
  18350.             [(checkedAVs includes: (shared at: count) endingAt av)
  18351.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  18352.                 ifFalse: 
  18353.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  18354.                     checkedAVs add: (shared at: count) endingAt av].
  18355.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  18356.                     ifTrue: [transformation := currentFunction]
  18357.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  18358.             newLower := (shared at: count) boundLower.
  18359.             newUpper := (shared at: count) boundUpper.
  18360.             (TTMList convertToNumber: newLower)
  18361.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  18362.             upper = 'infinity'
  18363.                 ifTrue: [upper := newUpper]
  18364.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  18365.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  18366.             count := count + 1].
  18367.     set := OrderedCollection new.
  18368.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  18369.     ^set! !
  18370.  
  18371. !TTM methodsFor: 'processing trs'!
  18372. processSharedTransitionsLast: shared 
  18373.     "Given a set of shared transitions, this returns 
  18374.     
  18375.     the name, guard, transformation, and time 
  18376.     
  18377.     bounds composed from them. Note that we 
  18378.     
  18379.     have to look for branches. We can identify 
  18380.     
  18381.     them by the fact that their source activities 
  18382.     
  18383.     belong to the same activity variable."
  18384.  
  18385.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  18386.     name := (shared at: 1) myName.
  18387.     guard := ''.
  18388.     transformation := ''.
  18389.     lower := (shared at: 1) boundLower.
  18390.     upper := (shared at: 1) boundUpper.
  18391.     avCount := 1.
  18392.     [avCount > self activityvariable size]
  18393.         whileFalse: 
  18394.             [count := 1.
  18395.             currentAVCs := OrderedCollection new.
  18396.             thisAVempty := true.
  18397.             closeBracket := false.
  18398.             [count > shared size]
  18399.                 whileFalse: 
  18400.                     [thisInstance := shared at: count.
  18401.                     (thisInstance startingAt av at: 1)
  18402.                         = ((self activityvariable at: avCount)
  18403.                                 at: 1)
  18404.                         ifTrue: 
  18405.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  18406.                             closeBracket := true.
  18407.                             guard isEmpty
  18408.                                 ifTrue: 
  18409.                                     [guard := '(' , currentGuard.
  18410.                                     thisAVempty := false]
  18411.                                 ifFalse: [thisAVempty = true
  18412.                                         ifTrue: 
  18413.                                             [guard := guard , ' (' , currentGuard.
  18414.                                             thisAVempty := false]
  18415.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  18416.                     count := count + 1].
  18417.             closeBracket = true ifTrue: [guard := guard , '),'].
  18418.             avCount := avCount + 1].
  18419.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  18420.     count := 1.
  18421.     currentAVCs := OrderedCollection new.
  18422.     checkedAVs := OrderedCollection new.
  18423.     [count > shared size]
  18424.         whileFalse: 
  18425.             [(checkedAVs includes: (shared at: count) endingAt av)
  18426.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  18427.                 ifFalse: 
  18428.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  18429.                     checkedAVs add: (shared at: count) endingAt av].
  18430.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  18431.                     ifTrue: [transformation := currentFunction]
  18432.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  18433.             newLower := (shared at: count) boundLower.
  18434.             newUpper := (shared at: count) boundUpper.
  18435.             (TTMList convertToNumber: newLower)
  18436.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  18437.             upper = 'infinity'
  18438.                 ifTrue: [upper := newUpper]
  18439.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  18440.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  18441.             count := count + 1].
  18442.     set := OrderedCollection new.
  18443.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  18444.     ^set! !
  18445.  
  18446. !TTM methodsFor: 'processing trs'!
  18447. processSharedTransitionsOld: shared 
  18448.  
  18449.     "Given a set of shared transitions, this returns 
  18450.  
  18451.     the name, guard, transformation, and time 
  18452.  
  18453.     bounds composed from them. Note that we 
  18454.  
  18455.     have to look for branches. We can identify 
  18456.  
  18457.     them by the fact that their source activities 
  18458.  
  18459.     belong to the same activity variable."
  18460.  
  18461.  
  18462.  
  18463.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  18464.  
  18465.     name := (shared at: 1) myName.
  18466.  
  18467.     guard := ''.
  18468.  
  18469.     transformation := ''.
  18470.  
  18471.     lower := (shared at: 1) boundLower.
  18472.  
  18473.     upper := (shared at: 1) boundUpper.
  18474.  
  18475.     avCount := 1.
  18476.  
  18477.     [avCount > self activityvariable size]
  18478.  
  18479.         whileFalse: 
  18480.  
  18481.             [count := 1.
  18482.  
  18483.             currentAVCs := OrderedCollection new.
  18484.  
  18485.             thisAVempty := true.
  18486.  
  18487.             closeBracket := false.
  18488.  
  18489.             [count > shared size]
  18490.  
  18491.                 whileFalse: 
  18492.  
  18493.                     [thisInstance := shared at: count.
  18494.  
  18495.                     (thisInstance startingAt av at: 1)
  18496.  
  18497.                         = ((self activityvariable at: avCount)
  18498.  
  18499.                                 at: 1)
  18500.  
  18501.                         ifTrue: 
  18502.  
  18503.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  18504.  
  18505.                             closeBracket := true.
  18506.  
  18507.                             guard isEmpty
  18508.  
  18509.                                 ifTrue: 
  18510.  
  18511.                                     [guard := '(' , currentGuard.
  18512.  
  18513.                                     thisAVempty := false]
  18514.  
  18515.                                 ifFalse: [thisAVempty = true
  18516.  
  18517.                                         ifTrue: 
  18518.  
  18519.                                             [guard := guard , ' (' , currentGuard.
  18520.  
  18521.                                             thisAVempty := false]
  18522.  
  18523.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  18524.  
  18525.                     count := count + 1].
  18526.  
  18527.             closeBracket = true ifTrue: [guard := guard , '),'].
  18528.  
  18529.             avCount := avCount + 1].
  18530.  
  18531.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  18532.  
  18533.     count := 1.
  18534.  
  18535.     currentAVCs := OrderedCollection new.
  18536.  
  18537.     checkedAVs := OrderedCollection new.
  18538.  
  18539.     [count > shared size]
  18540.  
  18541.         whileFalse: 
  18542.  
  18543.             [(checkedAVs includes: (shared at: count) endingAt av)
  18544.  
  18545.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  18546.  
  18547.                 ifFalse: 
  18548.  
  18549.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  18550.  
  18551.                     checkedAVs add: (shared at: count) endingAt av].
  18552.  
  18553.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  18554.  
  18555.                     ifTrue: [transformation := currentFunction]
  18556.  
  18557.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  18558.  
  18559.             newLower := (shared at: count) boundLower.
  18560.  
  18561.             newUpper := (shared at: count) boundUpper.
  18562.  
  18563.             (TTMList convertToNumber: newLower)
  18564.  
  18565.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  18566.  
  18567.             upper = 'infinity'
  18568.  
  18569.                 ifTrue: [upper := newUpper]
  18570.  
  18571.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  18572.  
  18573.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  18574.  
  18575.             count := count + 1].
  18576.  
  18577.     set := OrderedCollection new.
  18578.  
  18579.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  18580.  
  18581.     ^set! !
  18582.  
  18583. !TTM methodsFor: 'processing trs'!
  18584. translate: enablingStates toStringUsing: av 
  18585.     "For use in Simulation and code generation: we 
  18586.     
  18587.     are given a set of activities which composed the 
  18588.     
  18589.     type of av. Translate into something like: 
  18590.     
  18591.     `X1 = one; X1 = two; X1 =three'"
  18592.  
  18593.     | preamble aString count |
  18594.     preamble := (av at: 1) asString , '='.
  18595.     aString := ''.
  18596.     count := 1.
  18597.     [count > enablingStates size]
  18598.         whileFalse: 
  18599.             [aString := aString , preamble , (enablingStates at: count) myName.
  18600.             count ~= enablingStates size ifTrue: [aString := aString , ';'].
  18601.             count := count + 1].
  18602.     ^aString! !
  18603.  
  18604. !TTM methodsFor: 'consistancy checks'!
  18605. checkForUndeclaredVariables! !
  18606.  
  18607. !TTM methodsFor: 'consistancy checks'!
  18608. checkSFs! !
  18609.  
  18610. !TTM methodsFor: 'consistancy checks'!
  18611. checkTransformationFunctions
  18612.     "Not currently used - but don't delete"
  18613.  
  18614.     | undefined ast ok |
  18615.     undefined := ''.
  18616.     ok := true.
  18617.     transitionList
  18618.         do: 
  18619.             [:x | 
  18620.             ast := BuildTFParser new parseForAST: x myAction ifFail: [nil].
  18621.             ast rhsVars do: [:y | (self anExistingAV: y)
  18622.                     = false & (self anExistingDV: y) = false
  18623.                     ifTrue: 
  18624.                         [ok := false.
  18625.                         undefined isNil ifTrue: [undefined := ''].
  18626.                         undefined := undefined , '  ' , y]]].
  18627.     ^ok! !
  18628.  
  18629. !TTM methodsFor: 'shared transitions'!
  18630. computeEffectiveTransitions
  18631.     | t1 t2 |
  18632.     self initializeForSharedTransitionAlgorithm.
  18633.     t2 := SortedCollection sortBlock: [:x :y | x myName < y myName].
  18634.     t1 := self findEffectiveTransitionsOf: activityTree getRoot.
  18635.     (t1 at: 2) notNil ifTrue: [t2 addAll: (t1 at: 2)].
  18636.     (t1 at: 1) notNil ifTrue: [(t1 at: 1) values do: [:x | t2 addAll: x]].
  18637.     ^t2! !
  18638.  
  18639. !TTM methodsFor: 'shared transitions'!
  18640. computeEffectiveTransitionsTest
  18641.     self initializeForSharedTransitionAlgorithm.
  18642.     ^self findEffectiveTransitionsOf: activityTree getRoot! !
  18643.  
  18644. !TTM methodsFor: 'shared transitions'!
  18645. crossTransition: a with: b named: aName 
  18646.     | newGuard newFunction newLo newHi t1 t2 newName temp |
  18647.     temp := ''.
  18648.     a startingAt notNil ifTrue: [temp := self avEnablingFor: a].
  18649.     b startingAt notNil ifTrue: [temp := temp , (self avEnablingFor: b)].
  18650.     newGuard := a myGuard , ',' , b myGuard.
  18651.     a myAction = 'nil'
  18652.         ifTrue: [newFunction := b myAction]
  18653.         ifFalse: [b myAction = 'nil'
  18654.                 ifTrue: [newFunction := a myAction]
  18655.                 ifFalse: [newFunction := a myAction , ',' , b myAction]].
  18656.     newName := self getUniqueNameForTransitionNamed: aName.
  18657.     t1 := a boundUpper.
  18658.     t2 := b boundUpper.
  18659.     t1 = 'infinity'
  18660.         ifTrue: [t2 ~= 'infinity'
  18661.                 ifTrue: [newHi := t2]
  18662.                 ifFalse: [newHi := 'infinity']]
  18663.         ifFalse: [t2 = 'infinity'
  18664.                 ifTrue: [newHi := t1]
  18665.                 ifFalse: [t2 asNumber < t1 asNumber
  18666.                         ifTrue: [newHi := t2]
  18667.                         ifFalse: [newHi := t1]]].
  18668.     t1 := a boundLower.
  18669.     t2 := b boundLower.
  18670.     t1 asNumber  < t2 asNumber
  18671.         ifTrue: [newLo := t2]
  18672.         ifFalse: [newLo := t1].
  18673.     ^Transition
  18674.         name: newName
  18675.         startAt: nil
  18676.         endAt: nil
  18677.         upper: newHi
  18678.         lower: newLo
  18679.         guard: newGuard
  18680.         action: newFunction! !
  18681.  
  18682. !TTM methodsFor: 'shared transitions'!
  18683. crossTransitionCollection: a with: b named: aName 
  18684.     | result |
  18685.     a isNil & b isNil ifTrue: [^OrderedCollection new].
  18686.     a isNil ifTrue: [^b].
  18687.     b isNil ifTrue: [^a].
  18688.     a size = 0 ifTrue: [^b].
  18689.     result := OrderedCollection new.
  18690.     a do: [:x | b do: [:y | result add: (self
  18691.                     crossTransition: x
  18692.                     with: y
  18693.                     named: aName)]].
  18694.     ^result! !
  18695.  
  18696. !TTM methodsFor: 'shared transitions'!
  18697. findEffectiveTransitionsOf: aNode 
  18698.     | children childResultCollection temp sharedDictionary nonSharedCollection s ind newTransition cs temp2 temp1 temp3 |
  18699.     children := activityTree allImmediateChildrenOf: aNode.
  18700.     s := children size.
  18701.     s = 0 ifTrue: [^Array with: (Dictionary new) with: (OrderedCollection new)].
  18702.     childResultCollection := OrderedCollection new.
  18703.     sharedDictionary := Dictionary new.
  18704.     nonSharedCollection := OrderedCollection new.
  18705.     children do: [:x | childResultCollection add: (self findEffectiveTransitionsOf: x)].
  18706.     aNode collectionType == #cluster
  18707.         ifTrue: 
  18708.             [childResultCollection do: [:c | (c at: 1) notNil
  18709.                     ifTrue: 
  18710.                         [(c at: 1) associations
  18711.                             do: 
  18712.                                 [:a | 
  18713.                                 ind := sharedDictionary findKey: a key ifAbsent: [nil].
  18714.                                 ind isNil ifFalse: [(sharedDictionary at: a key) value addAll: a value]
  18715.                                     ifTrue: [sharedDictionary add: a key -> a value]].
  18716.                         nonSharedCollection addAll: (c at: 2)]].
  18717.             (self getSetOfTransitionsStartingOrEndingAtActivites: children)
  18718.                 do: 
  18719.                     [:t | 
  18720.                     temp1 := ''.
  18721.                     temp := self getUniqueNameForTransitionNamed: t myName.
  18722.                     t startingAt notNil
  18723.                         ifTrue: 
  18724.                             [temp3 := self processFunction: t myAction from: t.
  18725.                             temp1 := self processGuard: t myGuard from: t].
  18726.                              
  18727.                     newTransition := Transition
  18728.                                 name: temp
  18729.                                 startAt: t startingAt
  18730.                                 endAt: t endingAt
  18731.                                 upper: t boundUpper copy
  18732.                                 lower: t boundLower copy
  18733.                                 guard: temp1 copy
  18734.                                 action: temp3 copy.
  18735.                     newTransition defaultDestinationAssignments: t defaultDestinationAssignments.
  18736.                     newTransition defaultSourceAssignments: t defaultSourceAssignments.
  18737.                     t shared
  18738.                         ifTrue: [(sharedDictionary includesKey: t myName)
  18739.                                 = true
  18740.                                 ifTrue: [(sharedDictionary at: t myName)
  18741.                                         add: newTransition]
  18742.                                 ifFalse: 
  18743.                                     [sharedDictionary add: t myName -> OrderedCollection new.
  18744.                                     (sharedDictionary at: t myName)
  18745.                                         add: newTransition]]
  18746.                         ifFalse: [nonSharedCollection add: newTransition]]]
  18747.         ifFalse: 
  18748.             [childResultCollection do: [:c | (c at: 1) notNil ifTrue: [nonSharedCollection addAll: (c at: 2)]].
  18749.             s < 2
  18750.                 ifTrue: [sharedDictionary := (childResultCollection at: 1)
  18751.                                 at: 1]
  18752.                 ifFalse: [1 to: s
  18753.                         do: 
  18754.                             [:i | 
  18755.                             cs := (childResultCollection at: i)
  18756.                                         at: 1.
  18757.                             cs associations do: [:x | (sharedDictionary includesKey: x key)
  18758.                                     = false
  18759.                                     ifTrue: 
  18760.                                         [temp := x value.
  18761.                                         i + 1 to: s
  18762.                                             do: 
  18763.                                                 [:j | 
  18764.                                                 temp2 := ((childResultCollection at: j)
  18765.                                                             at: 1)
  18766.                                                             at: x key ifAbsent: [nil].
  18767.                                                 temp2 isNil ifFalse: [temp := self
  18768.                                                                 crossTransitionCollection: temp
  18769.                                                                 with: temp2
  18770.                                                                 named: x key]].
  18771.                                         sharedDictionary add: x key -> temp]]]]].
  18772.     ^Array with: sharedDictionary with: nonSharedCollection! !
  18773.  
  18774. !TTM methodsFor: 'shared transitions'!
  18775. getSetOfTransitionsStartingOrEndingAtActivites: activityCollection 
  18776.     | result |
  18777.     result := OrderedCollection new.
  18778.     activityCollection do: [:x | result addAll: (transitionList TransitionsStartingAt: x)].
  18779.     ^result! !
  18780.  
  18781. !TTM methodsFor: 'shared transitions'!
  18782. getUniqueNameForTransitionNamed: aName 
  18783.     | int |
  18784.     int := transitionDictionary at: aName.
  18785.     transitionDictionary at: aName put: int + 1.
  18786.     int = 0
  18787.         ifTrue: [^aName]
  18788.         ifFalse: [^aName , '_' , int printString]! !
  18789.  
  18790. !TTM methodsFor: 'shared transitions'!
  18791. initializeForSharedTransitionAlgorithm
  18792.     transitionDictionary := Dictionary new.
  18793.     transitionList do: [:x | (transitionDictionary includesKey: x myName)
  18794.             ifFalse: [transitionDictionary add: x myName -> 0]
  18795.             ifTrue: [transitionDictionary at: x myName put: 1]]! !
  18796.  
  18797. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  18798.  
  18799. TTM class
  18800.     instanceVariableNames: ''!
  18801.  
  18802. !TTM class methodsFor: 'instance creation'!
  18803. create: givenName with: variable 
  18804.     "Create an instance of a TTM. 
  18805.     
  18806.     We use the new method for Model, super, and then the 
  18807.     
  18808.     initialize instance method for TTM."
  18809.  
  18810.     ^super new initialize: givenName with: variable! !
  18811.  
  18812. !TTM class methodsFor: 'BOSS i/o'!
  18813. getTTMFromFile: aFileName 
  18814.     | aTTM bos |
  18815.     bos := BinaryObjectStorage onOld: (Filename named: aFileName) readStream.
  18816.     aTTM := bos next.
  18817.     bos close.
  18818.     ^aTTM! !
  18819.  
  18820. !TTM class methodsFor: 'BOSS i/o'!
  18821. storeTTM: aTTM onFile: aFileName 
  18822.     | t1 t2 t3 i |
  18823.     t3 := aTTM openWindows.
  18824.     aTTM openWindows: #(0 0 0 0 ).
  18825.     t2 := OrderedCollection new.
  18826.     t1 := aTTM simulateWindow.
  18827.     aTTM transitionlist
  18828.         do: 
  18829.             [:x | 
  18830.             t2 add: x detailWindow.
  18831.             x detailWindow: nil].
  18832.     aTTM simulateWindow: nil.
  18833.     (BinaryObjectStorage onNew: (Filename named: aFileName) writeStream)
  18834.         nextPut: aTTM; close.
  18835.     aTTM simulateWindow: t1.
  18836.     aTTM openWindows: t3.
  18837.     i := 1.
  18838.     aTTM transitionlist
  18839.         do: 
  18840.             [:x | 
  18841.             x detailWindow: (t2 at: i).
  18842.             i := i + 1].
  18843.     ^aTTM! !
  18844.  
  18845. ApplicationModel subclass: #DetailWindow
  18846.     instanceVariableNames: 'editingController transition newSource newDestination list currentTTM tempList sourceActView destActView topWin originalDestinationList defaultDestinationDictionary defaultSourceDictionary propertyNameView lowerBoundAspect upperBoundAspect guardAspect functionAspect newDestinationList destinationAspect sourceAspect ui sharedAspect '
  18847.     classVariableNames: 'Instances '
  18848.     poolDictionaries: ''
  18849.     category: 'Build'!
  18850.  
  18851. !DetailWindow methodsFor: 'miscellaneous'!
  18852. blanks: anInteger 
  18853.     | temp |
  18854.     temp := ''.
  18855.     anInteger timesRepeat: [temp := temp , ' '].
  18856.     ^temp! !
  18857.  
  18858. !DetailWindow methodsFor: 'performing'!
  18859. aActListMenu
  18860.     sourceActView selection > 0
  18861.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#sourceActivityTypeList )]
  18862.         ifFalse: [^nil]! !
  18863.  
  18864. !DetailWindow methodsFor: 'performing'!
  18865. aDestListMenu
  18866.     destActView selection > 0
  18867.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#destinationActivityTypeList )]
  18868.         ifFalse: [^nil]! !
  18869.  
  18870. !DetailWindow methodsFor: 'performing'!
  18871. aSourceListMenu
  18872.     ^PopUpMenu labelList: #(#('TTM | Activity Name' 'Range' ) ) values: #(#ttmNameS #sourceRange )! !
  18873.  
  18874. !DetailWindow methodsFor: 'performing'!
  18875. compressString: s 
  18876.     | r |
  18877.     r := ''.
  18878.     s do: [:x | x isAlphaNumeric | (#($< $> $% $* $+ $/ $- $) $( $= $: $, $; $~ $# $_ ) includes: x) ifTrue: [r := r , x asString]].
  18879.     ^r! !
  18880.  
  18881. !DetailWindow methodsFor: 'performing'!
  18882. destinationActivityTypeList
  18883.     | n lt temp2 temp1 theAct anAssociation newDict |
  18884.     lt := Array new: 1.
  18885.     theAct := (newDestination at: destinationAspect selectionIndex)
  18886.                 at: 1.
  18887.     temp1 := theAct.
  18888.     (currentTTM anExistingAVsPosition: (temp1 av at: 1)) notNil
  18889.         ifTrue: 
  18890.             [temp2 := SortedCollection new.
  18891.             (currentTTM typeForAVNamed: (temp1 av at: 1))
  18892.                 do: [:x | temp2 add: x].
  18893.             temp2 := temp2 asArray.
  18894.             lt at: 1 put: temp2].
  18895.     n := (PopUpMenu labelList: lt) startUp.
  18896.     n > 0
  18897.         ifTrue: 
  18898.             [theAct := (currentTTM typeForAVNamed3: (temp1 av at: 1))
  18899.                         at: n.
  18900.             anAssociation := Association new.
  18901.             anAssociation key: (temp1 av at: 1)
  18902.                 value: theAct.
  18903.             defaultDestinationDictionary add: anAssociation.
  18904.             newDict := Dictionary new.
  18905.             newDestination := editingController
  18906.                         findAV: transition endingAt
  18907.                         withDefault: defaultDestinationDictionary
  18908.                         newDictionary: newDict.
  18909.             defaultDestinationDictionary := newDict.
  18910.             destinationAspect list: self newDestinationList]! !
  18911.  
  18912. !DetailWindow methodsFor: 'performing'!
  18913. destinationMenu
  18914.     ^PopUpMenu labelList: #(#('TTM | Activity Name' 'Range' ) ) values: #(#ttmNameD #destinationRange )! !
  18915.  
  18916. !DetailWindow methodsFor: 'performing'!
  18917. destinationMenu1
  18918.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  18919.  
  18920. !DetailWindow methodsFor: 'performing'!
  18921. destinationMenut
  18922.     destinationAspect selectionIndex > 0
  18923.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#destinationRange ) decodeAsLiteralArray]
  18924.         ifFalse: [^nil]! !
  18925.  
  18926. !DetailWindow methodsFor: 'performing'!
  18927. destinationRange
  18928.     destinationAspect selectionIndex > 0 ifTrue: [self destinationActivityTypeList]! !
  18929.  
  18930. !DetailWindow methodsFor: 'performing'!
  18931. dummy! !
  18932.  
  18933. !DetailWindow methodsFor: 'performing'!
  18934. dummy: ignore! !
  18935.  
  18936. !DetailWindow methodsFor: 'performing'!
  18937. editProperty! !
  18938.  
  18939. !DetailWindow methodsFor: 'performing'!
  18940. functionMenu
  18941.     ^PopUpMenu labelList: #(#('Edit' ) ) values: #(#performEditFunction )! !
  18942.  
  18943. !DetailWindow methodsFor: 'performing'!
  18944. getFunction
  18945.   ^transition myAction! !
  18946.  
  18947. !DetailWindow methodsFor: 'performing'!
  18948. getGuard
  18949.   ^transition myGuard! !
  18950.  
  18951. !DetailWindow methodsFor: 'performing'!
  18952. getLowerBound
  18953.   ^transition boundLower asString! !
  18954.  
  18955. !DetailWindow methodsFor: 'performing'!
  18956. getParallelAVListFor: anActivity 
  18957.     | child |
  18958.     child := anActivity left.
  18959.     [child notNil]
  18960.         whileTrue: 
  18961.             [child collectionType = #cluster
  18962.                 ifTrue: [child left notNil ifTrue: [tempList add: child]]
  18963.                 ifFalse: [self getParallelAVListFor: child].
  18964.             child := child right]! !
  18965.  
  18966. !DetailWindow methodsFor: 'performing'!
  18967. getUpperBound
  18968.   ^transition boundUpper asString! !
  18969.  
  18970. !DetailWindow methodsFor: 'performing'!
  18971. guardMenu
  18972.     ^PopUpMenu labelList: #(#('Edit' ) ) values: #(#performEditGuard )! !
  18973.  
  18974. !DetailWindow methodsFor: 'performing'!
  18975. isNumber: aString 
  18976.     aString = '' ifTrue: [^false].
  18977.     aString do: [:x | x isDigit ifFalse: [^false]].
  18978.     ^true! !
  18979.  
  18980. !DetailWindow methodsFor: 'performing'!
  18981. parallelAVListFor: anActivity 
  18982.     | t c |
  18983.     tempList := OrderedCollection new.
  18984.     self getParallelAVListFor: anActivity.
  18985.     t := Array new: tempList size.
  18986.     c := 1.
  18987.     tempList
  18988.         do: 
  18989.             [:x | 
  18990.             t at: c put: (x selfAV at: 1).
  18991.             c := c + 1].
  18992.     ^t! !
  18993.  
  18994. !DetailWindow methodsFor: 'performing'!
  18995. parrallelAVs
  18996.     | theAct temp2 lt s1 n types |
  18997.     theAct := (newSource at: sourceAspect selectionIndex)
  18998.                 at: 1.
  18999.     theAct collectionType = #parallel
  19000.         ifTrue: 
  19001.             [s1 := (PopUpMenu labelArray: (self parallelAVListFor: theAct)) startUp.
  19002.             s1 = 0 ifTrue: [^nil].
  19003.             lt := Array new: 1.
  19004.             (currentTTM anExistingAVsPosition: ((tempList at: s1) selfAV at: 1)) notNil
  19005.                 ifTrue: 
  19006.                     [temp2 := SortedCollection new.
  19007.                     types := currentTTM typeForAVNamed: ((tempList at: s1) selfAV at: 1).
  19008.                     types isNil ifTrue: [^nil].
  19009.                     types do: [:x | temp2 add: x].
  19010.                     temp2 := temp2 asArray.
  19011.                     lt at: 1 put: temp2].
  19012.             n := (PopUpMenu labelList: lt) startUp]
  19013.         ifFalse: [^nil]! !
  19014.  
  19015. !DetailWindow methodsFor: 'performing'!
  19016. performEditFunction
  19017.     | oldValue newValue accept ast undefined |
  19018.     oldValue := transition myAction.
  19019.     newValue := functionAspect value.
  19020.     newValue := self compressString: newValue.
  19021.     accept := false.
  19022.     newValue isEmpty ifTrue: [newValue := 'nil'].
  19023.     newValue = oldValue
  19024.         ifFalse: 
  19025.             [newValue = 'nil'
  19026.                 ifTrue: [transition myAction: newValue]
  19027.                 ifFalse: 
  19028.                     [accept := true.
  19029.                     ast := BuildTFParser new parseForAST: newValue
  19030.                                 ifFail: 
  19031.                                     [TTMList speak: newValue , ' : Invalid function for transition'.
  19032.                                     accept := false.
  19033.                                     ^functionAspect value: oldValue]].
  19034.             accept = false ifFalse: [ast rhsVars do: [:x | (currentTTM anExistingAV: x)
  19035.                         = false & (currentTTM anExistingDV: x) = false
  19036.                         ifTrue: 
  19037.                             [undefined isNil ifTrue: [undefined := ''].
  19038.                             undefined := undefined , '  ' , x]]].
  19039.             accept = false | undefined notNil = true
  19040.                 ifTrue: [undefined notNil
  19041.                         ifTrue: 
  19042.                             [TTMList speak: (newValue , ' : Invalid function for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  19043.                             functionAspect value: oldValue]]
  19044.                 ifFalse: 
  19045.                     [transition myAction: newValue.
  19046.                     editingController view displayOn: #dummy]]! !
  19047.  
  19048. !DetailWindow methodsFor: 'performing'!
  19049. performEditGuard
  19050.     | oldValue newValue accept ast undefined |
  19051.     oldValue := transition myGuard.
  19052.     newValue := guardAspect value.
  19053.     newValue := self compressString: newValue.
  19054.     accept := false.
  19055.     newValue isEmpty ifTrue: [newValue := 'nil'].
  19056.     newValue = oldValue
  19057.         ifFalse: 
  19058.             [newValue = 'nil'
  19059.                 ifTrue: [accept := true]
  19060.                 ifFalse: 
  19061.                     [accept := true.
  19062.                     ast := BuildBoolParser new parseForAST: newValue
  19063.                                 ifFail: 
  19064.                                     [TTMList speak: newValue , ' : Invalid guard for transition'.
  19065.                                     accept := false].
  19066.                     accept = false ifFalse: [ast rhsVars do: [:x | (currentTTM anExistingAV: x)
  19067.                                 = false & ((currentTTM anExistingDV: x)
  19068.                                     = false)
  19069.                                 ifTrue: 
  19070.                                     [undefined isNil ifTrue: [undefined := ''].
  19071.                                     undefined := undefined , '  ' , x]]]].
  19072.             accept = false | undefined notNil = true
  19073.                 ifTrue: [undefined notNil
  19074.                         ifTrue: 
  19075.                             [TTMList speak: (newValue , ' : Invalid guard for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  19076.                             guardAspect value: oldValue]]
  19077.                 ifFalse: 
  19078.                     [transition myGuard: newValue.
  19079.                     editingController view displayOn: #dummy]]! !
  19080.  
  19081. !DetailWindow methodsFor: 'performing'!
  19082. performEditLowerBound
  19083.     | oldValue newValue |
  19084.     oldValue := transition boundLower.
  19085.     newValue := lowerBoundAspect value.
  19086.     newValue := self compressString: newValue.
  19087.     (self isNumber: newValue)
  19088.         = true
  19089.         ifTrue: 
  19090.             [transition boundLower: newValue.
  19091.             editingController view displayOn: #dummy]
  19092.         ifFalse: 
  19093.             [lowerBoundAspect value: oldValue.
  19094.             TTMList speak: 'invalid lower bound']! !
  19095.  
  19096. !DetailWindow methodsFor: 'performing'!
  19097. performEditUpperBound
  19098.     | oldValue newValue |
  19099.     oldValue := transition boundUpper.
  19100.     newValue := upperBoundAspect value.
  19101.     newValue := self compressString: newValue.
  19102.     (self isNumber: newValue)
  19103.         = true | (newValue = 'infinity')
  19104.         ifTrue: 
  19105.             [transition boundUpper: newValue.
  19106.             editingController view displayOn: #dummy]
  19107.         ifFalse: 
  19108.             [upperBoundAspect value: oldValue.
  19109.             TTMList speak: 'invalid upper bound']! !
  19110.  
  19111. !DetailWindow methodsFor: 'performing'!
  19112. propertyMenu
  19113.     propertyNameView selection > 0
  19114.         ifTrue: [^PopUpMenu labelList: #(#('Edit' ) ) values: #(#editProperty )]
  19115.         ifFalse: [^nil]! !
  19116.  
  19117. !DetailWindow methodsFor: 'performing'!
  19118. sourceActivityTypeList
  19119.     | n lt temp2 temp1 theAct anAssociation newDict actualActs s1 |
  19120.     sourceAspect selectionIndex < 1 ifTrue: [^nil].
  19121.     lt := Array new: 1.
  19122.     theAct := (newSource at: sourceAspect selectionIndex)
  19123.                 at: 1.
  19124.     temp1 := theAct.
  19125.     theAct collectionType = #parallel
  19126.         ifTrue: 
  19127.             [s1 := (PopUpMenu labelArray: (self parallelAVListFor: theAct)) startUp.
  19128.             s1 = 0 ifTrue: [^nil].
  19129.             lt := Array new: 1.
  19130.             (currentTTM anExistingAVsPosition: ((tempList at: s1) selfAV at: 1)) notNil
  19131.                 ifTrue: 
  19132.                     [temp2 := SortedCollection new.
  19133.                     actualActs := currentTTM typeForAVNamed3: ((tempList at: s1) selfAV at: 1).
  19134.                     actualActs isNil ifTrue: [^nil].
  19135.                     actualActs do: [:x | temp2 add: x myName].
  19136.                     temp2 := temp2 asArray.
  19137.                     lt at: 1 put: temp2].
  19138.             n := (PopUpMenu labelList: lt) startUp]
  19139.         ifFalse: 
  19140.             [temp1 selfAV isNil ifTrue: [^nil].
  19141.             (currentTTM anExistingAVsPosition: (temp1 selfAV at: 1)) notNil
  19142.                 ifTrue: 
  19143.                     [temp2 := OrderedCollection new.
  19144.                     actualActs := currentTTM typeForAVNamed3: (temp1 selfAV at: 1).
  19145.                     actualActs isNil ifTrue: [^nil].
  19146.                     actualActs do: [:x | temp2 add: x myName].
  19147.                     temp2 := temp2 asArray.
  19148.                     lt at: 1 put: temp2].
  19149.             (lt at: 1) notNil ifTrue: [n := (PopUpMenu labelList: lt) startUp]].
  19150.     n isNil ifTrue: [^nil].
  19151.     n > 0
  19152.         ifTrue: 
  19153.             [theAct := actualActs at: n.
  19154.             anAssociation := Association new.
  19155.             anAssociation key: (theAct av at: 1)
  19156.                 value: theAct.
  19157.             defaultSourceDictionary add: anAssociation.
  19158.             newDict := Dictionary new.
  19159.             newSource := editingController
  19160.                         findAVSource2: transition startingAt
  19161.                         withDefault: defaultSourceDictionary
  19162.                         newDictionary: newDict.
  19163.             defaultDestinationDictionary := newDict.
  19164.             sourceAspect list: self newSourceList]! !
  19165.  
  19166. !DetailWindow methodsFor: 'performing'!
  19167. sourceMenu
  19168.     ^self aSourceListMenu! !
  19169.  
  19170. !DetailWindow methodsFor: 'performing'!
  19171. sourceRange
  19172.     self sourceActivityTypeList! !
  19173.  
  19174. !DetailWindow methodsFor: 'performing'!
  19175. ttmNameD
  19176.     | theAct name |
  19177.     destinationAspect selectionIndex < 1 ifTrue: [^nil].
  19178.     theAct := (newDestination at: destinationAspect selectionIndex)
  19179.                 at: 1.
  19180.     name := (editingController model ttm activitytree parentOf: theAct) myName.
  19181.     (PopUpMenu labels: name) startUp! !
  19182.  
  19183. !DetailWindow methodsFor: 'performing'!
  19184. ttmNameS
  19185.     | theAct name |
  19186.      sourceAspect selectionIndex < 1 ifTrue: [^nil].
  19187.     theAct := (newSource at: sourceAspect selectionIndex)
  19188.                 at: 1.
  19189.     name := (editingController model ttm activitytree parentOf: theAct) myName.
  19190.     (PopUpMenu labels: name) startUp! !
  19191.  
  19192. !DetailWindow methodsFor: 'closing'!
  19193. closeDetail
  19194.     transition detailWindow: nil.
  19195.       self closeRequest.
  19196.     "ui close"! !
  19197.  
  19198. !DetailWindow methodsFor: 'closing'!
  19199. removeDependent: aDependent 
  19200.     transition detailWindow: nil.
  19201.     super removeDependent: aDependent.
  19202.       self closeRequest.! !
  19203.  
  19204. !DetailWindow methodsFor: 'initialization'!
  19205. initialize
  19206.     super initialize.
  19207.     self lowerBoundAspect onChangeSend: #performEditLowerBound to: self.
  19208.     self upperBoundAspect onChangeSend: #performEditUpperBound to: self.
  19209.     self guardAspect onChangeSend: #performEditGuard to: self.
  19210.     self functionAspect onChangeSend: #performEditFunction to: self! !
  19211.  
  19212. !DetailWindow methodsFor: 'initialization'!
  19213. openFor2: aTransition 
  19214.     | p |
  19215.     transition := aTransition.
  19216.     defaultDestinationDictionary := Dictionary new.
  19217.     defaultSourceDictionary := Dictionary new.
  19218.     newSource := OrderedCollection new.
  19219.     functionAspect := aTransition myAction asValue.
  19220.     guardAspect := aTransition myGuard asValue.
  19221.     upperBoundAspect := aTransition boundUpper asValue.
  19222.     lowerBoundAspect := aTransition boundLower asValue.
  19223.     sharedAspect := ValueHolder new.
  19224.     aTransition shared ifTrue: [sharedAspect value: #setShared].
  19225.     sharedAspect onChangeSend: #updateSharedStatus to: self.
  19226.     transition detailWindow: self.
  19227.     transition defaultDestinationAssignments notNil
  19228.         ifFalse: 
  19229.             [newDestination := editingController getActivityTranformationsFor: aTransition endingAt.
  19230.             originalDestinationList := OrderedCollection new.
  19231.             newDestination
  19232.                 do: 
  19233.                     [:x | 
  19234.                     p := Array new: 2.
  19235.                     p at: 1 put: (x at: 1).
  19236.                     p at: 2 put: (x at: 2).
  19237.                     originalDestinationList add: p]]
  19238.         ifTrue: [newDestination := editingController
  19239.                         findAV: transition endingAt
  19240.                         withDefault: transition defaultDestinationAssignments
  19241.                         newDictionary: defaultDestinationDictionary].
  19242.     transition defaultSourceAssignments notNil
  19243.         ifTrue: [newSource := editingController
  19244.                         findAVSource: transition startingAt
  19245.                         withDefault: transition defaultSourceAssignments
  19246.                         newDictionary: defaultSourceDictionary]
  19247.         ifFalse: [newSource add: (Array with: aTransition startingAt with: 0)].
  19248.     destinationAspect := SelectionInList new list: self newDestinationList.
  19249.     sourceAspect := SelectionInList new list: self newSourceList.
  19250.     currentTTM := editingController model ttm.
  19251.     self initialize.! !
  19252.  
  19253. !DetailWindow methodsFor: 'variable access'!
  19254. editingController
  19255.  
  19256.      ^editingController! !
  19257.  
  19258. !DetailWindow methodsFor: 'variable access'!
  19259. editingController: aController
  19260.  
  19261.      editingController := aController! !
  19262.  
  19263. !DetailWindow methodsFor: 'variable access'!
  19264. newDestination
  19265.  
  19266.      ^newDestination! !
  19267.  
  19268. !DetailWindow methodsFor: 'variable access'!
  19269. newSource
  19270.  
  19271.      ^newSource! !
  19272.  
  19273. !DetailWindow methodsFor: 'variable access'!
  19274. newSourceList
  19275.     | temp |
  19276.     temp := OrderedCollection new.
  19277.     newSource do: [:x | temp add: (self blanks: (x at: 2)
  19278.                     - 1 * 4)
  19279.                 , ((x at: 1) av at: 1) , ' = ' , (x at: 1) myName].
  19280.     ^temp asArray! !
  19281.  
  19282. !DetailWindow methodsFor: 'variable access'!
  19283. propertyList
  19284.     ^#('Upper Time Bound' 'Lower Time Bound' 'Guard' 'Transformation Function' )! !
  19285.  
  19286. !DetailWindow methodsFor: 'variable access'!
  19287. ui: aUi 
  19288.     ui := aUi! !
  19289.  
  19290. !DetailWindow methodsFor: 'aspects'!
  19291. destinationAspect
  19292.     "This method was generated by UIDefiner. The initialization provided 
  19293.     below may have been preempted by an initialize method."
  19294.  
  19295.     ^destinationAspect isNil ifTrue: [destinationAspect := SelectionInList new] ifFalse: [destinationAspect]! !
  19296.  
  19297. !DetailWindow methodsFor: 'aspects'!
  19298. functionAspect
  19299.     "This method was generated by UIDefiner. The initialization provided 
  19300.     below may have been preempted by an initialize method."
  19301.  
  19302.     ^functionAspect isNil ifTrue: [functionAspect := String new asValue] ifFalse: [functionAspect]! !
  19303.  
  19304. !DetailWindow methodsFor: 'aspects'!
  19305. guardAspect
  19306.     "This method was generated by UIDefiner. The initialization provided 
  19307.     below may have been preempted by an initialize method."
  19308.  
  19309.     ^guardAspect isNil ifTrue: [guardAspect := String new asValue] ifFalse: [guardAspect]! !
  19310.  
  19311. !DetailWindow methodsFor: 'aspects'!
  19312. lowerBoundAspect
  19313.     "This method was generated by UIDefiner. The initialization provided 
  19314.     below may have been preempted by an initialize method."
  19315.  
  19316.     ^lowerBoundAspect isNil ifTrue: [lowerBoundAspect := String new asValue] ifFalse: [lowerBoundAspect]! !
  19317.  
  19318. !DetailWindow methodsFor: 'aspects'!
  19319. newDestinationList
  19320.     | temp |
  19321.     temp := OrderedCollection new.
  19322.     newDestination do: [:x | temp add: (self blanks: (x at: 2)
  19323.                     - 1 * 4)
  19324.                 , ((x at: 1) av at: 1) , ' : ' , (x at: 1) myName].
  19325.     ^temp asArray! !
  19326.  
  19327. !DetailWindow methodsFor: 'aspects'!
  19328. sharedAspect
  19329.     ^sharedAspect! !
  19330.  
  19331. !DetailWindow methodsFor: 'aspects'!
  19332. sourceAspect
  19333.     "This method was generated by UIDefiner. The initialization provided 
  19334.     below may have been preempted by an initialize method."
  19335.  
  19336.     ^sourceAspect isNil ifTrue: [sourceAspect := SelectionInList new] ifFalse: [sourceAspect]! !
  19337.  
  19338. !DetailWindow methodsFor: 'aspects'!
  19339. upperBoundAspect
  19340.     "This method was generated by UIDefiner. The initialization provided 
  19341.     below may have been preempted by an initialize method."
  19342.  
  19343.     ^upperBoundAspect isNil ifTrue: [upperBoundAspect := String new asValue] ifFalse: [upperBoundAspect]! !
  19344.  
  19345. !DetailWindow methodsFor: 'actions'!
  19346. doAcceptNewDest
  19347.     "This stub method was generated by UIDefiner"
  19348.  
  19349.     transition defaultDestinationAssignments: defaultDestinationDictionary copy.! !
  19350.  
  19351. !DetailWindow methodsFor: 'actions'!
  19352. doAcceptNewSource
  19353.     "This stub method was generated by UIDefiner"
  19354.  
  19355.     transition defaultSourceAssignments: defaultSourceDictionary copy.! !
  19356.  
  19357. !DetailWindow methodsFor: 'actions'!
  19358. doRevertToDestinationDefaults
  19359.     "This stub method was generated by UIDefiner"
  19360.  
  19361.     defaultDestinationDictionary := Dictionary new.
  19362.     newDestination := editingController
  19363.                 findAV: transition endingAt
  19364.                 withDefault: defaultDestinationDictionary
  19365.                 newDictionary: defaultDestinationDictionary.
  19366.     destinationAspect list: self newDestinationList.
  19367.     transition defaultDestinationAssignments: nil! !
  19368.  
  19369. !DetailWindow methodsFor: 'actions'!
  19370. doRevertToSourceDefault
  19371.     "This stub method was generated by UIDefiner"
  19372.  
  19373.     defaultSourceDictionary := Dictionary new.
  19374.     newSource := editingController
  19375.                 findAVSource: transition startingAt
  19376.                 withDefault: defaultSourceDictionary
  19377.                 newDictionary: defaultSourceDictionary.
  19378.     sourceAspect list: self newSourceList.
  19379.     transition defaultSourceAssignments: nil! !
  19380.  
  19381. !DetailWindow methodsFor: 'actions'!
  19382. updateSharedStatus
  19383.     sharedAspect value = #setShared
  19384.         ifTrue: [transition shared: true]
  19385.         ifFalse: [transition shared: false]! !
  19386.  
  19387. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  19388.  
  19389. DetailWindow class
  19390.     instanceVariableNames: ''!
  19391.  
  19392. !DetailWindow class methodsFor: 'instance creation'!
  19393. new: aTransition from: aController 
  19394.     | temp t2 |
  19395.     aTransition detailWindow notNil
  19396.         ifTrue: 
  19397.             [SimpleDialog new warn: 'A Detail Window is already open for this transition'.
  19398.             ^nil].
  19399.     temp := super new editingController: aController.
  19400.     temp openFor2: aTransition.
  19401.     t2 := temp open window label: 'Transition:  ' , aTransition myName , '   TTM: ' , aController model ttm named.
  19402.     temp ui: t2! !
  19403.  
  19404. !DetailWindow class methodsFor: 'interface specs'!
  19405. windowSpec
  19406.     "UIPainter new openOnClass: self andSelector: #windowSpec"
  19407.  
  19408.     ^#(#FullSpec #window: #(#WindowSpec #label: '' #min: #(#Point 364 429 ) #bounds: #(#Rectangle 393 243 757 672 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 0 0.0357143 0 0.0979021 0 0.494505 0 0.351981 ) #flags: 15 #model: #sourceAspect #menu: #sourceMenu ) #(#SequenceViewSpec #layout: #(#LayoutFrame 0 0.510989 0 0.0979021 0 0.950549 0 0.34965 ) #flags: 15 #model: #destinationAspect #menu: #destinationMenu ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0851648 0 0.041958 ) #label: 'Source Activities' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.532967 0 0.041958 ) #label: 'Destination Activities' ) #(#GroupBoxSpec #layout: #(#LayoutFrame 0 0.0164835 0 0.034965 0 0.972527 0 0.505827 ) ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.546703 0 0.361305 0 0.917582 0 0.424242 ) #model: #doRevertToDestinationDefaults #label: 'Revert to Default' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0604396 0 0.363636 0 0.453297 0 0.428904 ) #model: #doRevertToSourceDefault #label: 'Revert to Default' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.549451 0 0.428904 0 0.92033 0 0.484848 ) #model: #doAcceptNewDest #label: 'Accept New Dest.' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.526807 ) #label: 'Lower Bound' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.354396 0 0.531468 0 0.681319 0 0.58042 ) #model: #lowerBoundAspect #isReadOnly: false #type: #string ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.717033 0 0.937063 0 0.934066 0 0.993007 ) #model: #closeDetail #label: 'Close' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.596737 ) #label: 'Upper Bound' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.680653 ) #label: 'Guard' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0604396 0 0.764569 ) #label: 'Function' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.357143 0 0.594406 0 0.684066 0 0.645688 ) #model: #upperBoundAspect #isReadOnly: false ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0604396 0 0.428904 0 0.456044 0 0.48951 ) #model: #doAcceptNewSource #label: 'Accept New Source' #defaultable: true ) #(#MenuButtonSpec #layout: #(#LayoutFrame 0 0.354396 0 0.862471 0 0.958791 0 0.925408 ) #model: #sharedAspect #menu: #sharedMenu ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0631868 0 0.876457 ) #label: 'Scope' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.258242 0 0.680653 0 0.96978 0 0.741259 ) #model: #guardAspect ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.258242 0 0.762238 0 0.975275 0 0.820513 ) #model: #functionAspect ) ) ) )! !
  19409.  
  19410. !DetailWindow class methodsFor: 'resources'!
  19411. destinationMenu
  19412.     "UIMenuEditor new openOnClass: self andSelector: #destinationMenu"
  19413.  
  19414.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  19415.  
  19416. !DetailWindow class methodsFor: 'resources'!
  19417. destinationMenu2
  19418.     "UIMenuEditor new openOnClass: self andSelector: #destinationMenu"
  19419.  
  19420.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  19421.  
  19422. !DetailWindow class methodsFor: 'resources'!
  19423. dingus
  19424.     "UIMenuEditor new openOnClass: self andSelector: #dingus"
  19425.  
  19426.     ^#(#PopUpMenu #('range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  19427.  
  19428. !DetailWindow class methodsFor: 'resources'!
  19429. functionMenu
  19430.     "UIMenuEditor new openOnClass: self andSelector: #functionMenu"
  19431.  
  19432.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditFunction ) ) decodeAsLiteralArray! !
  19433.  
  19434. !DetailWindow class methodsFor: 'resources'!
  19435. guardMenu
  19436.     "UIMenuEditor new openOnClass: self andSelector: #guardMenu"
  19437.  
  19438.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditGuard ) ) decodeAsLiteralArray! !
  19439.  
  19440. !DetailWindow class methodsFor: 'resources'!
  19441. lowerBoundMenu
  19442.     "UIMenuEditor new openOnClass: self andSelector: #lowerBoundMenu"
  19443.  
  19444.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditLowerBound ) ) decodeAsLiteralArray! !
  19445.  
  19446. !DetailWindow class methodsFor: 'resources'!
  19447. sharedMenu
  19448.     "UIMenuEditor new openOnClass: self andSelector: #sharedMenu"
  19449.  
  19450.     ^#(#PopUpMenu #('Transition is not shared' 'Transition is shared' ) #() #(#setNoShare #setShared ) ) decodeAsLiteralArray! !
  19451.  
  19452. !DetailWindow class methodsFor: 'resources'!
  19453. upperBoundMenu
  19454.     "UIMenuEditor new openOnClass: self andSelector: #upperBoundMenu"
  19455.  
  19456.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditUpperBound ) ) decodeAsLiteralArray! !
  19457.  
  19458. Model subclass: #ConditionsWindow
  19459.     instanceVariableNames: 'currentTTM allSelection icSelection myConditions initialCondition table '
  19460.     classVariableNames: ''
  19461.     poolDictionaries: ''
  19462.     category: 'Build'!
  19463.  
  19464. !ConditionsWindow methodsFor: 'initialize-release'!
  19465. initializeCondition
  19466.     | count existingDV |
  19467.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  19468.                     with: (currentTTM defaultOfAV: (existingAV at: 1))].
  19469.     count := 1.
  19470.     currentTTM datavariable size
  19471.         timesRepeat: 
  19472.             [existingDV := currentTTM datavariable at: count.
  19473.             existingDV := Array with: (existingDV at: 1)
  19474.                         with: (existingDV at: 4).
  19475.             count := count + 1.
  19476.             initialCondition add: existingDV]! !
  19477.  
  19478. !ConditionsWindow methodsFor: 'initialize-release'!
  19479. initializeTTM: instanceOfTTM 
  19480.     currentTTM := instanceOfTTM.
  19481.     myConditions := currentTTM specificIC.
  19482.     self initializeCondition! !
  19483.  
  19484. !ConditionsWindow methodsFor: 'ic maintenance'!
  19485. icChange
  19486.     "Change initial value of a variable."
  19487.  
  19488.     | initial oldInitial |
  19489.     icSelection ~~ nil ifFalse: []
  19490.         ifTrue: 
  19491.             [oldInitial := icSelection at: 2.
  19492.             initial := DialogView request: 'New initial value of ' , (icSelection at: 1) , '?' initialAnswer: oldInitial.
  19493.             (currentTTM anExistingDV: (icSelection at: 1))
  19494.                 ifTrue: [(currentTTM isInDVRange: initial of: (icSelection at: 1))
  19495.                         ifFalse: 
  19496.                             [TTMList speak: 'illegal data variable value.'.
  19497.                             ^self]]
  19498.                 ifFalse: [(currentTTM anExistingAV: (icSelection at: 1))
  19499.                         ifTrue: [(currentTTM isInAVRange: initial of: (icSelection at: 1))
  19500.                                 ifFalse: 
  19501.                                     [TTMList speak: 'illegal activity variable value.'.
  19502.                                     ^self]]
  19503.                         ifFalse: 
  19504.                             [TTMList speak: 'illegal variable name in use.'.
  19505.                             ^self]].
  19506.             initial isEmpty
  19507.                 ifTrue: [^self]
  19508.                 ifFalse: 
  19509.                     [icSelection at: 2 put: initial.
  19510.                     self changed: #icTransaction]]! !
  19511.  
  19512. !ConditionsWindow methodsFor: 'ic maintenance'!
  19513. icList
  19514.  
  19515.     "Return a list of variable names and initial conditions."
  19516.  
  19517.  
  19518.  
  19519.     allSelection ~~ nil
  19520.  
  19521.         ifTrue: 
  19522.  
  19523.             [initialCondition := allSelection at: 2.
  19524.  
  19525.             ^initialCondition collect: [:existingCondition | (existingCondition at: 1)
  19526.  
  19527.                     , ' = ' , (existingCondition at: 2)]]
  19528.  
  19529.         ifFalse: [^nil]! !
  19530.  
  19531. !ConditionsWindow methodsFor: 'ic maintenance'!
  19532. icMenu
  19533.     "Answer a menu for the specific initial condition view."
  19534.  
  19535.     icSelection == nil ifTrue: [^nil].
  19536.     ^PopUpMenu labelList: #(#('new initial value' 'show type' ) ) values: #(#icChange #icTypeList )! !
  19537.  
  19538. !ConditionsWindow methodsFor: 'ic maintenance'!
  19539. icSelection: index 
  19540.  
  19541.      "If the selection has been changed, remember the new
  19542.  
  19543. selection."
  19544.  
  19545.  
  19546.  
  19547.      | newSel |
  19548.  
  19549.      newSel := index = 0
  19550.  
  19551.                     ifTrue: []
  19552.  
  19553.                     ifFalse: [initialCondition at: index].
  19554.  
  19555.      
  19556.  
  19557.      icSelection == newSel
  19558.  
  19559.           ifTrue: 
  19560.  
  19561.                ["self updateSimulateWindowIfOpen."
  19562.  
  19563.                ^self].
  19564.  
  19565.      
  19566.  
  19567.      icSelection := newSel.! !
  19568.  
  19569. !ConditionsWindow methodsFor: 'ic maintenance'!
  19570. icTypeList
  19571.     | n list temp pos cd junk isActivity |
  19572.     isActivity := False.
  19573.     list := Array new: 1.
  19574.     (pos := currentTTM anExistingDVsPosition: (icSelection at: 1)) notNil
  19575.         ifTrue: 
  19576.             [cd := currentTTM datavariable at: pos.
  19577.             temp := 'Range: ' , (cd at: 2) , ' to ' , (cd at: 3).
  19578.             junk := Array new: 1.
  19579.             junk at: 1 put: temp.
  19580.             list at: 1 put: junk]
  19581.         ifFalse: [(pos := currentTTM anExistingAVsPosition: (icSelection at: 1)) notNil
  19582.                 ifTrue: 
  19583.                     [isActivity := True.
  19584.                     temp := SortedCollection new.
  19585.                     (currentTTM typeForAVNamed: (icSelection at: 1))
  19586.                         do: [:x | temp add: x].
  19587.                     temp := temp asArray.
  19588.                     list at: 1 put: temp]
  19589.                 ifFalse: []].
  19590.     n := (PopUpMenu labelList: list) startUp.
  19591.     isActivity = True & (n > 0)
  19592.         ifTrue: 
  19593.             [icSelection at: 2 put: ((list at: 1)
  19594.                     at: n).
  19595.             self changed: #icTransaction]! !
  19596.  
  19597. !ConditionsWindow methodsFor: 'list access'!
  19598. listAdd
  19599.     | newname totalNumber checkIfValid count okay |
  19600.     totalNumber := myConditions size.
  19601.     checkIfValid := true.
  19602.     [checkIfValid = true]
  19603.         whileTrue: 
  19604.             [count := 1.
  19605.             okay := true.
  19606.             [count > myConditions size]
  19607.                 whileFalse: 
  19608.                     [((myConditions at: count)
  19609.                         at: 1)
  19610.                         = totalNumber printString
  19611.                         ifTrue: 
  19612.                             [okay := false.
  19613.                             count := myConditions size].
  19614.                     count := count + 1].
  19615.             okay = true
  19616.                 ifTrue: [checkIfValid := false]
  19617.                 ifFalse: [totalNumber := totalNumber + 1]].
  19618.     newname := DialogView request: 'New condition number?' initialAnswer: totalNumber printString.
  19619.     newname isEmpty
  19620.         ifTrue: [^self]
  19621.         ifFalse: 
  19622.             [self initializeCondition.
  19623.             myConditions add: (Array with: newname with: initialCondition copy).
  19624.             self changed: #listTransaction.
  19625.             self changed: #icTransaction]! !
  19626.  
  19627. !ConditionsWindow methodsFor: 'list access'!
  19628. listClear
  19629.     currentTTM specificIC: OrderedCollection new.
  19630.     myConditions := currentTTM specificIC.
  19631.     self changed: #listTransaction! !
  19632.  
  19633. !ConditionsWindow methodsFor: 'list access'!
  19634. listCopy
  19635.     | newname copiedCondition |
  19636.     allSelection == nil
  19637.         ifFalse: 
  19638.             [newname := DialogView request: 'Copy to condition number?'.
  19639.             newname isEmpty
  19640.                 ifTrue: [^self]
  19641.                 ifFalse: 
  19642.                     [copiedCondition := (allSelection at: 2) copy.
  19643.                     myConditions add: (Array with: newname with: copiedCondition).
  19644.                     self changed: #listTransaction.
  19645.                     self changed: #icTransaction]]! !
  19646.  
  19647. !ConditionsWindow methodsFor: 'list access'!
  19648. listList
  19649.  
  19650.      ^myConditions collect: [:existingIC | existingIC at: 1]! !
  19651.  
  19652. !ConditionsWindow methodsFor: 'list access'!
  19653. listMenu
  19654.  
  19655.     allSelection = nil
  19656.  
  19657.         ifTrue: [^PopUpMenu labelList: #(#(#add #clear ) ) values: #(#listAdd #listClear )]
  19658.  
  19659.         ifFalse: [^PopUpMenu labelList: #(#(#add #copy #clear #remove #send ) ) values: #(#listAdd #listCopy #listClear #listRemove #listSend )]! !
  19660.  
  19661. !ConditionsWindow methodsFor: 'list access'!
  19662. listRemove
  19663.  
  19664.     | location |
  19665.  
  19666.     allSelection == nil
  19667.  
  19668.         ifTrue: []
  19669.  
  19670.         ifFalse: 
  19671.  
  19672.             [location := myConditions indexOf: allSelection.
  19673.  
  19674.             myConditions removeAtIndex: location.
  19675.  
  19676.             self changed: #listTransaction]! !
  19677.  
  19678. !ConditionsWindow methodsFor: 'list access'!
  19679. listSelection: index 
  19680.     "If the selection has been changed, remember the new 
  19681.     
  19682.     selection."
  19683.  
  19684.     | newSel |
  19685.     newSel := index = 0
  19686.                 ifTrue: [nil]
  19687.                 ifFalse: [myConditions at: index].
  19688.     allSelection == newSel ifTrue: [^self].
  19689.     allSelection := newSel.
  19690.     self changed: #icTransaction! !
  19691.  
  19692. !ConditionsWindow methodsFor: 'list access'!
  19693. listSend
  19694.  
  19695.     self updateSimulateWindowIfOpen! !
  19696.  
  19697. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  19698. ic1Accept: candidateCondition 
  19699.  
  19700.      | accept cCondition |
  19701.  
  19702.      accept := false.
  19703.  
  19704.      candidateCondition isEmpty
  19705.  
  19706.           ifTrue: [cCondition := 'nil']
  19707.  
  19708.           ifFalse: [cCondition := candidateCondition].
  19709.  
  19710.      cCondition asString = 'nil'
  19711.  
  19712.           ifTrue: [accept := true]
  19713.  
  19714.           ifFalse: [(ParseTree guardSyntaxCheck: cCondition
  19715.  
  19716. asString from: currentTTM)
  19717.  
  19718.                     ifFalse: [accept := true]].
  19719.  
  19720.      accept = false
  19721.  
  19722.           ifFalse: 
  19723.  
  19724.                [currentTTM initialcondition: cCondition asString.
  19725.  
  19726.                self changed: #ic1List.
  19727.  
  19728.                ^true]
  19729.  
  19730.           ifTrue: 
  19731.  
  19732.                [TTMList speak: 'revised initial condition
  19733.  
  19734. rejected.'.
  19735.  
  19736.                self changed: #ic1List.
  19737.  
  19738.                ^true]! !
  19739.  
  19740. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  19741. ic1List
  19742.  
  19743.      ^currentTTM initialcondition! !
  19744.  
  19745. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  19746. ic1Menu
  19747.  
  19748.      "Answer a menu for the initial condition view."
  19749.  
  19750.  
  19751.  
  19752.      ^PopUpMenu 
  19753.  
  19754.                        labelList: #(#(#again #undo ) #(#copy #cut
  19755.  
  19756. #paste ) #(#accept #cancel ) ) 
  19757.  
  19758.                        values: #(#again #undo #copySelection #cut
  19759.  
  19760. #paste #accept #cancel )! !
  19761.  
  19762. !ConditionsWindow methodsFor: 'SimulateWindow interface'!
  19763. simulateWindowOpen
  19764.     "Return the SimulateWindow if it is open"
  19765.  
  19766.     (currentTTM openWindows at: 4)
  19767.         ~= 0 ifTrue: [^currentTTM simulateWindow].
  19768.     ^nil! !
  19769.  
  19770. !ConditionsWindow methodsFor: 'SimulateWindow interface'!
  19771. updateSimulateWindowIfOpen
  19772.     "If there is a SimulateWindow open for this TTM, then update the 
  19773.     Starting Condition to the IC chosen in the corresponding 
  19774.     QueryWindow"
  19775.  
  19776.     | anSW |
  19777.     anSW := self simulateWindowOpen.
  19778.     anSW ~= nil ifTrue: [allSelection notNil
  19779.             ifTrue: 
  19780.                 [anSW initialCondition: (self allSelection at: 2) copy.
  19781.                 anSW changed: #icTransaction.
  19782.                 anSW clockReset.
  19783.                 anSW accessTimeFor: #all to: #initialize.
  19784.                 anSW initializeTable.
  19785.                 anSW reset]]! !
  19786.  
  19787. !ConditionsWindow methodsFor: 'variable access'!
  19788. allSelection
  19789.  
  19790.      ^allSelection! !
  19791.  
  19792. !ConditionsWindow methodsFor: 'variable access'!
  19793. currentTTM
  19794.  
  19795.      ^currentTTM! !
  19796.  
  19797. !ConditionsWindow methodsFor: 'closing'!
  19798. removeDependent: aDependent 
  19799.  
  19800.     currentTTM openWindows at: 1 put: 0.
  19801.  
  19802.     super removeDependent: aDependent! !
  19803.  
  19804. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  19805.  
  19806. ConditionsWindow class
  19807.     instanceVariableNames: ''!
  19808.  
  19809. !ConditionsWindow class methodsFor: 'instance creation'!
  19810. new: ttm 
  19811.     ^super new initializeTTM: ttm! !
  19812.  
  19813. !ConditionsWindow class methodsFor: 'instance creation'!
  19814. open: currentTTM 
  19815.     self open: (self new: currentTTM)
  19816.         with: currentTTM! !
  19817.  
  19818. !ConditionsWindow class methodsFor: 'instance creation'!
  19819. open: anICModel with: currentTTM 
  19820.     | window container myWrapper title initialView up vsize left hsize hButton cButton noteView icListView |
  19821.     window := ScheduledWindow new.
  19822.     title := 'Specifying Initial Conditions For: ' , currentTTM named asText.
  19823.     window label: title.
  19824.     window minimumSize: 450 @ 300.
  19825.     window insideColor: ColorValue white.
  19826.     window model: anICModel.
  19827.     container := CompositePart new.
  19828.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  19829.         insideColor: ColorValue white.
  19830.     noteView := TextView
  19831.                 on: anICModel
  19832.                 aspect: #ic1List
  19833.                 change: #ic1Accept:
  19834.                 menu: #ic1Menu
  19835.                 initialSelection: nil.
  19836.     myWrapper := self wrap: (LookPreferences edgeDecorator on: noteView).
  19837.     (container add: myWrapper borderedIn: (0.0 @ 0.08 extent: 1.0 @ 0.33))
  19838.         insideColor: ColorValue white.
  19839.     self labelWrap: (container add: ' Prolog III Initial
  19840.  
  19841. Condition:' asText allBold asComposedText borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.08)).
  19842.     icListView := SelectionInListView
  19843.                 on: anICModel
  19844.                 printItems: false
  19845.                 oneItem: false
  19846.                 aspect: #listTransaction
  19847.                 change: #listSelection:
  19848.                 list: #listList
  19849.                 menu: #listMenu
  19850.                 initialSelection: nil
  19851.                 useIndex: true.
  19852.     myWrapper := self wrap: (LookPreferences edgeDecorator on: icListView).
  19853.     (container add: myWrapper borderedIn: (0.0 @ 0.49 extent: 0.3 @ 0.42))
  19854.         insideColor: ColorValue white.
  19855.     self labelWrap: (container add: ' Specific IC List:' asText allBold asComposedText borderedIn: (0.0 @ 0.41 extent: 0.3 @ 0.08)).    "new initial condition view"
  19856.     initialView := SelectionInListView
  19857.                 on: anICModel
  19858.                 printItems: false
  19859.                 oneItem: false
  19860.                 aspect: #icTransaction
  19861.                 change: #icSelection:
  19862.                 list: #icList
  19863.                 menu: #icMenu
  19864.                 initialSelection: nil
  19865.                 useIndex: true.
  19866.     myWrapper := self wrap: (LookPreferences edgeDecorator on: initialView).
  19867.     container add: myWrapper borderedIn: (0.3 @ 0.49 extent: 0.7 @ 0.42).
  19868.     self labelWrap: (container add: ' Selected Specific Initial
  19869.  
  19870. Condition:' asText allBold asComposedText borderedIn: (0.3 @ 0.41 extent: 0.7 @ 0.08)).
  19871.     up := 0.91.
  19872.     vsize := 0.08.
  19873.     left := 0.01.
  19874.     hsize := 0.17.    "Button for closing"
  19875.     cButton := PushButton named: 'Exit'.
  19876.     cButton model: ((PluggableAdaptor on: anICModel)
  19877.             getBlock: [:model | false]
  19878.             putBlock: [:model :value | TTMList closeWindow: 1 in: currentTTM]
  19879.             updateBlock: [:model :value :parameter | false]).
  19880.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  19881.         insideColor: ColorValue white.
  19882.     left := left + hsize.    "Button for help"
  19883.     hButton := PushButton named: 'Help' asText allBold.
  19884.     hButton model: ((PluggableAdaptor on: anICModel)
  19885.             getBlock: [:model | false]
  19886.             putBlock: [:model :value | HelpScreens openHelp: 'specifying']
  19887.             updateBlock: [:model :value :parameter | false]).
  19888.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  19889.         insideColor: ColorValue white.
  19890.     window component: container.
  19891.     window open! !
  19892.  
  19893. !ConditionsWindow class methodsFor: 'decoration'!
  19894. labelWrap: aLabel 
  19895.     | newLabel |
  19896.     newLabel := aLabel.
  19897.     newLabel insideColor: ColorValue white.
  19898.     newLabel borderColor: ColorValue black.
  19899.     newLabel borderWidth: 1.
  19900.     ^newLabel! !
  19901.  
  19902. !ConditionsWindow class methodsFor: 'decoration'!
  19903. wrap: aWrapper 
  19904.     | newWrapper |
  19905.     newWrapper := aWrapper.
  19906.     newWrapper noMenuBar.    "newWrapper borderColor: ColorValue black."
  19907.     "newWrapper borderWidth: 1."
  19908.     ^newWrapper"newWrapper insideColor: ColorValue white."! !
  19909.  
  19910. Model subclass: #TTMList
  19911.     instanceVariableNames: 'variableSet models selection dvSelection avSelection icSelection chSelection sfSelection fileSelection currentDir dirContents temporary editedtrlist enumerateActivities temporaryTTM activityStack tempStack currentDirectory '
  19912.     classVariableNames: ''
  19913.     poolDictionaries: ''
  19914.     category: 'Build'!
  19915. TTMList comment:
  19916. 'This is the root class for the Model Builder Program.
  19917.  
  19918. To run the program select: "TTMList open" and doit.
  19919.  
  19920.  
  19921.  
  19922. models -- contains the list of TTMs. Each one is an element
  19923.  
  19924.                   of the class TTM.
  19925.  
  19926. -----------------------------------------------
  19927.  
  19928. In the class section of TTMList are sets of general functions.
  19929.  
  19930. They were put here for easy access even though they really have
  19931.  
  19932. nothing to do with the TTMList class itself. These sections are:
  19933.  
  19934.  
  19935.  
  19936. type conversions -- routines for converting from one object to
  19937.  
  19938.                                 another.
  19939.  
  19940.  
  19941.  
  19942. dialog windows  -- routines used in manipulating windows.
  19943.  
  19944.  
  19945.  
  19946. strings                -- routines for manipulating string
  19947.  
  19948. objects.
  19949.  
  19950.                                And for testing string objects.
  19951.  
  19952.               '!
  19953.  
  19954. TTMList comment:
  19955. 'This is the root class for the Model Builder Program.
  19956.  
  19957. To run the program select: "TTMList open" and doit.
  19958.  
  19959.  
  19960.  
  19961. models -- contains the list of TTMs. Each one is an element
  19962.  
  19963.                   of the class TTM.
  19964.  
  19965. -----------------------------------------------
  19966.  
  19967. In the class section of TTMList are sets of general functions.
  19968.  
  19969. They were put here for easy access even though they really have
  19970.  
  19971. nothing to do with the TTMList class itself. These sections are:
  19972.  
  19973.  
  19974.  
  19975. type conversions -- routines for converting from one object to
  19976.  
  19977.                                 another.
  19978.  
  19979.  
  19980.  
  19981. dialog windows  -- routines used in manipulating windows.
  19982.  
  19983.  
  19984.  
  19985. strings                -- routines for manipulating string
  19986.  
  19987. objects.
  19988.  
  19989.                                And for testing string objects.
  19990.  
  19991.               '!
  19992.  
  19993. !TTMList methodsFor: 'initialize-release'!
  19994. initialize
  19995.     models := OrderedCollection new.
  19996.     selection := nil.
  19997.     enumerateActivities := 0! !
  19998.  
  19999. !TTMList methodsFor: 'code output'!
  20000. codeAsProlog3
  20001.     "output code in the prolog3 format"
  20002.  
  20003.     | aStream ending |
  20004.     aStream := self openFileFor: #prolog3 as: #code.
  20005.     aStream = nil
  20006.         ifFalse: 
  20007.             [self variablesInitialize.
  20008.             self enumerationCommentOn: aStream.
  20009.             selection fileHeading: 'Mapping and Types:' on: aStream.
  20010.             selection fileThis: self makeMapForP3 on: aStream.
  20011.             selection fileThis: (self makeTypesFor: #prolog3)
  20012.                 on: aStream.
  20013.             selection fileHeading: 'Initial Condition:' on: aStream.
  20014.             selection fileThis: (self makeInitialConditionFor: #prolog3)
  20015.                 on: aStream.
  20016.             selection fileHeading: 'Enabling Conditions:' on: aStream.
  20017.             selection fileThis: (self makeGuardsFor: #prolog3)
  20018.                 on: aStream.
  20019.             selection fileHeading: 'Transformation Functions:' on: aStream.
  20020.             selection fileThis: (self makeFunctionsFor: #prolog3)
  20021.                 on: aStream.
  20022.             selection fileHeading: 'Lower and Upper Bounds:' on: aStream.
  20023.             selection fileThis: (self makeLohisFor: #prolog3)
  20024.                 on: aStream.
  20025.             selection fileHeading: 'Negations of Enabling Conditions:' on: aStream.
  20026.             selection fileThis: self makeNegations on: aStream.
  20027.             ending := OrderedCollection new.
  20028.             ending add: '. '.
  20029.             selection fileThis: ending on: aStream.
  20030.             aStream close]! !
  20031.  
  20032. !TTMList methodsFor: 'code output'!
  20033. codeAsQuintus
  20034.     "output code in the quintus prolog format"
  20035.  
  20036.     | aStream |
  20037.     aStream := self openFileFor: #quintus as: #code.
  20038.     aStream = nil
  20039.         ifFalse: 
  20040.             [self variablesInitialize.
  20041.             selection fileHeading: 'Multifile and Dynamic declarations:' on: aStream.
  20042.             selection fileLine: ':- multifile map/3, type/3, initialcondition/2, en/3, h/4, lohi/4.' on: aStream.
  20043.             selection fileLine: ':- dynamic map/3, type/3, initialcondition/2, en/3, h/4, lohi/4.' on: aStream.
  20044.             self enumerationCommentOn: aStream.
  20045.             selection fileHeading: 'Mapping and Types:' on: aStream.
  20046.             selection fileThis: self makeMapForQP on: aStream.
  20047.             selection fileThis: (self makeTypesFor: #quintus)
  20048.                 on: aStream.
  20049.             selection fileHeading: 'Initial Condition:' on: aStream.
  20050.             selection fileThis: (self makeInitialConditionFor: #quintus)
  20051.                 on: aStream.
  20052.             selection fileHeading: 'Enabling Conditions:' on: aStream.
  20053.             selection fileThis: (self makeGuardsFor: #quintus)
  20054.                 on: aStream.
  20055.             selection fileHeading: 'Transformation Functions:' on: aStream.
  20056.             selection fileThis: (self makeFunctionsFor: #quintus)
  20057.                 on: aStream.
  20058.             selection fileHeading: 'Lower and Upper Bounds:' on: aStream.
  20059.             selection fileThis: (self makeLohisFor: #quintus)
  20060.                 on: aStream.
  20061.             aStream close]! !
  20062.  
  20063. !TTMList methodsFor: 'code output'!
  20064. doRunGenerate
  20065.     | count newValues |
  20066.     newValues := OrderedCollection new.
  20067.     count := 1.
  20068.     [count > temporary size]
  20069.         whileFalse: 
  20070.             [(temporary at: count) value = true
  20071.                 ifTrue: [newValues add: true]
  20072.                 ifFalse: [newValues add: false].
  20073.             count := count + 1].
  20074.     (newValues at: 1)
  20075.         = false & ((newValues at: 2)
  20076.             = false) ifTrue: [TTMList speak: 'No code type has been selected.'].
  20077.     (newValues at: 3)
  20078.         = false & ((newValues at: 4)
  20079.             = false) ifTrue: [TTMList speak: 'No dialect has been selected.'].
  20080.     (newValues at: 5)
  20081.         = true ifTrue: [enumerateActivities := 1].
  20082.     (newValues at: 1)
  20083.         = true
  20084.         ifTrue: 
  20085.             [(newValues at: 3)
  20086.                 = true ifTrue: [self codeAsQuintus].
  20087.             (newValues at: 4)
  20088.                 = true ifTrue: [self codeAsProlog3]].
  20089.     (newValues at: 2)
  20090.         = true ifTrue: [selection stateFormulas size ~= 0 ifFalse: [TTMList speak: 'There are NO State Formulas for this TTM.']
  20091.             ifTrue: 
  20092.                 [(newValues at: 3)
  20093.                     = true ifTrue: [self sfAsQuintus].
  20094.                 (newValues at: 4)
  20095.                     = true ifTrue: [self sfAsProlog3]]].
  20096.     ScheduledControllers activeController close! !
  20097.  
  20098. !TTMList methodsFor: 'code output'!
  20099. enumerationCommentOn: aStream 
  20100.     "if the user has selected enumeration then make a comment"
  20101.  
  20102.     | c anAV avList k |
  20103.     enumerateActivities > 0
  20104.         ifTrue: 
  20105.             [selection fileHeading: 'Activity Variable Type Enumeration:' on: aStream.
  20106.             c := 1.
  20107.             [c > selection activityvariable size]
  20108.                 whileFalse: 
  20109.                     [anAV := selection activityvariable at: c.
  20110.                     selection fileLine: '% enumeration of ' , (anAV at: 1) , ':' on: aStream.
  20111.                     avList := selection typeForAV: anAV.
  20112.                     avList notNil
  20113.                         ifTrue: 
  20114.                             [k := 1.
  20115.                             [k > avList size]
  20116.                                 whileFalse: 
  20117.                                     [selection fileLine: '%     [' , k printString , ' = ' , (avList at: k) myName , ']' on: aStream.
  20118.                                     k := k + 1]].
  20119.                     c := c + 1]]! !
  20120.  
  20121. !TTMList methodsFor: 'code output'!
  20122. enumerationOf: activity in: position 
  20123.     "Return # of activity"
  20124.  
  20125.     | avList k anAV |
  20126.     anAV := selection activityvariable at: position.
  20127.     enumerateActivities > 0
  20128.         ifTrue: 
  20129.             [avList := selection typeForAV: anAV.
  20130.             avList notNil
  20131.                 ifTrue: 
  20132.                     [k := 1.
  20133.                     [k > avList size]
  20134.                         whileFalse: 
  20135.                             [activity = (avList at: k) myName ifTrue: [^k printString].
  20136.                             k := k + 1]]].
  20137.     ^nil! !
  20138.  
  20139. !TTMList methodsFor: 'code output'!
  20140. openFileFor: prologType as: codeType 
  20141.     "Returns the stream in append mode or 
  20142.     
  20143.     returns nil if file could not be opened."
  20144.  
  20145.     | aStream defaultName fileName ending state ready prefix set go myMessage aTransitionCollection fullPath |
  20146.     codeType = #code
  20147.         ifTrue: 
  20148.             [prefix := '.ttm'.
  20149.             editedtrlist := OrderedCollection new.
  20150.             aTransitionCollection := selection computeEffectiveTransitions.
  20151.             aTransitionCollection
  20152.                 do: 
  20153.                     [:x | 
  20154.                     set := OrderedCollection new.
  20155.                     set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  20156.                     editedtrlist add: set]]
  20157.         ifFalse: [prefix := '.sf'].
  20158.     prologType = #quintus
  20159.         ifTrue: 
  20160.             [ending := prefix.
  20161.             state := 'Quintus Prolog file name?']
  20162.         ifFalse: 
  20163.             [ending := prefix , 'p3'.
  20164.             state := 'Prolog III file name?'].
  20165.     defaultName := selection named asString , ending.
  20166.     ready := false.
  20167.     [ready]
  20168.         whileFalse: 
  20169.             [fileName := DialogView request: state initialAnswer: defaultName.
  20170.             fileName isEmpty
  20171.                 ifTrue: 
  20172.                     [TTMList speak: 'No filename given ...generation aborted.'.
  20173.                     aStream := nil.
  20174.                     ^nil]
  20175.                 ifFalse: 
  20176.                     [go := false.
  20177.                     fullPath := (Filename named: selection getDirectory)
  20178.                                 constructString: fileName.
  20179.                     (Filename named: fullPath) exists
  20180.                         ifTrue: 
  20181.                             [myMessage := 'Filename already exists. Overwrite?'.
  20182.                             (DialogView confirm: myMessage)
  20183.                                 = true ifTrue: [go := true]]
  20184.                         ifFalse: [go := true].
  20185.                     go = true
  20186.                         ifTrue: 
  20187.                             [aStream := (Filename named: fullPath) writeStream.
  20188.                             codeType = #code
  20189.                                 ifTrue: [prefix := 'Code']
  20190.                                 ifFalse: [prefix := 'SFs'].
  20191.                             prologType = #quintus
  20192.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  20193.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  20194.                             selection fileTitle: state on: aStream.
  20195.                             selection fileNotePadOn: aStream.
  20196.                             ready := true]]].
  20197.     ^aStream! !
  20198.  
  20199. !TTMList methodsFor: 'code output'!
  20200. openFileForNew: prologType as: codeType 
  20201.     "Returns the stream in append mode or 
  20202.     
  20203.     returns nil if file could not be opened."
  20204.  
  20205.     | aStream defaultName fileName ending state ready prefix set go myMessage aTransitionCollection |
  20206.     codeType = #code
  20207.         ifTrue: 
  20208.             [prefix := '.ttm'.
  20209.             editedtrlist := OrderedCollection new.
  20210.             aTransitionCollection := selection computeEffectiveTransitions.
  20211.             aTransitionCollection
  20212.                 do: 
  20213.                     [:x | 
  20214.                     set := OrderedCollection new.
  20215.                     set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  20216.                     editedtrlist add: set]]
  20217.         ifFalse: [prefix := '.sf'].
  20218.     prologType = #quintus
  20219.         ifTrue: 
  20220.             [ending := prefix.
  20221.             state := 'Quintus Prolog file name?']
  20222.         ifFalse: 
  20223.             [ending := prefix , 'p3'.
  20224.             state := 'Prolog III file name?'].
  20225.     defaultName := selection named asString , ending.
  20226.     ready := false.
  20227.     [ready]
  20228.         whileFalse: 
  20229.             [fileName := DialogView request: state initialAnswer: defaultName.
  20230.             fileName isEmpty
  20231.                 ifTrue: 
  20232.                     [TTMList speak: 'No filename given ...generation aborted.'.
  20233.                     aStream := nil.
  20234.                     ready := true]
  20235.                 ifFalse: 
  20236.                     [go := false.
  20237.                     (Filename named: fileName) exists
  20238.                         ifTrue: 
  20239.                             [myMessage := 'Filename already exists. Overwrite?'.
  20240.                             (DialogView confirm: myMessage)
  20241.                                 = true ifTrue: [go := true]]
  20242.                         ifFalse: [go := true].
  20243.                     go = true
  20244.                         ifTrue: 
  20245.                             [aStream := (Filename named: fileName) writeStream.
  20246.                             codeType = #code
  20247.                                 ifTrue: [prefix := 'Code']
  20248.                                 ifFalse: [prefix := 'SFs'].
  20249.                             prologType = #quintus
  20250.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  20251.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  20252.                             selection fileTitle: state on: aStream.
  20253.                             selection fileNotePadOn: aStream.
  20254.                             ready := true]]].
  20255.     ^aStream! !
  20256.  
  20257. !TTMList methodsFor: 'code output'!
  20258. openFileForOld: prologType as: codeType 
  20259.     "Returns the stream in append mode or 
  20260.     
  20261.     returns nil if file could not be opened."
  20262.  
  20263.     | aStream defaultName fileName ending state ready prefix templist shared count set go myMessage |
  20264.     codeType = #code
  20265.         ifTrue: 
  20266.             [prefix := '.ttm'.
  20267.             editedtrlist := OrderedCollection new.
  20268.             templist := selection transitionlist collect: [:element | element].
  20269.             [templist size > 0]
  20270.                 whileTrue: 
  20271.                     [shared := selection transitionlist sharedTransitionsNamed: templist first myName.
  20272.                     count := 1.
  20273.                     [count > shared size]
  20274.                         whileFalse: 
  20275.                             [templist remove: (shared at: count)
  20276.                                 ifAbsent: [].
  20277.                             count := count + 1].
  20278.                     set := selection processSharedTransitions: shared.
  20279.                     editedtrlist add: set]]
  20280.         ifFalse: [prefix := '.sf'].
  20281.     prologType = #quintus
  20282.         ifTrue: 
  20283.             [ending := prefix.
  20284.             state := 'Quintus Prolog file name?']
  20285.         ifFalse: 
  20286.             [ending := prefix , 'p3'.
  20287.             state := 'Prolog III file name?'].
  20288.     defaultName := selection named asString , ending.
  20289.     ready := false.
  20290.     [ready]
  20291.         whileFalse: 
  20292.             [fileName := DialogView request: state initialAnswer: defaultName.
  20293.             fileName isEmpty
  20294.                 ifTrue: 
  20295.                     [TTMList speak: 'No filename given ...generation aborted.'.
  20296.                     aStream := nil.
  20297.                     ready := true]
  20298.                 ifFalse: 
  20299.                     [go := false.
  20300.                     (Filename named: fileName) exists
  20301.                         ifTrue: 
  20302.                             [myMessage := 'Filename already exists. Overwrite?'.
  20303.                             (DialogView confirm: myMessage)
  20304.                                 = true ifTrue: [go := true]]
  20305.                         ifFalse: [go := true].
  20306.                     go = true
  20307.                         ifTrue: 
  20308.                             [aStream := (Filename named: fileName) writeStream.
  20309.                             codeType = #code
  20310.                                 ifTrue: [prefix := 'Code']
  20311.                                 ifFalse: [prefix := 'SFs'].
  20312.                             prologType = #quintus
  20313.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  20314.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  20315.                             selection fileTitle: state on: aStream.
  20316.                             selection fileNotePadOn: aStream.
  20317.                             ready := true]]].
  20318.     ^aStream! !
  20319.  
  20320. !TTMList methodsFor: 'code output'!
  20321. possiblyEnumerate: contents 
  20322.     "Given a guard, convert it into enumerated type 
  20323.     
  20324.     if required."
  20325.  
  20326.     | editable position |
  20327.     enumerateActivities > 0 ifFalse: [^contents]
  20328.         ifTrue: 
  20329.             [editable := OrderedCollection new.
  20330.             (contents includes: '#')
  20331.                 | (contents includes: '=') & contents size = 3
  20332.                 ifTrue: 
  20333.                     [position := nil.
  20334.                     editable add: (contents at: 1) copy.
  20335.                     editable add: (contents at: 2) copy.
  20336.                     position := selection anExistingAVsPosition: (contents at: 1).
  20337.                     position notNil
  20338.                         ifTrue: [editable add: (self enumerationOf: (contents at: 3)
  20339.                                     in: position)]
  20340.                         ifFalse: [editable add: (contents at: 3) copy].
  20341.                     ^editable ].
  20342.             ^contents]! !
  20343.  
  20344. !TTMList methodsFor: 'code output'!
  20345. possiblyEnumerateNew: contents 
  20346.     "Given a guard, convert it into enumerated type 
  20347.     
  20348.     if required."
  20349.  
  20350.     | editable position |
  20351.     enumerateActivities > 0 ifFalse: [^contents]
  20352.         ifTrue: 
  20353.             [editable := OrderedCollection new.
  20354.             (contents includes: '#')
  20355.                 | (contents includes: '=') & contents size = 3
  20356.                 ifTrue: 
  20357.                     [position := nil.
  20358.                     editable add: (contents at: 1) copy.
  20359.                     editable add: (contents at: 2) copy.
  20360.                     position := selection anExistingAVsPosition: (contents at: 1).
  20361.                     position notNil
  20362.                         ifTrue: [editable add: (self enumerationOf: (contents at: 3)
  20363.                                     in: position)]
  20364.                         ifFalse: [editable add: (contents at: 3) copy].
  20365.                     ^editable ].
  20366.             ^contents]! !
  20367.  
  20368. !TTMList methodsFor: 'code output'!
  20369. possiblyEnumerateOld: contents 
  20370.     "Given a guard, convert it into enumerated type 
  20371.     
  20372.     if required."
  20373.  
  20374.     | editable possibleVar possibleValue position newValue expression |
  20375.     enumerateActivities > 0 ifFalse: [^contents]
  20376.         ifTrue: 
  20377.             [(contents includes: '#')
  20378.                 | (contents includes: '=')
  20379.                 ifTrue: 
  20380.                     [expression := (contents at: 2) copy.
  20381.                     possibleVar := (contents at: 1) copy.
  20382.                     possibleValue := (contents at: 3) copy.
  20383.                     position := selection anExistingAVsPosition: possibleVar.
  20384.                     position notNil
  20385.                         ifTrue: [newValue := self enumerationOf: possibleValue in: position]
  20386.                         ifFalse: [newValue := possibleValue].
  20387.                     editable := OrderedCollection new.
  20388.                     editable add: possibleVar; add: expression; add: newValue.
  20389.                     ^editable].
  20390.             ^contents]! !
  20391.  
  20392. !TTMList methodsFor: 'code output'!
  20393. sfAsProlog3
  20394.     "output SFs in the prolog 3 format"
  20395.  
  20396.     | aStream count anSF anSFNumber |
  20397.     aStream := self openFileFor: #prolog3 as: #sfs.
  20398.     aStream = nil
  20399.         ifFalse: 
  20400.             [self variablesInitialize.
  20401.             self enumerationCommentOn: aStream.
  20402.             selection fileHeading: 'SFs:' on: aStream.
  20403.             count := 1.
  20404.             [count > selection stateFormulas size]
  20405.                 whileFalse: 
  20406.                     [anSF := (selection stateFormulas at: count)
  20407.                                 at: 2.
  20408.                     anSFNumber := (selection stateFormulas at: count)
  20409.                                 at: 1.
  20410.                     selection fileThis: (self
  20411.                             makeSF: anSF
  20412.                             with: anSFNumber
  20413.                             for: #prolog3)
  20414.                         on: aStream.
  20415.                     count := count + 1].
  20416.             selection fileHeading: 'SF negations:' on: aStream.
  20417.             count := 1.
  20418.             [count > selection stateFormulas size]
  20419.                 whileFalse: 
  20420.                     [anSF := (selection stateFormulas at: count)
  20421.                                 at: 2.
  20422.                     anSFNumber := (selection stateFormulas at: count)
  20423.                                 at: 1.
  20424.                     selection fileThis: (self makeSFNegations: anSF with: anSFNumber)
  20425.                         on: aStream.
  20426.                     count := count + 1].
  20427.             aStream close]! !
  20428.  
  20429. !TTMList methodsFor: 'code output'!
  20430. sfAsQuintus
  20431.     "output SFs in the quintus prolog format"
  20432.  
  20433.     | aStream anSF count anSFNumber |
  20434.     aStream := self openFileFor: #quintus as: #sfs.
  20435.     aStream = nil
  20436.         ifFalse: 
  20437.             [self variablesInitialize.
  20438.             self enumerationCommentOn: aStream.
  20439.             selection fileHeading: 'Multifile and Dynamic declarations:' on: aStream.
  20440.             selection fileLine: ':- multifile prop/3, sf/3.' on: aStream.
  20441.             selection fileLine: ':- dynamic prop/3, sf/3.' on: aStream.
  20442.             selection fileHeading: 'Prop definitions:' on: aStream.
  20443.             selection fileThis: self makeEnabledForQuintus on: aStream.
  20444.             selection fileHeading: 'SFs:' on: aStream.
  20445.             count := 1.
  20446.             [count > selection stateFormulas size]
  20447.                 whileFalse: 
  20448.                     [anSF := (selection stateFormulas at: count)
  20449.                                 at: 2.
  20450.                     anSFNumber := (selection stateFormulas at: count)
  20451.                                 at: 1.
  20452.                     selection fileThis: (self
  20453.                             makeSF: anSF
  20454.                             with: anSFNumber
  20455.                             for: #quintus)
  20456.                         on: aStream.
  20457.                     count := count + 1].
  20458.             aStream close]! !
  20459.  
  20460. !TTMList methodsFor: 'code generation'!
  20461. divideAssignment: str 
  20462.     | res ind comma colon |
  20463.     ind := 1.
  20464.     res := OrderedCollection new.
  20465.     (str occurrencesOf: $:)
  20466.         timesRepeat: 
  20467.             [comma := str
  20468.                         nextIndexOf: $,
  20469.                         from: ind
  20470.                         to: str size.
  20471.             comma isNil ifTrue: [comma := str size + 1].
  20472.             colon := str
  20473.                         nextIndexOf: $:
  20474.                         from: ind
  20475.                         to: str size.
  20476.             res add: (Array with: (str copyFrom: ind to: colon - 1)
  20477.                     with: (str copyFrom: colon + 1 to: comma - 1)).
  20478.             ind := comma + 1].
  20479.     ^res! !
  20480.  
  20481. !TTMList methodsFor: 'code generation'!
  20482. functionTraverse: start lookFor: targetVariable 
  20483.     "A recursive traversal."
  20484.  
  20485.     | count assignment |
  20486.     start left ~= nil & temporary isNil ifTrue: [self functionTraverse: start left lookFor: targetVariable].
  20487.     start right ~= nil & temporary isNil ifTrue: [self functionTraverse: start right lookFor: targetVariable].
  20488.     start isAtom & temporary isNil ifTrue: [(start contents at: 1)
  20489.             = targetVariable
  20490.             ifTrue: 
  20491.                 [count := 3.
  20492.                 assignment := ''.
  20493.                 [count > start contents size]
  20494.                     whileFalse: 
  20495.                         [assignment := assignment , (start contents at: count).
  20496.                         count := count + 1].
  20497.                 temporary := assignment]]! !
  20498.  
  20499. !TTMList methodsFor: 'code generation'!
  20500. getLHSOfAssignmentsIn: str 
  20501.     | res ind comma colon |
  20502.     ind := 1.
  20503.     res := OrderedCollection new.
  20504.     (str occurrencesOf: $:)
  20505.         timesRepeat: 
  20506.             [comma := str
  20507.                         nextIndexOf: $,
  20508.                         from: ind
  20509.                         to: str size.
  20510.             comma isNil ifTrue: [comma := str size + 1].
  20511.             colon := str
  20512.                         nextIndexOf: $:
  20513.                         from: ind
  20514.                         to: str size.
  20515.             res add: (str copyFrom: ind to: colon - 1).
  20516.             ind := comma + 1].
  20517.     ^res! !
  20518.  
  20519. !TTMList methodsFor: 'code generation'!
  20520. guardTraverseP3: start 
  20521.     "A recursive traversal. Differs from Quintus 
  20522.     
  20523.     by not inserting left and right brackets."
  20524.  
  20525.     | count newContents e enumeratedContents |
  20526.     
  20527.     start left ~= nil ifTrue: [self guardTraverseP3: start left].
  20528.     start right ~= nil ifTrue: [self guardTraverseP3: start right].
  20529.     start contents ~= 'ROOT' ifTrue: [start isAtom
  20530.             ifTrue: 
  20531.                 [count := 1.
  20532.                 newContents := ''.
  20533.                 enumeratedContents := self possiblyEnumerate: start contents.
  20534.                 start contents: enumeratedContents.
  20535.                 [count > start contents size]
  20536.                     whileFalse: 
  20537.                         [e := (start contents at: count) copy.
  20538.                         newContents := newContents , e asString.
  20539.                         count := count + 1].
  20540.                 start contents: newContents]
  20541.             ifFalse: [start contents = 'AND'
  20542.                     ifTrue: [start contents: start left contents , ',' , start right contents]
  20543.                     ifFalse: [start contents: start left contents , ';' , start right contents]]]! !
  20544.  
  20545. !TTMList methodsFor: 'code generation'!
  20546. guardTraverseQuintus: start 
  20547.     "A recursive traversal."
  20548.  
  20549.     | count newContents e enumeratedContents |
  20550.     start left ~= nil ifTrue: [self guardTraverseQuintus: start left].
  20551.     start right ~= nil ifTrue: [self guardTraverseQuintus: start right].
  20552.     start contents ~= 'ROOT' ifTrue: [start isAtom
  20553.             ifTrue: 
  20554.                 [count := 1.
  20555.                 newContents := ''.
  20556.                 enumeratedContents := self possiblyEnumerate: start contents.
  20557.                 start contents: enumeratedContents.
  20558.                 [count > start contents size]
  20559.                     whileFalse: [(start contents includes: '#')
  20560.                             ifTrue: 
  20561.                                 [count = 1 ifTrue: [newContents := newContents , 'not('].
  20562.                                 e := start contents at: count.
  20563.                                 e = '#' ifTrue: [e := '='].
  20564.                                 newContents := newContents , e.
  20565.                                 count := count + 1.
  20566.                                 count > start contents size ifTrue: [newContents := newContents , ')']]
  20567.                             ifFalse: 
  20568.                                 [e := start contents at: count.
  20569.                                 newContents := newContents , e.
  20570.                                 count := count + 1]].
  20571.                 start contents: newContents]
  20572.             ifFalse: [start contents = 'AND'
  20573.                     ifTrue: [start contents: '(' , start left contents , ',' , start right contents , ')']
  20574.                     ifFalse: [start contents: '(' , start left contents , ';' , start right contents , ')']]]! !
  20575.  
  20576. !TTMList methodsFor: 'code generation'!
  20577. makeEnabledForQuintus
  20578.     | table |
  20579.     table := OrderedCollection new.
  20580.     table add: '?-consult(''' , selection named , '.ttm'').'.
  20581.     table add: 'prop(' , selection named , ',  enabled, [ X, N ] ) :-'.
  20582.     table add: '        en(' , selection named , ', Transition, X ),  not (Transition = tick).'.
  20583.     ^table! !
  20584.  
  20585. !TTMList methodsFor: 'code generation'!
  20586. makeFunction: aFunction 
  20587.     "We go through each 
  20588.     
  20589.     variable in the ttm. If there is an assignment for it 
  20590.     
  20591.     put in newFunction, else put variable itself."
  20592.     "NOTE if there are multiple assignments for a 
  20593.     
  20594.     variable, this routine will ONLY select the first one."
  20595.  
  20596.     | newFunction count supplement currentVariable position lhs df ind |
  20597.     count := 1.
  20598.     newFunction := ''.
  20599.     lhs := self getLHSOfAssignmentsIn: aFunction.
  20600.     df := self divideAssignment: aFunction.
  20601.     variableSet
  20602.         do: 
  20603.             [:x | 
  20604.             currentVariable := x at: 1.
  20605.             temporary := nil.
  20606.             (lhs includes: currentVariable)
  20607.                 = false
  20608.                 ifTrue: [temporary := nil]
  20609.                 ifFalse: [df size > 0
  20610.                         ifTrue: 
  20611.                             [ind := 1.
  20612.                             [temporary = nil]
  20613.                                 whileTrue: [((df at: ind)
  20614.                                         at: 1)
  20615.                                         = currentVariable
  20616.                                         ifTrue: [temporary := (df at: ind)
  20617.                                                         at: 2]
  20618.                                         ifFalse: [ind := ind + 1]]]].
  20619.             temporary isNil
  20620.                 ifFalse: 
  20621.                     [position := selection anExistingAVsPosition: currentVariable.
  20622.                     position notNil
  20623.                         ifTrue: 
  20624.                             [supplement := self enumerationOf: temporary in: position.
  20625.                             supplement isNil ifTrue: [supplement := temporary]]
  20626.                         ifFalse: [supplement := temporary]]
  20627.                 ifTrue: [supplement := currentVariable].
  20628.             newFunction := newFunction , supplement , ','.
  20629.             count := count + 1].
  20630.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  20631.  
  20632. !TTMList methodsFor: 'code generation'!
  20633. makeFunctionOld: aFunction 
  20634.     "Form a parse tree. Now, we go through each 
  20635.     
  20636.     variable in the ttm. If there is an assignment for it 
  20637.     
  20638.     put in newFunction, else put variable itself."
  20639.     "NOTE if there are multiple assignments for a 
  20640.     
  20641.     variable, this routine will ONLY select the first one."
  20642.  
  20643.     | root newFunction count supplement currentVariable position |
  20644.     root := (ParseTree orderIntoTree: (ParseTree fission: aFunction definedAs: #function)
  20645.                 from: selection) treeRoot.
  20646.     count := 1.
  20647.     newFunction := ''.
  20648.     [count > variableSet size]
  20649.         whileFalse: 
  20650.             [currentVariable := (variableSet at: count)
  20651.                         at: 1.
  20652.             temporary := nil.
  20653.             self functionTraverse: root lookFor: currentVariable.
  20654.             temporary isNil
  20655.                 ifFalse: 
  20656.                     [position := selection anExistingAVsPosition: currentVariable.
  20657.                     position notNil
  20658.                         ifTrue: 
  20659.                             [supplement := self enumerationOf: temporary in: position.
  20660.                             supplement isNil ifTrue: [supplement := temporary]]
  20661.                         ifFalse: [supplement := temporary]]
  20662.                 ifTrue: [supplement := currentVariable].
  20663.             newFunction := newFunction , supplement , ','.
  20664.             count := count + 1].
  20665.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  20666.  
  20667. !TTMList methodsFor: 'code generation'!
  20668. makeFunctionQuintus: aFunction 
  20669.     "Form a parse tree. Now, we go through each 
  20670.     
  20671.     variable in the ttm. If there is an assignment for it 
  20672.     
  20673.     put in newFunction, else put variable itself."
  20674.     "NOTE if there are multiple assignments for a 
  20675.     
  20676.     variable, this routine will ONLY select the first one."
  20677.  
  20678.     | lhs newFunction count supplement currentVariable position setOfFunctions df ind |
  20679.     count := 1.
  20680.     newFunction := ''.
  20681.     setOfFunctions := OrderedCollection new.
  20682.     lhs := self getLHSOfAssignmentsIn: aFunction.
  20683.     df := self divideAssignment: aFunction.
  20684.     variableSet
  20685.         do: 
  20686.             [:x | 
  20687.             currentVariable := x at: 1.
  20688.             temporary := nil.
  20689.             (lhs includes: currentVariable)
  20690.                 = false
  20691.                 ifTrue: [temporary := nil]
  20692.                 ifFalse: [df size > 0
  20693.                         ifTrue: 
  20694.                             [ind := 1.
  20695.                             [temporary = nil]
  20696.                                 whileTrue: [((df at: ind)
  20697.                                         at: 1)
  20698.                                         = currentVariable
  20699.                                         ifTrue: [temporary := (df at: ind)
  20700.                                                         at: 2]
  20701.                                         ifFalse: [ind := ind + 1]]]].
  20702.             temporary isNil
  20703.                 ifFalse: 
  20704.                     [position := selection anExistingAVsPosition: currentVariable.
  20705.                     position notNil
  20706.                         ifTrue: 
  20707.                             [supplement := self enumerationOf: temporary in: position.
  20708.                             supplement isNil ifTrue: [supplement := temporary]]
  20709.                         ifFalse: 
  20710.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  20711.                             supplement := currentVariable , 'new']]
  20712.                 ifTrue: [supplement := currentVariable].
  20713.             newFunction := newFunction , supplement , ','.
  20714.             count := count + 1].
  20715.     temporary := setOfFunctions.
  20716.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  20717.  
  20718. !TTMList methodsFor: 'code generation'!
  20719. makeFunctionQuintusOld: aFunction 
  20720.     "Form a parse tree. Now, we go through each 
  20721.     
  20722.     variable in the ttm. If there is an assignment for it 
  20723.     
  20724.     put in newFunction, else put variable itself."
  20725.     "NOTE if there are multiple assignments for a 
  20726.     
  20727.     variable, this routine will ONLY select the first one."
  20728.  
  20729.     | root newFunction count supplement currentVariable position setOfFunctions   |
  20730.     root := (ParseTree orderIntoTree: (ParseTree fission: aFunction definedAs: #function)
  20731.                 from: selection) treeRoot.
  20732.     count := 1.
  20733.     newFunction := ''.
  20734.     setOfFunctions := OrderedCollection new.
  20735.     [count > variableSet size]
  20736.         whileFalse: 
  20737.             [currentVariable := (variableSet at: count)
  20738.                         at: 1.
  20739.             temporary := nil.
  20740.             self functionTraverse: root lookFor: currentVariable.
  20741.             temporary isNil
  20742.                 ifFalse: 
  20743.                     [position := selection anExistingAVsPosition: currentVariable.
  20744.                     position notNil
  20745.                         ifTrue: 
  20746.                             [supplement := self enumerationOf: temporary in: position.
  20747.                             supplement isNil ifTrue: [supplement := temporary]]
  20748.                         ifFalse: 
  20749.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  20750.                             supplement := currentVariable , 'new']]
  20751.                 ifTrue: [supplement := currentVariable].
  20752.             newFunction := newFunction , supplement , ','.
  20753.             count := count + 1].
  20754.     temporary := setOfFunctions.
  20755.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  20756.  
  20757. !TTMList methodsFor: 'code generation'!
  20758. makeFunctionQuintusX: aFunction 
  20759.     "Form a parse tree. Now, we go through each 
  20760.     
  20761.     variable in the ttm. If there is an assignment for it 
  20762.     
  20763.     put in newFunction, else put variable itself."
  20764.     "NOTE if there are multiple assignments for a 
  20765.     
  20766.     variable, this routine will ONLY select the first one."
  20767.  
  20768.     | lhs newFunction count supplement currentVariable position setOfFunctions |
  20769.     count := 1.
  20770.     newFunction := ''.
  20771.     setOfFunctions := OrderedCollection new.
  20772.     lhs := self getLHSOfAssignmentsIn: aFunction.
  20773.     (self divideAssignment: aFunction)
  20774.         do: 
  20775.             [:x | 
  20776.             currentVariable := x at: 1.
  20777.             temporary := nil.
  20778.             (lhs includes: currentVariable)
  20779.                 = false
  20780.                 ifTrue: [temporary := nil]
  20781.                 ifFalse: [temporary := x at: 2].
  20782.             temporary isNil
  20783.                 ifFalse: 
  20784.                     [position := selection anExistingAVsPosition: currentVariable.
  20785.                     position notNil
  20786.                         ifTrue: 
  20787.                             [supplement := self enumerationOf: temporary in: position.
  20788.                             supplement isNil ifTrue: [supplement := temporary]]
  20789.                         ifFalse: 
  20790.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  20791.                             supplement := currentVariable , 'new']]
  20792.                 ifTrue: [supplement := currentVariable].
  20793.             newFunction := newFunction , supplement , ','.
  20794.             count := count + 1].
  20795.     temporary := setOfFunctions.
  20796.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  20797.  
  20798. !TTMList methodsFor: 'code generation'!
  20799. makeFunctionsFor: prologType 
  20800.     "Create h() predicates for all of the transitions 
  20801.     
  20802.     in the ttm, selection."
  20803.  
  20804.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  20805.     table := OrderedCollection new.
  20806.     common := 'h(' , selection named , ', '.
  20807.     prologType = #quintus
  20808.         ifTrue: 
  20809.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  20810.             table add: current.
  20811.             trCount := 1.
  20812.             [trCount > editedtrlist size]
  20813.                 whileFalse: 
  20814.                     [currentTr := editedtrlist at: trCount.
  20815.                     samplename := currentTr at: 1.
  20816.                     samplefunction := currentTr at: 3.
  20817.                     temporary := OrderedCollection new.
  20818.                     samplefunction = 'nil'
  20819.                         ifTrue: [supplement := self variablesUppercase]
  20820.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  20821.                     temporary size = 0
  20822.                         ifTrue: 
  20823.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  20824.                             table add: current]
  20825.                         ifFalse: 
  20826.                             [tempCount := 1.
  20827.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  20828.                             table add: current.
  20829.                             [tempCount > temporary size]
  20830.                                 whileFalse: 
  20831.                                     [temp1 := temporary at: tempCount.
  20832.                                     temp1 := TTMList
  20833.                                                 inString: temp1
  20834.                                                 replace: '%'
  20835.                                                 with: ' mod '.
  20836.                                     temp1 := TTMList
  20837.                                                 inString: temp1
  20838.                                                 replace: '/'
  20839.                                                 with: ' div '.
  20840.                                     current := '     ' , temp1.
  20841.                                     tempCount = temporary size
  20842.                                         ifTrue: [current := current , '.']
  20843.                                         ifFalse: [current := current , ','].
  20844.                                     table add: current.
  20845.                                     tempCount := tempCount + 1]].
  20846.                     trCount := trCount + 1]]
  20847.         ifFalse: 
  20848.             [trCount := 1.
  20849.             [trCount > editedtrlist size]
  20850.                 whileFalse: 
  20851.                     [currentTr := editedtrlist at: trCount.
  20852.                     samplename := currentTr at: 1.
  20853.                     samplefunction := currentTr at: 3.
  20854.                     samplefunction = 'nil'
  20855.                         ifTrue: [supplement := self variablesUppercase]
  20856.                         ifFalse: 
  20857.                             [supplement := self makeFunction: samplefunction.
  20858.                             supplement := TTMList
  20859.                                         inString: supplement
  20860.                                         replace: '%'
  20861.                                         with: ' mod '.
  20862.                             supplement := TTMList
  20863.                                         inString: supplement
  20864.                                         replace: '/'
  20865.                                         with: ' div '].
  20866.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  20867.                     table add: current.
  20868.                     trCount := trCount + 1]].
  20869.     ^table! !
  20870.  
  20871. !TTMList methodsFor: 'code generation'!
  20872. makeFunctionsForNew: prologType 
  20873.     "Create h() predicates for all of the transitions 
  20874.     
  20875.     in the ttm, selection."
  20876.  
  20877.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  20878.     table := OrderedCollection new.
  20879.     common := 'h(' , selection named , ', '.
  20880.     prologType = #quintus
  20881.         ifTrue: 
  20882.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  20883.             table add: current.
  20884.             trCount := 1.
  20885.             [trCount > editedtrlist size]
  20886.                 whileFalse: 
  20887.                     [currentTr := editedtrlist at: trCount.
  20888.                     samplename := currentTr at: 1.
  20889.                     samplefunction := currentTr at: 3.
  20890.                     temporary := OrderedCollection new.
  20891.                     samplefunction = 'nil'
  20892.                         ifTrue: [supplement := self variablesUppercase]
  20893.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  20894.                     temporary size = 0
  20895.                         ifTrue: 
  20896.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  20897.                             table add: current]
  20898.                         ifFalse: 
  20899.                             [tempCount := 1.
  20900.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  20901.                             table add: current.
  20902.                             [tempCount > temporary size]
  20903.                                 whileFalse: 
  20904.                                     [temp1 := temporary at: tempCount.
  20905.                                     temp1 := TTMList
  20906.                                                 inString: temp1
  20907.                                                 replace: '%'
  20908.                                                 with: ' mod '.
  20909.                                     temp1 := TTMList
  20910.                                                 inString: temp1
  20911.                                                 replace: '/'
  20912.                                                 with: ' div '.
  20913.                                     current := '     ' , temp1.
  20914.                                     tempCount = temporary size
  20915.                                         ifTrue: [current := current , '.']
  20916.                                         ifFalse: [current := current , ','].
  20917.                                     table add: current.
  20918.                                     tempCount := tempCount + 1]].
  20919.                     trCount := trCount + 1]]
  20920.         ifFalse: 
  20921.             [trCount := 1.
  20922.             [trCount > editedtrlist size]
  20923.                 whileFalse: 
  20924.                     [currentTr := editedtrlist at: trCount.
  20925.                     samplename := currentTr at: 1.
  20926.                     samplefunction := currentTr at: 3.
  20927.                     samplefunction = 'nil'
  20928.                         ifTrue: [supplement := self variablesUppercase]
  20929.                         ifFalse: 
  20930.                             [supplement := self makeFunction: samplefunction.
  20931.                             supplement := TTMList
  20932.                                         inString: supplement
  20933.                                         replace: '%'
  20934.                                         with: ' mod '.
  20935.                             supplement := TTMList
  20936.                                         inString: supplement
  20937.                                         replace: '/'
  20938.                                         with: ' div '].
  20939.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  20940.                     table add: current.
  20941.                     trCount := trCount + 1]].
  20942.     ^table! !
  20943.  
  20944. !TTMList methodsFor: 'code generation'!
  20945. makeFunctionsForOld: prologType 
  20946.     "Create h() predicates for all of the transitions 
  20947.     
  20948.     in the ttm, selection."
  20949.  
  20950.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  20951.     table := OrderedCollection new.
  20952.     common := 'h(' , selection named , ', '.
  20953.     prologType = #quintus
  20954.         ifTrue: 
  20955.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  20956.             table add: current.
  20957.             trCount := 1.
  20958.             [trCount > editedtrlist size]
  20959.                 whileFalse: 
  20960.                     [currentTr := editedtrlist at: trCount.
  20961.                     samplename := currentTr at: 1.
  20962.                     samplefunction := currentTr at: 3.
  20963.                     temporary := OrderedCollection new.
  20964.                     samplefunction = 'nil'
  20965.                         ifTrue: [supplement := self variablesUppercase]
  20966.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  20967.                     temporary size = 0
  20968.                         ifTrue: 
  20969.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  20970.                             table add: current]
  20971.                         ifFalse: 
  20972.                             [tempCount := 1.
  20973.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  20974.                             table add: current.
  20975.                             [tempCount > temporary size]
  20976.                                 whileFalse: 
  20977.                                     [temp1 := temporary at: tempCount.
  20978.                                     temp1 := TTMList
  20979.                                                 inString: temp1
  20980.                                                 replace: '%'
  20981.                                                 with: ' mod '.
  20982.                                     temp1 := TTMList
  20983.                                                 inString: temp1
  20984.                                                 replace: '/'
  20985.                                                 with: ' div '.
  20986.                                     current := '     ' , temp1.
  20987.                                     tempCount = temporary size
  20988.                                         ifTrue: [current := current , '.']
  20989.                                         ifFalse: [current := current , ','].
  20990.                                     table add: current.
  20991.                                     tempCount := tempCount + 1]].
  20992.                     trCount := trCount + 1]]
  20993.         ifFalse: 
  20994.             [trCount := 1.
  20995.             [trCount > editedtrlist size]
  20996.                 whileFalse: 
  20997.                     [currentTr := editedtrlist at: trCount.
  20998.                     samplename := currentTr at: 1.
  20999.                     samplefunction := currentTr at: 3.
  21000.                     samplefunction = 'nil'
  21001.                         ifTrue: [supplement := self variablesUppercase]
  21002.                         ifFalse: [supplement := self makeFunction: samplefunction].
  21003.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  21004.                     table add: current.
  21005.                     trCount := trCount + 1]].
  21006.     ^table! !
  21007.  
  21008. !TTMList methodsFor: 'code generation'!
  21009. makeGuard: aGuard for: prologType 
  21010.     "Given a guard string, make a Parse Tree then 
  21011.     
  21012.     use it to make brackets around stuff, then 
  21013.     
  21014.     return a table of lines that should be output."
  21015.  
  21016.     | root tree |
  21017.     tree := ParseTree orderIntoTree: (ParseTree fission: aGuard copy definedAs: #guard)
  21018.                 from: selection.
  21019.     prologType = #prolog3
  21020.         ifTrue: 
  21021.             [root := tree inPrenexForm treeRoot.
  21022.             self guardTraverseP3: root.
  21023.             ^self separateLinesP3: root left contents]
  21024.         ifFalse: 
  21025.             ["root := tree treeRoot.
  21026.             self guardTraverseQuintus: root.
  21027.             ^self separateLinesQuintus: root left contents"
  21028.             ^self separateLinesQuintus: aGuard]! !
  21029.  
  21030. !TTMList methodsFor: 'code generation'!
  21031. makeGuardsFor: prologType 
  21032.     "Create en() predicates for all of the 
  21033.     
  21034.     transitions in the ttm, selection."
  21035.  
  21036.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  21037.     table := OrderedCollection new.
  21038.     common := 'en(' , selection named , ', '.
  21039.     prologType = #quintus
  21040.         ifTrue: 
  21041.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  21042.             table add: preamble].
  21043.     trCount := 1.
  21044.     [trCount > editedtrlist size]
  21045.         whileFalse: 
  21046.             [currentTr := editedtrlist at: trCount.
  21047.             samplename := currentTr at: 1.
  21048.             sampleguard := currentTr at: 2.
  21049.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  21050.             sampleguard = 'nil'
  21051.                 ifTrue: [table add: preamble , '. ']
  21052.                 ifFalse: 
  21053.                     [prologType = #quintus
  21054.                         ifTrue: 
  21055.                             [preamble := preamble , ' :-'.
  21056.                             table add: preamble]
  21057.                         ifFalse: [preamble := preamble , '{'].
  21058.                     supplement := self makeGuard: sampleguard for: prologType.
  21059.                     count := 1.
  21060.                     [count > supplement size]
  21061.                         whileFalse: 
  21062.                             [temp1 := supplement at: count.
  21063.                             temp1 := TTMList
  21064.                                         inString: temp1
  21065.                                         replace: '%'
  21066.                                         with: ' mod '.
  21067.                             temp1 := TTMList
  21068.                                         inString: temp1
  21069.                                         replace: '/'
  21070.                                         with: ' div '.
  21071.                             prologType = #quintus
  21072.                                 ifTrue: 
  21073.                                     [temp1 := TTMList
  21074.                                                 inString: temp1
  21075.                                                 replace: '#'
  21076.                                                 with: ' \= '.
  21077.                                     table add: temp1]
  21078.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  21079.                             count := count + 1]].
  21080.             trCount := trCount + 1].
  21081.     ^table! !
  21082.  
  21083. !TTMList methodsFor: 'code generation'!
  21084. makeInitialConditionFor: prologType 
  21085.     | table supplement count preamble currentIC currentout c e position resultingValue |
  21086.     table := OrderedCollection new.
  21087.     variableSet size > 0 ifTrue: [prologType = #quintus
  21088.             ifTrue: [selection specificIC size = 0
  21089.                     ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  21090.                     ifFalse: 
  21091.                         [preamble := 'initialcondition(' , selection named , ', ['.
  21092.                         count := 1.
  21093.                         [count > selection specificIC size]
  21094.                             whileFalse: 
  21095.                                 [currentIC := (selection specificIC at: count)
  21096.                                             at: 2.
  21097.                                 currentout := preamble.
  21098.                                 c := 1.
  21099.                                 [c > currentIC size]
  21100.                                     whileFalse: 
  21101.                                         [e := currentIC at: c.
  21102.                                         position := selection anExistingAVsPosition: (e at: 1).
  21103.                                         position notNil
  21104.                                             ifTrue: 
  21105.                                                 [resultingValue := self enumerationOf: (e at: 2)
  21106.                                                             in: position.
  21107.                                                 resultingValue isNil ifTrue: [resultingValue := e at: 2]]
  21108.                                             ifFalse: [resultingValue := e at: 2].
  21109.                                         currentout := currentout , resultingValue.
  21110.                                         c = currentIC size ifFalse: [currentout := currentout , ', ']
  21111.                                             ifTrue: 
  21112.                                                 [currentout := currentout , ']). '.
  21113.                                                 table add: currentout].
  21114.                                         c := c + 1].
  21115.                                 count := count + 1]]]
  21116.             ifFalse: [selection initialcondition asString = 'nil'
  21117.                     ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  21118.                     ifFalse: 
  21119.                         [preamble := 'initialcondition(' , selection named , ', ' , self variablesUppercase , ')'.
  21120.                         preamble := preamble , ' {'.
  21121.                         supplement := self makeGuard: selection initialcondition for: prologType.
  21122.                         count := 1.
  21123.                         [count > supplement size]
  21124.                             whileFalse: 
  21125.                                 [table add: preamble , (supplement at: count) , '}. '.
  21126.                                 count := count + 1]]]].
  21127.     ^table! !
  21128.  
  21129. !TTMList methodsFor: 'code generation'!
  21130. makeLohisFor: prologType 
  21131.     "Create lohi() predicates for all of the 
  21132.     
  21133.     transitions in the ttm, selection."
  21134.  
  21135.     | table common current trCount currentTr samplename samplelow samplehi |
  21136.     table := OrderedCollection new.
  21137.     common := 'lohi(' , selection named , ', '.
  21138.     prologType = #quintus
  21139.         ifTrue: 
  21140.             [current := common , 'tick, 0, infinity). '.
  21141.             table add: current].
  21142.     trCount := 1.
  21143.     [trCount > editedtrlist size]
  21144.         whileFalse: 
  21145.             [currentTr := editedtrlist at: trCount.
  21146.             samplename := currentTr at: 1.
  21147.             samplelow := currentTr at: 4.
  21148.             samplehi := currentTr at: 5.
  21149.             current := common , samplename , ', ' , samplelow , ', ' , samplehi , '). '.
  21150.             table add: current.
  21151.             trCount := trCount + 1].
  21152.     ^table! !
  21153.  
  21154. !TTMList methodsFor: 'code generation'!
  21155. makeMap
  21156.     | table current count |
  21157.     table := OrderedCollection new.
  21158.     variableSet size > 0
  21159.         ifTrue: 
  21160.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  21161.             table add: current.
  21162.             count := 1.
  21163.             [count >= variableSet size]
  21164.                 whileFalse: 
  21165.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  21166.                                     noName: #false) , ','.
  21167.                     table add: current.
  21168.                     count := count + 1].
  21169.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  21170.                             noName: #false) , '. '.
  21171.             table add: current].
  21172.     ^table! !
  21173.  
  21174. !TTMList methodsFor: 'code generation'!
  21175. makeMapForP3
  21176.     | table current count |
  21177.     table := OrderedCollection new.
  21178.     variableSet size > 0
  21179.         ifTrue: 
  21180.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  21181.             table add: current.
  21182.             count := 1.
  21183.             [count >= variableSet size]
  21184.                 whileFalse: 
  21185.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  21186.                                     noName: #false) , ','.
  21187.                     table add: current.
  21188.                     count := count + 1].
  21189.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  21190.                             noName: #false) , '. '.
  21191.             table add: current].
  21192.     ^table! !
  21193.  
  21194. !TTMList methodsFor: 'code generation'!
  21195. makeMapForQP
  21196.     | table current count |
  21197.     table := OrderedCollection new.
  21198.     variableSet size > 0
  21199.         ifTrue: 
  21200.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  21201.             table add: current.
  21202.             count := 1.
  21203.             [count >= variableSet size]
  21204.                 whileFalse: 
  21205.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  21206.                                     noName: #true) , ','.
  21207.                     table add: current.
  21208.                     count := count + 1].
  21209.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  21210.                             noName: #true) , '. '.
  21211.             table add: current].
  21212.     ^table! !
  21213.  
  21214. !TTMList methodsFor: 'code generation'!
  21215. makeNegation: aGuard 
  21216.     | root |
  21217.     root := (ParseTree orderIntoTree: (ParseTree fission: aGuard definedAs: #guard)
  21218.                 from: selection) negation inPrenexForm treeRoot.
  21219.     self guardTraverseP3: root.
  21220.     ^self separateLinesP3: root left contents! !
  21221.  
  21222. !TTMList methodsFor: 'code generation'!
  21223. makeNegations
  21224.     "Create negen() predicates for all of the 
  21225.     
  21226.     transitions in the ttm, selection."
  21227.  
  21228.     | table common current samplename sampleguard supplement trCount currentTr |
  21229.     table := OrderedCollection new.
  21230.     common := 'negen(' , selection named , ', '.
  21231.     trCount := 1.
  21232.     [trCount > editedtrlist size]
  21233.         whileFalse: 
  21234.             [currentTr := editedtrlist at: trCount.
  21235.             samplename := currentTr at: 1.
  21236.             sampleguard := currentTr at: 2.
  21237.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  21238.             sampleguard = 'nil'
  21239.                 ifTrue: [table add: current , '. ']
  21240.                 ifFalse: 
  21241.                     [current := current , ' {'.
  21242.                     supplement := self makeNegation: sampleguard copy.
  21243.                     supplement do: [:x | table add: current , x , '}. ']].
  21244.             trCount := trCount + 1].
  21245.     ^table! !
  21246.  
  21247. !TTMList methodsFor: 'code generation'!
  21248. makeNegationsDebug
  21249.     "Create negen() predicates for all of the 
  21250.     
  21251.     transitions in the ttm, selection."
  21252.  
  21253.     | table common current samplename sampleguard supplement trCount currentTr temp  |
  21254.     table := OrderedCollection new.
  21255.     temp := OrderedCollection new.
  21256.     common := 'negen(' , selection named , ', '.
  21257.     trCount := 1.
  21258.     [trCount > editedtrlist size]
  21259.         whileFalse: 
  21260.             [currentTr := editedtrlist at: trCount.
  21261.             samplename := currentTr at: 1.
  21262.             sampleguard := currentTr at: 2.
  21263.             temp add: sampleguard.
  21264.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  21265.             sampleguard = 'nil'
  21266.                 ifTrue: [table add: current , '. ']
  21267.                 ifFalse: 
  21268.                     [current := current , ' {'.
  21269.                     supplement := (TTMList new) makeNegation: sampleguard.
  21270.                     temp add: supplement.
  21271.                     supplement do: [:x | table add: current , x , '}. ']].
  21272.             trCount := trCount + 1].
  21273.     temp inspect.
  21274.     ^table! !
  21275.  
  21276. !TTMList methodsFor: 'code generation'!
  21277. makeNegationsNew
  21278.     "Create negen() predicates for all of the 
  21279.     
  21280.     transitions in the ttm, selection."
  21281.  
  21282.     | table common current samplename sampleguard supplement trCount currentTr |
  21283.     table := OrderedCollection new.
  21284.     common := 'negen(' , selection named , ', '.
  21285.     trCount := 1.
  21286.     [trCount > editedtrlist size]
  21287.         whileFalse: 
  21288.             [currentTr := editedtrlist at: trCount.
  21289.             samplename := currentTr at: 1.
  21290.             sampleguard := currentTr at: 2.
  21291.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  21292.             sampleguard = 'nil'
  21293.                 ifTrue: [table add: current , '. ']
  21294.                 ifFalse: 
  21295.                     [current := current , ' {'.
  21296.                     supplement := self makeNegation: sampleguard.
  21297.                     supplement do: [:x | table add: current , x , '}. ']].
  21298.             trCount := trCount + 1].
  21299.     ^table! !
  21300.  
  21301. !TTMList methodsFor: 'code generation'!
  21302. makeNegationsOld
  21303.     "Create negen() predicates for all of the 
  21304.     
  21305.     transitions in the ttm, selection."
  21306.  
  21307.     | table common current samplename sampleguard supplement count trCount currentTr |
  21308.     table := OrderedCollection new.
  21309.     common := 'negen(' , selection named , ', '.
  21310.     trCount := 1.
  21311.     [trCount > editedtrlist size]
  21312.         whileFalse: 
  21313.             [currentTr := editedtrlist at: trCount.
  21314.             samplename := currentTr at: 1.
  21315.             sampleguard := currentTr at: 2.
  21316.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  21317.             sampleguard = 'nil'
  21318.                 ifTrue: [table add: current , '. ']
  21319.                 ifFalse: 
  21320.                     [current := current , ' {'.
  21321.                     supplement := self makeNegation: sampleguard.
  21322.                     count := 1.
  21323.                     [count > supplement size]
  21324.                         whileFalse: 
  21325.                             [table add: current , (supplement at: count) , '}. '.
  21326.                             count := count + 1]].
  21327.             trCount := trCount + 1].
  21328.     ^table! !
  21329.  
  21330. !TTMList methodsFor: 'code generation'!
  21331. makeSF: anSF with: anSFNumber for: prologType 
  21332.     | table supplement count preamble |
  21333.     table := OrderedCollection new.
  21334.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  21335.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  21336.             ifFalse: 
  21337.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  21338.                 prologType = #quintus
  21339.                     ifTrue: 
  21340.                         [preamble := preamble , ' :-'.
  21341.                         table add: preamble]
  21342.                     ifFalse: [preamble := preamble , ' {'].
  21343.                 supplement := self makeGuard: anSF copy for: prologType.
  21344.                 count := 1.
  21345.                 [count > supplement size]
  21346.                     whileFalse: 
  21347.                         [prologType = #quintus
  21348.                             ifTrue: [table add: (supplement at: count)]
  21349.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  21350.                         count := count + 1]]].
  21351.     ^table! !
  21352.  
  21353. !TTMList methodsFor: 'code generation'!
  21354. makeSFDebug: anSF with: anSFNumber for: prologType 
  21355.     | table supplement count preamble temp|
  21356.     table := OrderedCollection new.
  21357.     temp := OrderedCollection new.
  21358.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  21359.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  21360.             ifFalse: 
  21361.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  21362.                 prologType = #quintus
  21363.                     ifTrue: 
  21364.                         [preamble := preamble , ' :-'.
  21365.                         table add: preamble]
  21366.                     ifFalse: [preamble := preamble , ' {'].
  21367.                 supplement := self makeGuard: anSF copy for: prologType.
  21368.                 temp add: supplement.
  21369.                 count := 1.
  21370.                 [count > supplement size]
  21371.                     whileFalse: 
  21372.                         [prologType = #quintus
  21373.                             ifTrue: [table add: (supplement at: count)]
  21374.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  21375.                         count := count + 1]]].
  21376.     supplement inspect.
  21377.     ^table! !
  21378.  
  21379. !TTMList methodsFor: 'code generation'!
  21380. makeSFNegations: anSF with: anSFNumber 
  21381.     "Create negsf predicates for the selected TTM"
  21382.  
  21383.     | table current supplement |
  21384.     table := OrderedCollection new.
  21385.     current := 'negsf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  21386.     anSF = 'nil'
  21387.         ifTrue: [table add: current , '. ']
  21388.         ifFalse: 
  21389.             [current := current , ' {'.
  21390.             supplement := self makeNegation: anSF copy.
  21391.             supplement do: [:x | table add: current , x , '}. ']].
  21392.     ^table! !
  21393.  
  21394. !TTMList methodsFor: 'code generation'!
  21395. makeSFNew: anSF with: anSFNumber for: prologType 
  21396.     | table supplement count preamble |
  21397.     table := OrderedCollection new.
  21398.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  21399.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  21400.             ifFalse: 
  21401.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  21402.                 prologType = #quintus
  21403.                     ifTrue: 
  21404.                         [preamble := preamble , ' :-'.
  21405.                         table add: preamble]
  21406.                     ifFalse: [preamble := preamble , ' {'].
  21407.                 supplement := self makeGuard: anSF copy for: prologType.
  21408.                 count := 1.
  21409.                 [count > supplement size]
  21410.                     whileFalse: 
  21411.                         [prologType = #quintus
  21412.                             ifTrue: [table add: (supplement at: count)]
  21413.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  21414.                         count := count + 1]]].
  21415.     ^table! !
  21416.  
  21417. !TTMList methodsFor: 'code generation'!
  21418. makeTypeForAV: anActivityVariable 
  21419.     | set aString count total |
  21420.     set := selection typeForAV: anActivityVariable.
  21421.     total := set size.
  21422.     aString := ''.
  21423.     enumerateActivities > 0
  21424.         ifTrue: 
  21425.             [aString := (anActivityVariable at: 1) asString , ' >= 1, ' , (anActivityVariable at: 1) asString.
  21426.             aString := aString , ' =< ' , total printString]
  21427.         ifFalse: 
  21428.             [count := 1.
  21429.             [count > set size]
  21430.                 whileFalse: 
  21431.                     [aString := aString , (anActivityVariable at: 1) asString , '=' , (set at: count) myName asString.
  21432.                     count = set size ifFalse: [aString := aString , '; '].
  21433.                     count := count + 1]].
  21434.     ^aString! !
  21435.  
  21436. !TTMList methodsFor: 'code generation'!
  21437. makeTypesFor: prologType 
  21438.     | table current count leftmargin v inset |
  21439.     table := OrderedCollection new.
  21440.     leftmargin := '        '.
  21441.     count := 1.
  21442.     [count > variableSet size]
  21443.         whileFalse: 
  21444.             [v := variableSet at: count.
  21445.             current := self variableTypeFor: v noName: #false.
  21446.             prologType = #quintus
  21447.                 ifTrue: [current := current , ' :- ']
  21448.                 ifFalse: [current := current , ' {'].
  21449.             table add: current.
  21450.             current := leftmargin.
  21451.             (selection anExistingDV: (v at: 1))
  21452.                 ifTrue: 
  21453.                     [(v at: 2)
  21454.                         = '-infinity' ifFalse: [current := current , (v at: 1) , ' >= ' , (v at: 2)].
  21455.                     (v at: 3)
  21456.                         = 'infinity'
  21457.                         ifFalse: 
  21458.                             [(v at: 2)
  21459.                                 ~= '-infinity'
  21460.                                 ifTrue: 
  21461.                                     [current := current , ','.
  21462.                                     table add: current].
  21463.                             current := leftmargin , (v at: 1) , ' =< ' , (v at: 3).
  21464.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  21465.                             current := current , '.'.
  21466.                             table add: current]
  21467.                         ifTrue: 
  21468.                             [(v at: 2)
  21469.                                 = '-infinity' ifTrue: [current := leftmargin , (v at: 1) , ' >= 0; ' , (v at: 1) , ' < 0'].
  21470.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  21471.                             current := current , '. '.
  21472.                             table add: current]]
  21473.                 ifFalse: 
  21474.                     [inset := self makeTypeForAV: v.
  21475.                     prologType = #quintus
  21476.                         ifTrue: [current := current , '(' , inset , '). ']
  21477.                         ifFalse: [current := current , inset , '}. '].
  21478.                     table add: current].
  21479.             count := count + 1].
  21480.     ^table! !
  21481.  
  21482. !TTMList methodsFor: 'code generation'!
  21483. oldmakeInitialConditionFor: prologType 
  21484.     | table supplement count preamble |
  21485.     table := OrderedCollection new.
  21486.     variableSet size > 0 ifTrue: [selection initialcondition asString = 'nil'
  21487.             ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  21488.             ifFalse: 
  21489.                 [preamble := 'initialcondition(' , selection named , ', ' , self variablesUppercase , ')'.
  21490.                 prologType = #quintus
  21491.                     ifTrue: 
  21492.                         [preamble := preamble , ' :-'.
  21493.                         table add: preamble]
  21494.                     ifFalse: [preamble := preamble , ' {'].
  21495.                 supplement := self makeGuard: selection initialcondition for: prologType.
  21496.                 count := 1.
  21497.                 [count > supplement size]
  21498.                     whileFalse: 
  21499.                         [prologType = #quintus
  21500.                             ifTrue: [table add: (supplement at: count)]
  21501.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  21502.                         count := count + 1]]].
  21503.     ^table! !
  21504.  
  21505. !TTMList methodsFor: 'code generation'!
  21506. separateLinesP3: aString 
  21507.     "Given a string, divide it into lines 
  21508.     
  21509.     separated at commas."
  21510.  
  21511.     | lines aLine newString left position c segment |
  21512.     (aString at: aString size)
  21513.         = $, | ((aString at: aString size)
  21514.             = $;)
  21515.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  21516.         ifFalse: [newString := aString].
  21517.     lines := OrderedCollection new.
  21518.     left := 1.
  21519.     position := 1.
  21520.     aLine := ''.
  21521.     [position > aString size]
  21522.         whileFalse: 
  21523.             [c := newString at: position.
  21524.             c = $;
  21525.                 ifTrue: 
  21526.                     [segment := newString copyFrom: left to: position - 1.
  21527.                     aLine := aLine , segment.
  21528.                     left := position + 1.
  21529.                     lines add: aLine.
  21530.                     aLine := ''].
  21531.             position := position + 1].
  21532.     segment := newString copyFrom: left to: position - 1.
  21533.     aLine := aLine , segment.
  21534.     lines add: aLine.
  21535.     ^lines! !
  21536.  
  21537. !TTMList methodsFor: 'code generation'!
  21538. separateLinesQuintus: aString 
  21539.     "Given a string, divide it into lines 
  21540.     
  21541.     separated at commas and semi-colons. 
  21542.     
  21543.     End it with a period."
  21544.  
  21545.     | lines aLine leftMargin newString left position c segment |
  21546.     (aString at: aString size)
  21547.         = $, | ((aString at: aString size)
  21548.             = $;)
  21549.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  21550.         ifFalse: [newString := aString].
  21551.     leftMargin := '        '.
  21552.     lines := OrderedCollection new.
  21553.     left := 1.
  21554.     position := 1.
  21555.     aLine := leftMargin , ''.
  21556.     [position > aString size]
  21557.         whileFalse: 
  21558.             [c := newString at: position.
  21559.             c = $, | (c = $;)
  21560.                 ifTrue: 
  21561.                     [segment := newString copyFrom: left to: position.
  21562.                     aLine := aLine , segment.
  21563.                     left := position + 1.
  21564.                     lines add: (TTMList
  21565.                             inString: aLine
  21566.                             replace: '#'
  21567.                             with: ' \= ').
  21568.                     aLine := leftMargin , ''].
  21569.             c = $) ifTrue: [leftMargin := leftMargin copyFrom: 1 to: leftMargin size - 1].
  21570.             c = $( ifTrue: [leftMargin := leftMargin , ' '].
  21571.             position := position + 1].
  21572.     segment := newString copyFrom: left to: position - 1.
  21573.     aLine := aLine , segment , '.'.
  21574.     lines add: (TTMList
  21575.             inString: aLine
  21576.             replace: '#'
  21577.             with: ' \= ').
  21578.     ^lines! !
  21579.  
  21580. !TTMList methodsFor: 'code generation'!
  21581. variablesInitialize
  21582.     | count existingDV |
  21583.     variableSet := selection activityvariable collect: [:existingAV | existingAV].
  21584.     count := 1.
  21585.     selection datavariable size
  21586.         timesRepeat: 
  21587.             [existingDV := selection datavariable at: count.
  21588.             count := count + 1.
  21589.             variableSet add: existingDV]! !
  21590.  
  21591. !TTMList methodsFor: 'code generation'!
  21592. variablesLowercase
  21593.     | current count |
  21594.     variableSet size > 0
  21595.         ifTrue: 
  21596.             [current := '['.
  21597.             count := 1.
  21598.             [count >= variableSet size]
  21599.                 whileFalse: 
  21600.                     [current := current , ((variableSet at: count)
  21601.                                     at: 1) asText asLowercase asString , ','.
  21602.                     count := count + 1].
  21603.             current := current , ((variableSet at: count)
  21604.                             at: 1) asText asLowercase asString , ']'.
  21605.             ^current]
  21606.         ifFalse: [^nil]! !
  21607.  
  21608. !TTMList methodsFor: 'code generation'!
  21609. variablesUppercase
  21610.     | current count |
  21611.     variableSet size > 0
  21612.         ifTrue: 
  21613.             [current := '['.
  21614.             count := 1.
  21615.             [count >= variableSet size]
  21616.                 whileFalse: 
  21617.                     [current := current , ((variableSet at: count)
  21618.                                     at: 1) asString , ','.
  21619.                     count := count + 1].
  21620.             current := current , ((variableSet at: count)
  21621.                             at: 1) asString , ']'.
  21622.             ^current]
  21623.         ifFalse: [^nil]! !
  21624.  
  21625. !TTMList methodsFor: 'code generation'!
  21626. variableTypeFor: variable noName: aBoolean 
  21627.     aBoolean = #true
  21628.         ifTrue: [^'type(' , (variable at: 1) asText asLowercase asString , ', ' , (variable at: 1) asString , ')']
  21629.         ifFalse: [^'type(' , selection named , ', ' , (variable at: 1) asText asLowercase asString , ', ' , (variable at: 1) asString , ')']! !
  21630.  
  21631. !TTMList methodsFor: 'button access'!
  21632. doAdd
  21633.     "Prompt the user for a TTM name and activity variable."
  21634.  
  21635.     | choice activityvariable newTTM existingNames avDefault |
  21636.     choice := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New TTM name?'.
  21637.     choice isEmpty
  21638.         ifTrue: [^self]
  21639.         ifFalse: [(TTMList aUsefulTTMName: choice)
  21640.                 ifFalse: 
  21641.                     [TTMList speak: 'illegal TTM name - add aborted'.
  21642.                     ^self]
  21643.                 ifTrue: 
  21644.                     [existingNames := models collect: [:existingTTM | existingTTM named].
  21645.                     (existingNames includes: choice)
  21646.                         ifTrue: 
  21647.                             [TTMList speak: 'TTM name already used - add aborted.'.
  21648.                             ^self].
  21649.                     avDefault := 'X_' , choice.
  21650.                     activityvariable := DialogView
  21651.                                 request: '(First letter must be upper case)' , (String with: Character cr) , 'Activity Variable of TTM?'
  21652.                                 initialAnswer: avDefault
  21653.                                 onCancel: [^nil].
  21654.                     activityvariable isEmpty
  21655.                         ifTrue: 
  21656.                             [TTMList speak: 'activity variable not given - add aborted.'.
  21657.                             ^self]
  21658.                         ifFalse: [(TTMList aUsefulTTMName: activityvariable)
  21659.                                 & (activityvariable at: 1) isUppercase
  21660.                                 ifTrue: 
  21661.                                     [newTTM := TTM create: choice with: activityvariable.
  21662.                                     models add: newTTM.
  21663.                                     newTTM openWindows: (Array
  21664.                                             with: 0
  21665.                                             with: 0
  21666.                                             with: 0
  21667.                                             with: 0).
  21668.                                     self changed: #transaction]
  21669.                                 ifFalse: 
  21670.                                     [TTMList speak: 'illegal Activity Variable name - add aborted.'.
  21671.                                     ^self]]]]! !
  21672.  
  21673. !TTMList methodsFor: 'button access'!
  21674. doConditions
  21675.     selection isNil
  21676.         ifFalse: 
  21677.             [(selection openWindows at: 1)
  21678.                 = 1
  21679.                 ifTrue: 
  21680.                     [TTMList speak: 'window is already open.'.
  21681.                     ^nil]
  21682.                 ifFalse: [selection openWindows at: 1 put: 1].
  21683.             ConditionsWindow open: selection]! !
  21684.  
  21685. !TTMList methodsFor: 'button access'!
  21686. doCopy
  21687.     "Prompt the user for name of new TTM."
  21688.  
  21689.     | newname oldname newTTM |
  21690.     selection == nil
  21691.         ifFalse: 
  21692.             [oldname := selection named , '2'.
  21693.             newname := DialogView
  21694.                         request: 'Name for copy of TTM?'
  21695.                         initialAnswer: oldname
  21696.                         onCancel: [^nil].
  21697.             newname isEmpty
  21698.                 ifTrue: [^self]
  21699.                 ifFalse: 
  21700.                     [newTTM := selection aCopy.
  21701.                     newTTM named: newname.
  21702.                     newTTM activitytree getRoot myName: newname.
  21703.                     models add: newTTM.
  21704.                     newTTM openWindows: (Array
  21705.                             with: 0
  21706.                             with: 0
  21707.                             with: 0
  21708.                             with: 0).
  21709.                     self changed: #transaction]]! !
  21710.  
  21711. !TTMList methodsFor: 'button access'!
  21712. doEdit
  21713.     "Edit the selected TTM. We pass it the entire list 
  21714.     
  21715.     because we need to allow TTM insertion."
  21716.  
  21717.     selection == nil
  21718.         ifFalse: 
  21719.             [(selection openWindows at: 2)
  21720.                 = 1
  21721.                 ifTrue: []
  21722.                 ifFalse: [selection openWindows at: 2 put: 1].
  21723.             EditingWindow open: selection from: self]! !
  21724.  
  21725. !TTMList methodsFor: 'button access'!
  21726. doFileAccess
  21727.  
  21728.      FileList openOnPattern: '*' for: self! !
  21729.  
  21730. !TTMList methodsFor: 'button access'!
  21731. doFileAccess1
  21732.     | window container myWrapper left hsize top vsize qButton sButton dirListView ldButton |
  21733.     currentDir := Filename currentDirectory.
  21734.     dirContents := currentDir directoryContents.
  21735.     window := ScheduledWindow new.
  21736.     window label: 'File Access'.
  21737.     window minimumSize: 200 @ 200.
  21738.     window insideColor: ColorValue white.
  21739.     container := CompositePart new.
  21740.     dirListView := SelectionInListView
  21741.                 on: self
  21742.                 printItems: false
  21743.                 oneItem: false
  21744.                 aspect: #fileTransaction
  21745.                 change: #fileSelection:
  21746.                 list: #fileList
  21747.                 menu: nil
  21748.                 initialSelection: nil
  21749.                 useIndex: true.
  21750.     myWrapper := TTMList wrap: (LookPreferences edgeDecorator on: dirListView).
  21751.     container add: myWrapper borderedIn: (0.02 @ 0.06 extent: 0.96 @ 0.8).
  21752.     left := 0.02.
  21753.     hsize := 0.3.
  21754.     top := 0.9.
  21755.     vsize := 0.09.
  21756.     sButton := PushButton named: 'Save'.
  21757.     sButton model: ((PluggableAdaptor on: self)
  21758.             getBlock: [:model | false]
  21759.             putBlock: [:model :value | model fileSave]
  21760.             updateBlock: [:model :value :parameter | false]).
  21761.     (container add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  21762.         insideColor: ColorValue white.
  21763.     left := left + 0.3.
  21764.     ldButton := PushButton named: 'Load'.
  21765.     ldButton model: ((PluggableAdaptor on: self)
  21766.             getBlock: [:model | false]
  21767.             putBlock: [:model :value | model fileLoad]
  21768.             updateBlock: [:model :value :parameter | false]).
  21769.     (container add: ldButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  21770.         insideColor: ColorValue white.
  21771.     left := left + 0.3.
  21772.     qButton := PushButton named: 'Exit'.
  21773.     qButton model: ((PluggableAdaptor on: self)
  21774.             getBlock: [:model | false]
  21775.             putBlock: [:model :value | ScheduledControllers activeController close]
  21776.             updateBlock: [:model :value :parameter | false]).
  21777.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  21778.         insideColor: ColorValue white.
  21779.     window component: container.
  21780.     window open! !
  21781.  
  21782. !TTMList methodsFor: 'button access'!
  21783. doFileAccessNew
  21784.     FileList openOnPattern: '*.mdl' for: self! !
  21785.  
  21786. !TTMList methodsFor: 'button access'!
  21787. doGenerate
  21788.     "Generate Code."
  21789.  
  21790.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize |
  21791.     selection == nil
  21792.         ifFalse: 
  21793.             [enumerateActivities := 0.
  21794.             labels := OrderedCollection new.
  21795.             labels add: 'TTM code'; add: 'State Formula code'; add: ' in Quintus Prolog'; add: ' in Prolog III'; add: ' with enumeration'.
  21796.             prompt := 'Code Generation'.
  21797.             window := ScheduledWindow
  21798.                         model: nil
  21799.                         label: prompt
  21800.                         minimumSize: 250 @ 200.
  21801.             window maximumSize: 250 @ 200.
  21802.             top := DialogView new.
  21803.             container := CompositePart new.
  21804.             topCorner := 0.1.
  21805.             hsize := 0.2.
  21806.             vsize := 0.15.
  21807.             okButton := PushButton named: 'accept'.
  21808.             okButton model: ((PluggableAdaptor on: self)
  21809.                     getBlock: [:model | false]
  21810.                     putBlock: [:model :value | model doRunGenerate]
  21811.                     updateBlock: [:model :value :parameter | false]).
  21812.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  21813.                 borderColor: ColorValue black;
  21814.                 borderWidth: 1.
  21815.             notokButton := PushButton named: 'cancel'.
  21816.             notokButton model: ((PluggableAdaptor on: self)
  21817.                     getBlock: [:model | false]
  21818.                     putBlock: [:model :value | ScheduledControllers activeController close]
  21819.                     updateBlock: [:model :value :parameter | false]).
  21820.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  21821.                 borderColor: ColorValue black;
  21822.                 borderWidth: 1.
  21823.             temporary := (1 to: labels size)
  21824.                         collect: [:i | ValueHolder newBoolean].
  21825.             top leftIndent: 70; rightIndent: 300; yPosition: 70;
  21826.                 addColumn: (1 to: temporary size)
  21827.                 fromX: 0
  21828.                 toX: 1
  21829.                 collect: 
  21830.                     [:i | 
  21831.                     | view |
  21832.                     view := LabeledBooleanView model: (temporary at: i).
  21833.                     view beRadioButton.
  21834.                     view controller beToggle.
  21835.                     view label: (labels at: i).
  21836.                     BorderedWrapper on: view].
  21837.             container add: top.
  21838.             bigSize := top preferredBounds extent copy.
  21839.             bigSize y: bigSize y + 20.
  21840.             window component: container.
  21841.             window openWithExtent: bigSize]! !
  21842.  
  21843. !TTMList methodsFor: 'button access'!
  21844. doQuery
  21845.     selection == nil
  21846.         ifFalse: 
  21847.             [(selection openWindows at: 3)
  21848.                 = 1
  21849.                 ifTrue: 
  21850.                     [TTMList speak: 'window is already open.'.
  21851.                     ^nil]
  21852.                 ifFalse: [selection openWindows at: 3 put: 1].
  21853.             QueryWindow openTable: selection]! !
  21854.  
  21855. !TTMList methodsFor: 'button access'!
  21856. doRemove
  21857.     "Prompt the user for name of TTM to be removed."
  21858.  
  21859.     | location ans1 |
  21860.     selection == nil
  21861.         ifFalse: 
  21862.             [ans1 := DialogView confirm: 'Are you certain you wish to remove TTM?'.
  21863.             ans1 = true
  21864.                 ifTrue: 
  21865.                     [location := models indexOf: selection.
  21866.                     models removeAtIndex: location.
  21867.                     self changed: #transaction]]! !
  21868.  
  21869. !TTMList methodsFor: 'button access'!
  21870. doRename
  21871.     "Prompt the user for name of TTM to be renamed."
  21872.  
  21873.     | newname oldname |
  21874.     selection == nil
  21875.         ifFalse: 
  21876.             [oldname := selection named.
  21877.             newname := DialogView
  21878.                         request: 'New name for TTM?'
  21879.                         initialAnswer: oldname
  21880.                         onCancel: [^nil].
  21881.             newname isEmpty
  21882.                 ifTrue: [^self]
  21883.                 ifFalse: 
  21884.                     [selection named: newname.
  21885.                     selection activitytree getRoot myName: newname.
  21886.                     self changed: #transaction]]! !
  21887.  
  21888. !TTMList methodsFor: 'button access'!
  21889. doSimulate
  21890.     selection == nil
  21891.         ifFalse: 
  21892.             [(selection openWindows at: 4)
  21893.                 = 1
  21894.                 ifTrue: 
  21895.                     [TTMList speak: 'window is already open.'.
  21896.                     ^nil]
  21897.                 ifFalse: [selection openWindows at: 4 put: 1].
  21898.             SimulateWindow open: selection]! !
  21899.  
  21900. !TTMList methodsFor: 'list access'!
  21901. realTTMList
  21902.  
  21903.      ^models! !
  21904.  
  21905. !TTMList methodsFor: 'list access'!
  21906. selection: index 
  21907.     "If the selection has been changed, remember the new 
  21908.     
  21909.     selection."
  21910.  
  21911.     | newSel |
  21912.     newSel := index = 0
  21913.                 ifTrue: [nil]
  21914.                 ifFalse: [models at: index].
  21915.     selection == newSel ifTrue: [^self].
  21916.     selection := newSel.
  21917.     self changed: #noteList.
  21918.     self changed: #dvTransaction.
  21919.     self changed: #avTransaction.
  21920.     self changed: #chTransaction.
  21921.     self changed: #sfTransaction! !
  21922.  
  21923. !TTMList methodsFor: 'list access'!
  21924. ttmList
  21925.  
  21926.      ^models collect: [:existingTTM | (existingTTM named)  ]! !
  21927.  
  21928. !TTMList methodsFor: 'list access'!
  21929. ttmListMenu
  21930.     | labelValues menuValues |
  21931.     selection == nil
  21932.         ifTrue: 
  21933.             [menuValues := #(#doAdd #doFileAccess ).
  21934.             labelValues := #(#(#add ) #(#'file access' ) )]
  21935.         ifFalse: 
  21936.             [menuValues := #(#doAdd #doRemove #doRename #doCopy #doEdit #doConditions #doQuery #doSimulate #doGenerate #doFileAccess ).
  21937.             labelValues := #(#(#add #remove #rename ) #(#copy #edit #'specify IC' ) #(#query #simulate #'generate code' ) #(#'file
  21938.  
  21939. access' ) )].
  21940.     ^PopUpMenu labelList: labelValues values: menuValues! !
  21941.  
  21942. !TTMList methodsFor: 'variable access'!
  21943. avList
  21944.  
  21945.     selection == nil ifTrue: [^nil].
  21946.  
  21947.     ^selection activityvariable collect: [:existingAV | existingAV at: 1]! !
  21948.  
  21949. !TTMList methodsFor: 'variable access'!
  21950. avMenu
  21951.  
  21952.      avSelection == nil ifTrue: [^nil].
  21953.  
  21954.      ^PopUpMenu
  21955.  
  21956.                labelList: #((rename))
  21957.  
  21958.                values: #(avRename)! !
  21959.  
  21960. !TTMList methodsFor: 'variable access'!
  21961. avRename
  21962.     | newname oldname oldAV newAV |
  21963.     avSelection == nil
  21964.         ifFalse: 
  21965.             [oldname := avSelection at: 1.
  21966.             newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New name for activity variable?' initialAnswer: oldname.
  21967.             newname isEmpty
  21968.                 ifTrue: [^self]
  21969.                 ifFalse: [(selection aValidVariableName: newname)
  21970.                         ifFalse: 
  21971.                             [TTMList speak: 'illegal variable name.'.
  21972.                             ^self]
  21973.                         ifTrue: 
  21974.                             [oldAV := avSelection copy.
  21975.                             avSelection at: 1 put: newname.
  21976.                             newAV := avSelection copy.
  21977.                             self changed: #avTransaction.
  21978.                             selection renameVariable: oldname asString to: newname asString.
  21979.                             selection
  21980.                                 changeAllAVsAt: selection activitytree getRoot
  21981.                                 from: oldAV
  21982.                                 to: newAV.
  21983.                             selection renameActivityVariable: (oldAV at: 1)
  21984.                                 to: (newAV at: 1).
  21985.                             self changed: #curSFList]]]! !
  21986.  
  21987. !TTMList methodsFor: 'variable access'!
  21988. avSelection: index 
  21989.     "If the selection has been changed, remember the new 
  21990.     
  21991.     selection."
  21992.  
  21993.     | newSel |
  21994.     selection == nil
  21995.         ifFalse: 
  21996.             [newSel := index = 0
  21997.                         ifTrue: [nil]
  21998.                         ifFalse: [selection activityvariable at: index].
  21999.             avSelection == newSel ifTrue: [^self].
  22000.             avSelection := newSel]! !
  22001.  
  22002. !TTMList methodsFor: 'variable access'!
  22003. currentDirectory
  22004.     ^currentDirectory! !
  22005.  
  22006. !TTMList methodsFor: 'variable access'!
  22007. currentDirectory: aDirectory 
  22008.     currentDirectory := aDirectory! !
  22009.  
  22010. !TTMList methodsFor: 'variable access'!
  22011. dvAdd
  22012.     "Add an data variable."
  22013.  
  22014.     | newname |
  22015.     newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New data variable name?'.
  22016.     newname isEmpty
  22017.         ifTrue: [^self]
  22018.         ifFalse: [(selection aValidVariableName: newname)
  22019.                 ifFalse: [TTMList speak: 'illegal data variable name']
  22020.                 ifTrue: [(selection anExistingAV: newname)
  22021.                         = true | ((selection anExistingDV: newname)
  22022.                             = true)
  22023.                         ifTrue: [TTMList speak: newname , ' : variable name already in use']
  22024.                         ifFalse: 
  22025.                             [selection
  22026.                                 datavariable: newname
  22027.                                 lrange: '0'
  22028.                                 hrange: 'infinity'
  22029.                                 initial: '0'.
  22030.                             selection updateSpecificIC.
  22031.                             self changed: #dvTransaction]]]! !
  22032.  
  22033. !TTMList methodsFor: 'variable access'!
  22034. dvChangeHigh
  22035.  
  22036.     "Change upper bound of a data variable."
  22037.  
  22038.  
  22039.  
  22040.     | high oldHigh initialAsNumber highAsNumber lowAsNumber |
  22041.  
  22042.     dvSelection == nil
  22043.  
  22044.         ifFalse: 
  22045.  
  22046.             [oldHigh := dvSelection at: 3.
  22047.  
  22048.             high := DialogView request: 'New upper limit for data variable?' initialAnswer: oldHigh.
  22049.  
  22050.             high isEmpty ifTrue: [^self].
  22051.  
  22052.             (TTMList aValidNumber: high)
  22053.  
  22054.                 & (high ~= '-infinity')
  22055.  
  22056.                 ifFalse: 
  22057.  
  22058.                     [TTMList speak: 'invalid upper bound.'.
  22059.  
  22060.                     ^nil].
  22061.  
  22062.             highAsNumber := TTMList convertToNumber: high.
  22063.  
  22064.             (dvSelection at: 2)
  22065.  
  22066.                 ~= '-infinity'
  22067.  
  22068.                 ifTrue: 
  22069.  
  22070.                     [lowAsNumber := TTMList convertToNumber: (dvSelection at: 2).
  22071.  
  22072.                     highAsNumber > lowAsNumber
  22073.  
  22074.                         ifFalse: 
  22075.  
  22076.                             [TTMList speak: 'invalid upper bound.'.
  22077.  
  22078.                             ^nil]].
  22079.  
  22080.             dvSelection at: 3 put: high.
  22081.  
  22082.             high = 'infinity' ifFalse: [(dvSelection at: 4)
  22083.  
  22084.                     = 'infinity'
  22085.  
  22086.                     ifFalse: 
  22087.  
  22088.                         [initialAsNumber := TTMList convertToNumber: (dvSelection at: 4).
  22089.  
  22090.                         initialAsNumber > highAsNumber ifTrue: [dvSelection at: 4 put: (dvSelection at: 2)]]].
  22091.  
  22092.             self changed: #dvTransaction]! !
  22093.  
  22094. !TTMList methodsFor: 'variable access'!
  22095. dvChangeLow
  22096.  
  22097.     "Change lower bound of a data variable."
  22098.  
  22099.  
  22100.  
  22101.     | low oldLow initialAsNumber lowAsNumber highAsNumber |
  22102.  
  22103.     dvSelection == nil
  22104.  
  22105.         ifFalse: 
  22106.  
  22107.             [oldLow := dvSelection at: 2.
  22108.  
  22109.             low := DialogView request: 'New lower limit for data variable?' initialAnswer: oldLow.
  22110.  
  22111.             low isEmpty ifTrue: [^self].
  22112.  
  22113.             (TTMList aValidNumber: low)
  22114.  
  22115.                 & (low ~= 'infinity')
  22116.  
  22117.                 ifFalse: 
  22118.  
  22119.                     [TTMList speak: 'invalid lower bound.'.
  22120.  
  22121.                     ^nil].
  22122.  
  22123.             lowAsNumber := TTMList convertToNumber: low.
  22124.  
  22125.             (dvSelection at: 3)
  22126.  
  22127.                 ~= 'infinity'
  22128.  
  22129.                 ifTrue: 
  22130.  
  22131.                     [highAsNumber := TTMList convertToNumber: (dvSelection at: 3).
  22132.  
  22133.                     lowAsNumber < highAsNumber
  22134.  
  22135.                         ifFalse: 
  22136.  
  22137.                             [TTMList speak: 'invalid lower bound'.
  22138.  
  22139.                             ^nil]].
  22140.  
  22141.             dvSelection at: 2 put: low.
  22142.  
  22143.             (dvSelection at: 4)
  22144.  
  22145.                 = 'infinity'
  22146.  
  22147.                 ifTrue: 
  22148.  
  22149.                     [dvSelection at: 4 put: low.
  22150.  
  22151.                     self changed: #icTransaction]
  22152.  
  22153.                 ifFalse: 
  22154.  
  22155.                     [initialAsNumber := TTMList convertToNumber: (dvSelection at: 4).
  22156.  
  22157.                     initialAsNumber < lowAsNumber ifTrue: [dvSelection at: 4 put: low]].
  22158.  
  22159.             self changed: #dvTransaction]! !
  22160.  
  22161. !TTMList methodsFor: 'variable access'!
  22162. dvList
  22163.  
  22164.     | low high |
  22165.  
  22166.     selection == nil
  22167.  
  22168.         ifTrue: [^nil]
  22169.  
  22170.         ifFalse: 
  22171.  
  22172.             [low := '  low: '.
  22173.  
  22174.             high := '  high: '.
  22175.  
  22176.             ^selection datavariable collect: [:existingDV | (existingDV at: 1)
  22177.  
  22178.                     , low , (existingDV at: 2) , high , (existingDV at: 3)]]! !
  22179.  
  22180. !TTMList methodsFor: 'variable access'!
  22181. dvMenu
  22182.  
  22183.     selection == nil ifTrue: [^nil].
  22184.  
  22185.     dvSelection == nil
  22186.  
  22187.         ifTrue: [^PopUpMenu labelList: #(#(#add ) ) values: #(#dvAdd )]
  22188.  
  22189.         ifFalse: [^PopUpMenu labelList: #(#(#add #remove #rename 'new lower limit' 'new upper limit' ) ) values: #(#dvAdd #dvRemove #dvRename #dvChangeLow #dvChangeHigh )]! !
  22190.  
  22191. !TTMList methodsFor: 'variable access'!
  22192. dvRemove
  22193.  
  22194.     "Remove a data variable."
  22195.  
  22196.  
  22197.  
  22198.     | location |
  22199.  
  22200.     dvSelection == nil ifFalse: [(selection variableIsBeingUsed: (dvSelection at: 1))
  22201.  
  22202.             ifTrue: [TTMList speak: 'Cannot delete - data variable is used within TTM.']
  22203.  
  22204.             ifFalse: 
  22205.  
  22206.                 [location := selection datavariable indexOf: dvSelection.
  22207.  
  22208.                 selection datavariable removeAtIndex: location.
  22209.  
  22210.                 selection updateSpecificIC.
  22211.  
  22212.                 self changed: #dvTransaction]]! !
  22213.  
  22214. !TTMList methodsFor: 'variable access'!
  22215. dvRename
  22216.     "Rename a data variable."
  22217.  
  22218.     | newname oldname |
  22219.     dvSelection == nil
  22220.         ifFalse: 
  22221.             [oldname := dvSelection at: 1.
  22222.             newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New name for data variable?' initialAnswer: oldname.
  22223.             newname isEmpty
  22224.                 ifTrue: [^self]
  22225.                 ifFalse: [(selection aValidVariableName: newname)
  22226.                         ifFalse: 
  22227.                             [TTMList speak: 'illegal variable name.'.
  22228.                             ^self]
  22229.                         ifTrue: 
  22230.                             [dvSelection at: 1 put: newname.
  22231.                             self changed: #dvTransaction.
  22232.                             selection renameVariable: oldname asString to: newname asString.
  22233.                             self changed: #curSFList]]]! !
  22234.  
  22235. !TTMList methodsFor: 'variable access'!
  22236. dvSelection: index 
  22237.  
  22238.      "If the selection has been changed, remember the new
  22239.  
  22240. selection."
  22241.  
  22242.  
  22243.  
  22244.      | newSel |
  22245.  
  22246.      newSel := index = 0
  22247.  
  22248.                     ifTrue: [nil]
  22249.  
  22250.                     ifFalse: [selection datavariable at: index].
  22251.  
  22252.      dvSelection == newSel ifTrue: [^self].
  22253.  
  22254.      dvSelection := newSel.! !
  22255.  
  22256. !TTMList methodsFor: 'variable access'!
  22257. fileSelection: aFileName 
  22258.  
  22259.      fileSelection := aFileName! !
  22260.  
  22261. !TTMList methodsFor: 'variable access'!
  22262. tempStack
  22263.  
  22264.      ^tempStack! !
  22265.  
  22266. !TTMList methodsFor: 'variable access'!
  22267. tempStack: anyThing 
  22268.  
  22269.      tempStack := anyThing! !
  22270.  
  22271. !TTMList methodsFor: 'note pad access'!
  22272. noteAccept: candidate 
  22273.  
  22274.      selection note: candidate asString.
  22275.  
  22276.      ^true! !
  22277.  
  22278. !TTMList methodsFor: 'note pad access'!
  22279. noteList
  22280.  
  22281.      selection == nil
  22282.  
  22283.           ifTrue: [^nil]
  22284.  
  22285.           ifFalse: [^selection note]! !
  22286.  
  22287. !TTMList methodsFor: 'note pad access'!
  22288. noteMenu
  22289.  
  22290.     selection ~~ nil ifFalse: [^nil]
  22291.  
  22292.         ifTrue: [^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #accept #cancel )]! !
  22293.  
  22294. !TTMList methodsFor: 'channel access'!
  22295. chAdd
  22296.     "Add a communication channel."
  22297.  
  22298.     | newname |
  22299.     newname := DialogView request: 'New communication channel name?'.
  22300.     newname isEmpty
  22301.         ifTrue: [^self]
  22302.         ifFalse: [(selection aValidVariableName: newname)
  22303.                 ifTrue: 
  22304.                     [selection commchannel: newname.
  22305.                     self changed: #chTransaction]]! !
  22306.  
  22307. !TTMList methodsFor: 'channel access'!
  22308. chList
  22309.     selection == nil
  22310.         ifTrue: [^nil]
  22311.         ifFalse: [^selection commchannel collect: [:existingCH | existingCH at: 1]]! !
  22312.  
  22313. !TTMList methodsFor: 'channel access'!
  22314. chMenu
  22315.     selection == nil ifTrue: [^nil].
  22316.     chSelection == nil
  22317.         ifTrue: [^PopUpMenu labelList: #(#(#add ) ) values: #(#chAdd )]
  22318.         ifFalse: [^PopUpMenu labelList: #(#(#add #remove #rename ) ) values: #(#chAdd #chRemove #chRename )]! !
  22319.  
  22320. !TTMList methodsFor: 'channel access'!
  22321. chRemove
  22322.     "Remove a communication channel."
  22323.  
  22324.     | location |
  22325.     chSelection == nil ifFalse: [(selection variableIsBeingUsed: (chSelection at: 1))
  22326.             ifTrue: [TTMList speak: 'Cannot delete - comm. channel is used within TTM.']
  22327.             ifFalse: 
  22328.                 [location := selection commchannel indexOf: chSelection.
  22329.                 selection commchannel removeAtIndex: location.
  22330.                 self changed: #chTransaction]]! !
  22331.  
  22332. !TTMList methodsFor: 'channel access'!
  22333. chRename
  22334.     "Rename a communication channel."
  22335.  
  22336.     | newname oldname |
  22337.     chSelection == nil
  22338.         ifFalse: 
  22339.             [oldname := chSelection at: 1.
  22340.             newname := DialogView request: 'New name for comm. channel?' initialAnswer: oldname.
  22341.             newname isEmpty
  22342.                 ifTrue: [^self]
  22343.                 ifFalse: [(selection aValidVariableName: newname)
  22344.                         ifFalse: [^self]
  22345.                         ifTrue: 
  22346.                             [chSelection at: 1 put: newname.
  22347.                             self changed: #chTransaction.
  22348.                             selection renameVariable: oldname asString to: newname asString]]]! !
  22349.  
  22350. !TTMList methodsFor: 'channel access'!
  22351. chSelection: index 
  22352.     "If the selection has been changed, remember the new 
  22353.     
  22354.     selection."
  22355.  
  22356.     | newSel |
  22357.     newSel := index = 0
  22358.                 ifTrue: [nil]
  22359.                 ifFalse: [selection commchannel at: index].
  22360.     chSelection == newSel ifTrue: [^self].
  22361.     chSelection := newSel! !
  22362.  
  22363. !TTMList methodsFor: 'sf access'!
  22364. curSFAccept: candidateCondition 
  22365.     | accept cCondition ast undefined |
  22366.     accept := false.
  22367.     candidateCondition isEmpty
  22368.         ifTrue: [cCondition := 'nil']
  22369.         ifFalse: [cCondition := candidateCondition].
  22370.     cCondition asString = 'nil'
  22371.         ifTrue: [accept := true]
  22372.         ifFalse: 
  22373.             [accept := true.
  22374.             ast := BuildBoolParser new parseForAST: cCondition asString
  22375.                         ifFail: 
  22376.                             [TTMList speak: cCondition asString , ' : Invalid state formula'.
  22377.                             accept := false]].
  22378.     accept = false ifFalse: [ast rhsVars do: [:x | (selection anExistingAV: x)
  22379.                 = false & ((selection anExistingDV: x)
  22380.                     = false)
  22381.                 ifTrue: 
  22382.                     [undefined isNil ifTrue: [undefined := ''].
  22383.                     undefined := undefined , '  ' , x]]].
  22384.     accept = false | undefined notNil = true
  22385.         ifTrue: [undefined notNil
  22386.                 ifTrue: 
  22387.                     [TTMList speak: (cCondition asString , ' : state formula\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  22388.                     self changed: #curSFList.
  22389.                     ^true]]
  22390.         ifFalse: 
  22391.             [sfSelection at: 2 put: cCondition asString.
  22392.             self changed: #curSFList.
  22393.             ^true]! !
  22394.  
  22395. !TTMList methodsFor: 'sf access'!
  22396. curSFAcceptNew: candidateCondition 
  22397.     | accept cCondition ast undefined |
  22398.     accept := false.
  22399.     candidateCondition isEmpty
  22400.         ifTrue: [cCondition := 'nil']
  22401.         ifFalse: [cCondition := candidateCondition].
  22402.     cCondition asString = 'nil'
  22403.         ifTrue: [accept := true]
  22404.         ifFalse: 
  22405.             [accept := true.
  22406.             ast := BuildBoolParser new parseForAST: cCondition asString
  22407.                         ifFail: 
  22408.                             [TTMList speak: cCondition asString , ' : Invalid state formula'.
  22409.                             accept := false]].
  22410.     accept = false ifFalse: [ast rhsVars do: [:x | (selection anExistingAV: x)
  22411.                 = false & (selection anExistingDV: x) = false
  22412.                 ifTrue: 
  22413.                     [undefined isNil ifTrue: [undefined := ''].
  22414.                     undefined := undefined , '  ' , x]]].
  22415.     accept = false | undefined notNil = true
  22416.         ifTrue: [undefined notNil
  22417.                 ifTrue: 
  22418.                     [TTMList speak: (cCondition asString , ' : state formula\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  22419.                     self changed: #curSFList.
  22420.                     ^true]]
  22421.         ifFalse: 
  22422.             [sfSelection at: 2 put: cCondition asString.
  22423.             self changed: #curSFList.
  22424.             ^true]! !
  22425.  
  22426. !TTMList methodsFor: 'sf access'!
  22427. curSFAcceptOld: candidateCondition 
  22428.     | accept cCondition |
  22429.     accept := false.
  22430.     candidateCondition isEmpty
  22431.         ifTrue: [cCondition := 'nil']
  22432.         ifFalse: [cCondition := candidateCondition].
  22433.     cCondition asString = 'nil'
  22434.         ifTrue: [accept := true]
  22435.         ifFalse: [(ParseTree guardSyntaxCheck: cCondition asString from: selection)
  22436.                 ifFalse: [accept := true]].
  22437.     accept = false
  22438.         ifFalse: 
  22439.             [sfSelection at: 2 put: cCondition asString.
  22440.             self changed: #curSFList.
  22441.             ^true]
  22442.         ifTrue: 
  22443.             [TTMList speak: 'revised state formula rejected.'.
  22444.             self changed: #curSFList.
  22445.             ^true]! !
  22446.  
  22447. !TTMList methodsFor: 'sf access'!
  22448. curSFList
  22449.  
  22450.      sfSelection == nil
  22451.  
  22452.           ifTrue: [^nil]
  22453.  
  22454.           ifFalse: [^sfSelection at: 2]! !
  22455.  
  22456. !TTMList methodsFor: 'sf access'!
  22457. curSFMenu
  22458.     selection == nil | (sfSelection == nil)
  22459.         ifTrue: [^nil]
  22460.         ifFalse: [^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #accept #cancel )]! !
  22461.  
  22462. !TTMList methodsFor: 'sf access'!
  22463. sfAdd
  22464.     | newname totalNumber checkIfValid count okay temp |
  22465.     totalNumber := selection stateFormulas size.
  22466.     checkIfValid := true.
  22467.     [checkIfValid = true]
  22468.         whileTrue: 
  22469.             [count := 1.
  22470.             okay := true.
  22471.             [count > selection stateFormulas size]
  22472.                 whileFalse: 
  22473.                     [((selection stateFormulas at: count)
  22474.                         at: 1)
  22475.                         = totalNumber printString
  22476.                         ifTrue: 
  22477.                             [okay := false.
  22478.                             count := selection stateFormulas size].
  22479.                     count := count + 1].
  22480.             okay = true
  22481.                 ifTrue: [checkIfValid := false]
  22482.                 ifFalse: [totalNumber := totalNumber + 1]].
  22483.     newname := DialogView request: 'New state formula name?' initialAnswer: totalNumber printString.
  22484.     newname isEmpty
  22485.         ifTrue: [^self]
  22486.         ifFalse: 
  22487.             [temp := selection stateFormulas collect: [:x | x at: 1].
  22488.             (TTMList aUsefulActLabel: newname)
  22489.                 ifTrue: [(temp includes: newname)
  22490.                         ifFalse: 
  22491.                             [selection stateFormulas: newname holding: 'nil'.
  22492.                             self changed: #sfTransaction]
  22493.                         ifTrue: [DialogView warn: 'State Formula Name Already in Use']]]! !
  22494.  
  22495. !TTMList methodsFor: 'sf access'!
  22496. sfClear
  22497.  
  22498.      selection stateFormulas: OrderedCollection new.
  22499.  
  22500.      self changed: #sfTransaction! !
  22501.  
  22502. !TTMList methodsFor: 'sf access'!
  22503. sfCopy
  22504.     | newname copiedsf |
  22505.     sfSelection == nil
  22506.         ifFalse: 
  22507.             [newname := DialogView request: 'Copied state formula number?'.
  22508.             newname isEmpty
  22509.                 ifTrue: [^self]
  22510.                 ifFalse: [(TTMList aUsefulActLabel: newname)
  22511.                         ifFalse: 
  22512.                             [TTMList speak: 'illegal sf name.'.
  22513.                             ^self]
  22514.                         ifTrue: 
  22515.                             [copiedsf := sfSelection at: 2.
  22516.                             selection stateFormulas: newname holding: copiedsf.
  22517.                             self changed: #sfTransaction]]]! !
  22518.  
  22519. !TTMList methodsFor: 'sf access'!
  22520. sfList
  22521.  
  22522.      selection == nil
  22523.  
  22524.           ifTrue: [^nil]
  22525.  
  22526.           ifFalse: [^selection stateFormulas collect:
  22527.  
  22528. [:existingSF | existingSF at: 1]]! !
  22529.  
  22530. !TTMList methodsFor: 'sf access'!
  22531. sfMenu
  22532.     selection == nil ifTrue: [^nil].
  22533.     sfSelection == nil
  22534.         ifTrue: [^PopUpMenu labelList: #(#(#add #clear ) ) values: #(#sfAdd #sfClear )]
  22535.         ifFalse: [^PopUpMenu labelList: #(#(#add #copy #clear #remove #renumber ) ) values: #(#sfAdd #sfCopy #sfClear #sfRemove #sfRenumber )]! !
  22536.  
  22537. !TTMList methodsFor: 'sf access'!
  22538. sfRemove
  22539.     | location |
  22540.     sfSelection == nil
  22541.         ifFalse: 
  22542.             [location := selection stateFormulas indexOf: sfSelection.
  22543.             selection stateFormulas removeAtIndex: location.
  22544.             self changed: #sfTransaction]! !
  22545.  
  22546. !TTMList methodsFor: 'sf access'!
  22547. sfRenumber
  22548.  
  22549.      | newname oldname |
  22550.  
  22551.      sfSelection == nil
  22552.  
  22553.           ifFalse: 
  22554.  
  22555.                [oldname := sfSelection at: 1.
  22556.  
  22557.                newname := DialogView request: 'New number for
  22558.  
  22559. SF?' initialAnswer: oldname.
  22560.  
  22561.                newname isEmpty
  22562.  
  22563.                     ifTrue: [^self]
  22564.  
  22565.                     ifFalse: [(TTMList aUsefulActLabel: newname)
  22566.  
  22567.                               ifFalse: [^self]
  22568.  
  22569.                               ifTrue: 
  22570.  
  22571.                                    [sfSelection at: 1 put:
  22572.  
  22573. newname.
  22574.  
  22575.                                    self changed:
  22576.  
  22577. #sfTransaction]]]! !
  22578.  
  22579. !TTMList methodsFor: 'sf access'!
  22580. sfSelection: index 
  22581.  
  22582.      "If the selection has been changed, remember the new
  22583.  
  22584. selection."
  22585.  
  22586.  
  22587.  
  22588.      | newSel |
  22589.  
  22590.      newSel := index = 0
  22591.  
  22592.                     ifTrue: [nil]
  22593.  
  22594.                     ifFalse: [selection stateFormulas at: index].
  22595.  
  22596.      sfSelection == newSel ifTrue: [^self].
  22597.  
  22598.      sfSelection := newSel.
  22599.  
  22600.      self changed: #curSFList! !
  22601.  
  22602. !TTMList methodsFor: 'filing operations'!
  22603. actualFileLoad
  22604.     | newTTM |
  22605.     newTTM := TTM getTTMFromFile: fileSelection.
  22606.     temporaryTTM := newTTM aCopy.
  22607.     temporaryTTM openWindows: (Array
  22608.             with: 0
  22609.             with: 0
  22610.             with: 0
  22611.             with: 0).
  22612.     models add: temporaryTTM.
  22613.     self changed: #transaction! !
  22614.  
  22615. !TTMList methodsFor: 'filing operations'!
  22616. actualFileLoadOld
  22617.     | aStream result line packingSection allParts |
  22618.     aStream := (Filename named: fileSelection) readStream.
  22619.     packingSection := nil.
  22620.     allParts := OrderedCollection new.
  22621.     result := aStream next.
  22622.     line := ''.
  22623.     [result notNil]
  22624.         whileTrue: 
  22625.             [result = Character cr
  22626.                 ifTrue: [line = ''
  22627.                         ifTrue: []
  22628.                         ifFalse: 
  22629.                             [(line at: 1)
  22630.                                 = $% | (line = '')
  22631.                                 ifTrue: []
  22632.                                 ifFalse: [(line at: 1)
  22633.                                         = $*
  22634.                                         ifTrue: 
  22635.                                             [self packAway: allParts into: packingSection.
  22636.                                             packingSection := line.
  22637.                                             allParts := OrderedCollection new]
  22638.                                         ifFalse: [packingSection = '*Initial Conditions' | (packingSection = '*State Formulas' | (packingSection = '*Note Pad'))
  22639.                                                 ifTrue: [allParts add: line]
  22640.                                                 ifFalse: [allParts add: (TTMList elementsFromLine: line)]]].
  22641.                             line := '']]
  22642.                 ifFalse: [line := line , (String with: result)].
  22643.             result := aStream next].
  22644.     aStream close! !
  22645.  
  22646. !TTMList methodsFor: 'filing operations'!
  22647. actualFileSave: aFileName 
  22648.     TTM storeTTM: selection onFile: aFileName! !
  22649.  
  22650. !TTMList methodsFor: 'filing operations'!
  22651. actualFileSaveOld: aFileName 
  22652.     | aStream count current listOfActivities left cc right actvar aPoint node arc icName icSet entry |
  22653.     aStream := (Filename named: aFileName) writeStream.
  22654.     selection fileTitle: selection named , '.model Description' on: aStream.
  22655.     selection fileLine: '%' on: aStream.
  22656.     selection fileLine: '*Activity Variables' on: aStream.
  22657.     selection fileLine: '%==================' on: aStream.
  22658.     count := 1.
  22659.     [count > selection activityvariable size]
  22660.         whileFalse: 
  22661.             [current := selection activityvariable at: count.
  22662.             selection fileLine: (current at: 1)
  22663.                     , ' ' , (current at: 2) on: aStream.
  22664.             count := count + 1].
  22665.     selection fileLine: '%' on: aStream.
  22666.     selection fileLine: '*Data Variables' on: aStream.
  22667.     selection fileLine: '%==============' on: aStream.
  22668.     count := 1.
  22669.     [count > selection datavariable size]
  22670.         whileFalse: 
  22671.             [current := selection datavariable at: count.
  22672.             selection fileLine: (current at: 1)
  22673.                     , ' ' , (current at: 2) , ' ' , (current at: 3) , ' ' , (current at: 4) on: aStream.
  22674.             count := count + 1].
  22675.     selection fileLine: '%' on: aStream.
  22676.     selection fileLine: '*Communication Channels' on: aStream.
  22677.     selection fileLine: '%======================' on: aStream.
  22678.     count := 1.
  22679.     [count > selection commchannel size]
  22680.         whileFalse: 
  22681.             [current := selection commchannel at: count.
  22682.             selection fileLine: (current at: 1)
  22683.                 on: aStream.
  22684.             count := count + 1].
  22685.     selection fileLine: '%' on: aStream.
  22686.     selection fileLine: '*State Formulas' on: aStream.
  22687.     selection fileLine: '%==============' on: aStream.
  22688.     count := 1.
  22689.     [count > selection stateFormulas size]
  22690.         whileFalse: 
  22691.             [current := selection stateFormulas at: count.
  22692.             selection fileLine: '!!' , (current at: 1) on: aStream.
  22693.             selection fileLine: (current at: 2)
  22694.                 on: aStream.
  22695.             count := count + 1].
  22696.     selection fileLine: '%' on: aStream.
  22697.     selection fileLine: '*Initial Conditions' on: aStream.
  22698.     selection fileLine: '%==================' on: aStream.
  22699.     selection fileLine: selection initialcondition on: aStream.
  22700.     selection fileLine: '%' on: aStream.
  22701.     selection fileLine: '*Specific Initial Conditions' on: aStream.
  22702.     selection fileLine: '%===========================' on: aStream.
  22703.     count := 1.
  22704.     [count > selection specificIC size]
  22705.         whileFalse: 
  22706.             [current := selection specificIC at: count.
  22707.             icName := '!!' , (current at: 1).
  22708.             icSet := current at: 2.
  22709.             selection fileLine: icName on: aStream.
  22710.             cc := 1.
  22711.             [cc > icSet size]
  22712.                 whileFalse: 
  22713.                     [entry := icSet at: cc.
  22714.                     selection fileLine: (entry at: 1)
  22715.                             , ' ' , (entry at: 2) on: aStream.
  22716.                     cc := cc + 1].
  22717.             count := count + 1].
  22718.     selection fileLine: '%' on: aStream.
  22719.     selection fileLine: '*Activities' on: aStream.
  22720.     selection fileLine: '%==========' on: aStream.
  22721.     listOfActivities := selection activitytree listOfActivities.
  22722.     count := 1.
  22723.     [count > listOfActivities size]
  22724.         whileFalse: 
  22725.             [current := listOfActivities at: count.
  22726.             selection fileLine: '% --------' , count printString , '--------' on: aStream.
  22727.             current left isNil
  22728.                 ifTrue: [left := '@']
  22729.                 ifFalse: 
  22730.                     [cc := 1.
  22731.                     [cc > listOfActivities size]
  22732.                         whileFalse: 
  22733.                             [(listOfActivities at: cc)
  22734.                                 = current left ifTrue: [left := cc printString].
  22735.                             cc := cc + 1]].
  22736.             current right isNil
  22737.                 ifTrue: [right := '@']
  22738.                 ifFalse: 
  22739.                     [cc := 1.
  22740.                     [cc > listOfActivities size]
  22741.                         whileFalse: 
  22742.                             [(listOfActivities at: cc)
  22743.                                 = current right ifTrue: [right := cc printString].
  22744.                             cc := cc + 1]].
  22745.             selection fileLine: current myName on: aStream.
  22746.             selection fileLine: left on: aStream.
  22747.             selection fileLine: right on: aStream.
  22748.             selection fileLine: current collectionType printString on: aStream.
  22749.             selection fileLine: current default printString on: aStream.
  22750.             cc := 1.
  22751.             [cc > selection activityvariable size]
  22752.                 whileFalse: 
  22753.                     [current av = (selection activityvariable at: cc) ifTrue: [actvar := cc printString].
  22754.                     cc := cc + 1].
  22755.             selection fileLine: actvar on: aStream.
  22756.             current myBox isNil
  22757.                 ifTrue: 
  22758.                     [selection fileLine: '@' on: aStream.
  22759.                     selection fileLine: '@' on: aStream.
  22760.                     selection fileLine: '@' on: aStream]
  22761.                 ifFalse: 
  22762.                     [selection fileLine: current myBox depth printString on: aStream.
  22763.                     aPoint := TTMList pointToString: current myBox location.
  22764.                     selection fileLine: aPoint on: aStream.
  22765.                     aPoint := (TTMList pointToString: current myBox dimensions origin)
  22766.                                 , ' ' , (TTMList pointToString: current myBox dimensions corner).
  22767.                     selection fileLine: aPoint on: aStream].
  22768.             count := count + 1].
  22769.     selection fileLine: '%' on: aStream.
  22770.     selection fileLine: '*Transitions' on: aStream.
  22771.     selection fileLine: '%===========' on: aStream.
  22772.     count := 1.
  22773.     [count > selection transitionlist size]
  22774.         whileFalse: 
  22775.             [selection fileLine: '%----------' , count printString , '---------' on: aStream.
  22776.             current := selection transitionlist at: count.
  22777.             selection fileLine: current myName on: aStream.
  22778.             current startingAt isNil
  22779.                 ifTrue: [node := '@']
  22780.                 ifFalse: 
  22781.                     [cc := 1.
  22782.                     [cc > listOfActivities size]
  22783.                         whileFalse: 
  22784.                             [(listOfActivities at: cc)
  22785.                                 = current startingAt ifTrue: [node := cc printString].
  22786.                             cc := cc + 1]].
  22787.             selection fileLine: node on: aStream.
  22788.             current endingAt isNil
  22789.                 ifTrue: [node := '@']
  22790.                 ifFalse: 
  22791.                     [cc := 1.
  22792.                     [cc > listOfActivities size]
  22793.                         whileFalse: 
  22794.                             [(listOfActivities at: cc)
  22795.                                 = current endingAt ifTrue: [node := cc printString].
  22796.                             cc := cc + 1]].
  22797.             selection fileLine: node on: aStream.
  22798.             selection fileLine: current boundLower , ' ' , current boundUpper on: aStream.
  22799.             selection fileLine: current myGuard on: aStream.
  22800.             selection fileLine: current myAction on: aStream.
  22801.             selection fileLine: current depth printString on: aStream.
  22802.             arc := current myArc.
  22803.             aPoint := (TTMList pointToString: arc dimensions origin)
  22804.                         , ' ' , (TTMList pointToString: arc dimensions corner).
  22805.             selection fileLine: aPoint on: aStream.
  22806.             aPoint := (TTMList pointToString: arc sourceStart)
  22807.                         , ' ' , (TTMList pointToString: arc sourceMid) , ' ' , (TTMList pointToString: arc sourceEnd).
  22808.             aPoint := aPoint , ' ' , (TTMList pointToString: arc destStart) , ' ' , (TTMList pointToString: arc destMid) , ' ' , (TTMList pointToString: arc destEnd).
  22809.             selection fileLine: aPoint on: aStream.
  22810.             selection fileLine: arc sourceArrow printString , ' ' , arc destArrow printString on: aStream.
  22811.             count := count + 1].
  22812.     selection fileLine: '%' on: aStream.
  22813.     selection fileLine: '*Note Pad' on: aStream.
  22814.     selection fileLine: '%========' on: aStream.
  22815.     selection fileLine: selection note on: aStream.
  22816.     selection fileLine: '%' on: aStream.
  22817.     selection fileLine: '*END' on: aStream.
  22818.     aStream close! !
  22819.  
  22820. !TTMList methodsFor: 'filing operations'!
  22821. fileList
  22822.     dirContents := SortedCollection new.
  22823.     currentDir directoryContents do: [:x | dirContents add: x].
  22824.     ^dirContents! !
  22825.  
  22826. !TTMList methodsFor: 'filing operations'!
  22827. fileLoad
  22828.     | suffix invalidSelection |
  22829.     invalidSelection := false.
  22830.     fileSelection == nil
  22831.         ifTrue: 
  22832.             [TTMList speak: 'no file selected'.
  22833.             ^nil].
  22834.     (Filename named: fileSelection) exists
  22835.         ifFalse: 
  22836.             [TTMList speak: 'file does not exist'.
  22837.             ^nil].
  22838.     (Filename named: fileSelection) isDirectory
  22839.         ifTrue: 
  22840.             [TTMList speak: 'this is a directory, not a file.'.
  22841.             ^nil].
  22842.     (Filename named: fileSelection) isReadable
  22843.         ifFalse: 
  22844.             [TTMList speak: 'file is not readable.'.
  22845.             ^nil].
  22846.     invalidSelection = false
  22847.         ifTrue: 
  22848.             ["fileSelection size < 7 
  22849.             
  22850.             ifTrue: [invalidSelection := true] 
  22851.             
  22852.             ifFalse: [invalidSelection := false]."
  22853.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  22854.             suffix = '.mdl'
  22855.                 ifTrue: [self actualFileLoad]
  22856.                 ifFalse: [invalidSelection := true]].
  22857.     invalidSelection = true
  22858.         ifTrue: 
  22859.             [TTMList speak: 'this is not a .mdl file.'.
  22860.             ^nil]! !
  22861.  
  22862. !TTMList methodsFor: 'filing operations'!
  22863. fileLoadNew
  22864.     | suffix invalidSelection |
  22865.     invalidSelection := false.
  22866.     fileSelection == nil
  22867.         ifTrue: 
  22868.             [TTMList speak: 'no file selected'.
  22869.             ^nil].
  22870.     (Filename named: fileSelection) exists
  22871.         ifFalse: 
  22872.             [TTMList speak: 'file does not exist'.
  22873.             ^nil].
  22874.     (Filename named: fileSelection) isDirectory
  22875.         ifTrue: 
  22876.             [TTMList speak: 'this is a directory, not a file.'.
  22877.             ^nil].
  22878.     (Filename named: fileSelection) isReadable
  22879.         ifFalse: 
  22880.             [TTMList speak: 'file is not readable.'.
  22881.             ^nil].
  22882.     invalidSelection = false
  22883.         ifTrue: 
  22884.             ["fileSelection size < 7 
  22885.             
  22886.             ifTrue: [invalidSelection := true] 
  22887.             
  22888.             ifFalse: [invalidSelection := false]."
  22889.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  22890.             suffix = '.mdl'
  22891.                 ifTrue: [self actualFileLoad]
  22892.                 ifFalse: [invalidSelection := true]].
  22893.     invalidSelection = true
  22894.         ifTrue: 
  22895.             [TTMList speak: 'this is not a .mdl file.'.
  22896.             ^nil]! !
  22897.  
  22898. !TTMList methodsFor: 'filing operations'!
  22899. fileLoadOld
  22900.     | suffix invalidSelection |
  22901.     invalidSelection := false.
  22902.     fileSelection == nil
  22903.         ifTrue: 
  22904.             [TTMList speak: 'no file selected'.
  22905.             ^nil].
  22906.     (Filename named: fileSelection) exists
  22907.         ifFalse: 
  22908.             [TTMList speak: 'file does not exist'.
  22909.             ^nil].
  22910.     (Filename named: fileSelection) isDirectory
  22911.         ifTrue: 
  22912.             [TTMList speak: 'this is a directory, not a file.'.
  22913.             ^nil].
  22914.     (Filename named: fileSelection) isReadable
  22915.         ifFalse: 
  22916.             [TTMList speak: 'file is not readable.'.
  22917.             ^nil].
  22918.     invalidSelection = false
  22919.         ifTrue: 
  22920.             ["fileSelection size < 7 
  22921.             
  22922.             ifTrue: [invalidSelection := true] 
  22923.             
  22924.             ifFalse: [invalidSelection := false]."
  22925.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  22926.             suffix = '.mdl'
  22927.                 ifTrue: [self actualFileLoad]
  22928.                 ifFalse: [invalidSelection := true]].
  22929.     invalidSelection = true
  22930.         ifTrue: 
  22931.             [TTMList speak: 'this is not a .mdl file.'.
  22932.             ^nil]! !
  22933.  
  22934. !TTMList methodsFor: 'filing operations'!
  22935. fileSave
  22936.     "Returns the stream in append mode or 
  22937.     
  22938.     returns nil if file could not be opened."
  22939.  
  22940.     | defaultName ready fileName go myMessage suffix fullPath |
  22941.     selection == nil
  22942.         ifTrue: 
  22943.             [TTMList speak: 'no TTM selected.'.
  22944.             ^nil].
  22945.     defaultName := selection named asString.
  22946.     ready := false.
  22947.     [ready]
  22948.         whileFalse: 
  22949.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  22950.             fileName isEmpty
  22951.                 ifTrue: 
  22952.                     [TTMList speak: 'No filename given - generation aborted.'.
  22953.                     ^nil]
  22954.                 ifFalse: 
  22955.                     [fileName size < 7
  22956.                         ifTrue: [fileName := fileName , '.mdl']
  22957.                         ifFalse: 
  22958.                             [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  22959.                             suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  22960.                     ready := true]].
  22961.     go := false.
  22962.     fullPath := (Filename named: selection getDirectory)
  22963.                 construct: fileName.
  22964.     fullPath exists
  22965.         ifTrue: 
  22966.             [myMessage := 'Filename already exists. Overwrite?'.
  22967.             (DialogView confirm: myMessage)
  22968.                 = true ifTrue: [go := true]]
  22969.         ifFalse: [go := true].
  22970.     go = true
  22971.         ifTrue: 
  22972.             [fullPath exists ifTrue: [fullPath isWritable
  22973.                     ifFalse: 
  22974.                         [TTMList speak: 'file is not writeable.'.
  22975.                         ^nil]].
  22976.             self actualFileSave: ((Filename named: selection getDirectory)
  22977.                     constructString: fileName).
  22978.             self changed: #fileTransaction]! !
  22979.  
  22980. !TTMList methodsFor: 'filing operations'!
  22981. fileSaveNew
  22982.     "Returns the stream in append mode or 
  22983.     
  22984.     returns nil if file could not be opened."
  22985.  
  22986.     | defaultName ready fileName go myMessage suffix fullPath |
  22987.     selection == nil
  22988.         ifTrue: 
  22989.             [TTMList speak: 'no TTM selected.'.
  22990.             ^nil].
  22991.     defaultName := selection named asString.
  22992.     ready := false.
  22993.     [ready]
  22994.         whileFalse: 
  22995.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  22996.             fileName isEmpty
  22997.                 ifTrue: 
  22998.                     [TTMList speak: 'No filename given - generation aborted.'.
  22999.                     ^nil]
  23000.                 ifFalse: 
  23001.                     [fileName size < 7
  23002.                         ifTrue: [fileName := fileName , '.mdl']
  23003.                         ifFalse: 
  23004.                             [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  23005.                             suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  23006.                     ready := true]].
  23007.     go := false.
  23008.     fullPath := (Filename named: fileName)
  23009.                 construct: fileName.
  23010.     fullPath exists
  23011.         ifTrue: 
  23012.             [myMessage := 'Filename already exists. Overwrite?'.
  23013.             (DialogView confirm: myMessage)
  23014.                 = true ifTrue: [go := true]]
  23015.         ifFalse: [go := true].
  23016.     go = true
  23017.         ifTrue: 
  23018.             [(Filename named: fileName) exists ifTrue: [(Filename named: fileName) isWritable
  23019.                     ifFalse: 
  23020.                         [TTMList speak: 'file is not writeable.'.
  23021.                         ^nil]].
  23022.             self actualFileSave: fileName.
  23023.             self changed: #fileTransaction]! !
  23024.  
  23025. !TTMList methodsFor: 'filing operations'!
  23026. fileSaveOld
  23027.     "Returns the stream in append mode or 
  23028.     
  23029.     returns nil if file could not be opened."
  23030.  
  23031.     | defaultName ready fileName go myMessage suffix |
  23032.     selection == nil
  23033.         ifTrue: 
  23034.             [TTMList speak: 'no TTM selected.'.
  23035.             ^nil].
  23036.     defaultName := selection named asString.
  23037.     ready := false.
  23038.     [ready]
  23039.         whileFalse: 
  23040.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  23041.             fileName isEmpty
  23042.                 ifTrue: 
  23043.                     [TTMList speak: 'No filename given - generation aborted.'.
  23044.                     ready := true]
  23045.                 ifFalse: 
  23046.                     [go := false.
  23047.                     (Filename named: fileName) exists
  23048.                         ifTrue: 
  23049.                             [myMessage := 'Filename already exists. Overwrite?'.
  23050.                             (DialogView confirm: myMessage)
  23051.                                 = true ifTrue: [go := true]]
  23052.                         ifFalse: [go := true].
  23053.                     go = true
  23054.                         ifTrue: 
  23055.                             [fileName size < 7
  23056.                                 ifTrue: [fileName := fileName , '.mdl']
  23057.                                 ifFalse: 
  23058.                                     [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  23059.                                     suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  23060.                             ready := true]]].
  23061.     (Filename named: fileName) exists ifTrue: [(Filename named: fileName) isWritable
  23062.             ifFalse: 
  23063.                 [TTMList speak: 'file is not writeable.'.
  23064.                 ^nil]].
  23065.     self actualFileSave: fileName.
  23066.     self changed: #fileTransaction! !
  23067.  
  23068. !TTMList methodsFor: 'filing operations'!
  23069. packAway: allParts into: packingSection 
  23070.     | count currentAV currentDV currentCom actName actLeft actRight actType actDefault actAV actDepth actLocation actDimensions currentActivity currentBox aPoint anotherPoint currentTrList trStartAct trEndAct trLowerBound trUpperBound trGuard trAction trPoints cc theString arc pt1 pt2 pt5 pt6 trName trDepth trDimensions trArrows currentTr pt3 pt4 note line current collection sfName icName specifics stateFormulas newname |
  23071.     packingSection isNil ifTrue: [^nil].
  23072.     packingSection = '*Activity Variables'
  23073.         ifTrue: 
  23074.             [count := 1.
  23075.             currentAV := allParts at: count.
  23076.             temporaryTTM := TTM create: 'dummy' with: (currentAV at: 1).
  23077.             (temporaryTTM activityvariable at: 1)
  23078.                 at: 2 put: (currentAV at: 2).
  23079.             count := 2.
  23080.             [count > allParts size]
  23081.                 whileFalse: 
  23082.                     [currentAV := allParts at: count.
  23083.                     temporaryTTM activityvariable: (currentAV at: 1)
  23084.                         initial: (currentAV at: 2).
  23085.                     count := count + 1]].
  23086.     packingSection = '*Data Variables'
  23087.         ifTrue: 
  23088.             [count := 1.
  23089.             [count > allParts size]
  23090.                 whileFalse: 
  23091.                     [currentDV := allParts at: count.
  23092.                     temporaryTTM
  23093.                         datavariable: (currentDV at: 1)
  23094.                         lrange: (currentDV at: 2)
  23095.                         hrange: (currentDV at: 3)
  23096.                         initial: (currentDV at: 4).
  23097.                     count := count + 1]].
  23098.     packingSection = '*Communication Channels'
  23099.         ifTrue: 
  23100.             [count := 1.
  23101.             [count > allParts size]
  23102.                 whileFalse: 
  23103.                     [currentCom := allParts at: count.
  23104.                     temporaryTTM commchannel: (currentCom at: 1).
  23105.                     count := count + 1]].
  23106.     packingSection = '*State Formulas'
  23107.         ifTrue: 
  23108.             [count := 1.
  23109.             collection := ''.
  23110.             sfName := nil.
  23111.             stateFormulas := OrderedCollection new.
  23112.             [count > allParts size]
  23113.                 whileFalse: 
  23114.                     [current := allParts at: count.
  23115.                     (current at: 1)
  23116.                         = $!!
  23117.                         ifTrue: 
  23118.                             [sfName notNil ifTrue: [stateFormulas add: (Array with: sfName with: collection)].
  23119.                             sfName := current copyFrom: 2 to: current size.
  23120.                             collection := '']
  23121.                         ifFalse: [collection := collection , current , (String with: Character cr)].
  23122.                     count := count + 1].
  23123.             collection = '' ifFalse: [stateFormulas add: (Array with: sfName with: collection)].
  23124.             temporaryTTM stateFormulas: stateFormulas].
  23125.     packingSection = '*Initial Conditions'
  23126.         ifTrue: 
  23127.             [count := 1.
  23128.             note := ''.
  23129.             [count > allParts size]
  23130.                 whileFalse: 
  23131.                     [line := allParts at: count.
  23132.                     note := note , line , (String with: Character cr).
  23133.                     count := count + 1].
  23134.             temporaryTTM initialcondition: note].
  23135.     packingSection = '*Specific Initial Conditions'
  23136.         ifTrue: 
  23137.             [count := 1.
  23138.             collection := OrderedCollection new.
  23139.             specifics := OrderedCollection new.
  23140.             icName := nil.
  23141.             [count > allParts size]
  23142.                 whileFalse: 
  23143.                     [current := allParts at: count.
  23144.                     ((current at: 1)
  23145.                         at: 1)
  23146.                         = $!!
  23147.                         ifTrue: 
  23148.                             [icName notNil ifTrue: [specifics add: (Array with: icName with: collection)].
  23149.                             icName := (current at: 1)
  23150.                                         copyFrom: 2 to: (current at: 1) size.
  23151.                             collection := OrderedCollection new]
  23152.                         ifFalse: [collection add: (Array with: (current at: 1)
  23153.                                     with: (current at: 2))].
  23154.                     count := count + 1].
  23155.             collection size > 0 ifTrue: [specifics add: (Array with: icName with: collection)].
  23156.             temporaryTTM specificIC: specifics].
  23157.     packingSection = '*Activities'
  23158.         ifTrue: 
  23159.             [count := 1.
  23160.             activityStack := OrderedCollection new.
  23161.             [count > allParts size]
  23162.                 whileFalse: 
  23163.                     [actName := (allParts at: count)
  23164.                                 at: 1.
  23165.                     actLeft := (allParts at: count + 1)
  23166.                                 at: 1.
  23167.                     actRight := (allParts at: count + 2)
  23168.                                 at: 1.
  23169.                     actType := (allParts at: count + 3)
  23170.                                 at: 1.
  23171.                     actDefault := (allParts at: count + 4)
  23172.                                 at: 1.
  23173.                     actAV := (allParts at: count + 5)
  23174.                                 at: 1.
  23175.                     actDepth := (allParts at: count + 6)
  23176.                                 at: 1.
  23177.                     actLocation := allParts at: count + 7.
  23178.                     actDimensions := allParts at: count + 8.
  23179.                     currentActivity := Activity new.
  23180.                     currentActivity myName: actName.
  23181.                     actLeft = '@'
  23182.                         ifTrue: [currentActivity left: nil]
  23183.                         ifFalse: [currentActivity left: (activityStack at: (TTMList convertToNumber: actLeft))].
  23184.                     actRight = '@'
  23185.                         ifTrue: [currentActivity right: nil]
  23186.                         ifFalse: [currentActivity right: (activityStack at: (TTMList convertToNumber: actRight))].
  23187.                     actType = '#cluster'
  23188.                         ifTrue: [currentActivity collectionType: #cluster]
  23189.                         ifFalse: [currentActivity collectionType: #parallel].
  23190.                     actDefault = 'false'
  23191.                         ifTrue: [currentActivity default: false]
  23192.                         ifFalse: [currentActivity default: true].
  23193.                     currentActivity av: (temporaryTTM activityvariable at: (TTMList convertToNumber: actAV)).
  23194.                     (actLocation at: 1)
  23195.                         = '@'
  23196.                         ifTrue: [currentActivity myBox: nil]
  23197.                         ifFalse: 
  23198.                             [currentBox := Box new.
  23199.                             aPoint := TTMList stringToPoint: (actLocation at: 1)
  23200.                                         at: (actLocation at: 2).
  23201.                             currentBox location: aPoint.
  23202.                             aPoint := TTMList stringToPoint: (actDimensions at: 1)
  23203.                                         at: (actDimensions at: 2).
  23204.                             anotherPoint := TTMList stringToPoint: (actDimensions at: 3)
  23205.                                         at: (actDimensions at: 4).
  23206.                             currentBox dimensions: (Rectangle origin: aPoint corner: anotherPoint).
  23207.                             actDepth = '#hidden'
  23208.                                 ifTrue: [currentBox depth: #hidden]
  23209.                                 ifFalse: [currentBox depth: #exposed].
  23210.                             currentActivity myBox: currentBox].
  23211.                     activityStack add: currentActivity.
  23212.                     count := count + 9].
  23213.             temporaryTTM activitytree newRoot: (activityStack at: activityStack size).
  23214.             temporaryTTM named: temporaryTTM activitytree getRoot myName.
  23215.             [self ttmList includes: temporaryTTM named]
  23216.                 whileTrue: 
  23217.                     [newname := DialogView request: 'TTM of this name already exists.' , (String with: Character cr) , 'Please supply a new name for loaded TTM:'.
  23218.                     (TTMList aUsefulTTMName: newname)
  23219.                         ifTrue: [temporaryTTM named: newname]]].
  23220.     packingSection = '*Transitions'
  23221.         ifTrue: 
  23222.             [count := 1.
  23223.             currentTrList := TransitionList new.
  23224.             [count > allParts size]
  23225.                 whileFalse: 
  23226.                     [trName := (allParts at: count)
  23227.                                 at: 1.
  23228.                     trStartAct := (allParts at: count + 1)
  23229.                                 at: 1.
  23230.                     trEndAct := (allParts at: count + 2)
  23231.                                 at: 1.
  23232.                     trLowerBound := (allParts at: count + 3)
  23233.                                 at: 1.
  23234.                     trUpperBound := (allParts at: count + 3)
  23235.                                 at: 2.
  23236.                     trGuard := allParts at: count + 4.
  23237.                     trAction := allParts at: count + 5.
  23238.                     trDepth := (allParts at: count + 6)
  23239.                                 at: 1.
  23240.                     trDimensions := allParts at: count + 7.
  23241.                     trPoints := allParts at: count + 8.
  23242.                     trArrows := allParts at: count + 9.
  23243.                     currentTr := Transition new.
  23244.                     currentTr myName: trName.
  23245.                     currentTr startingAt: (activityStack at: (TTMList convertToNumber: trStartAct)).
  23246.                     currentTr endingAt: (activityStack at: (TTMList convertToNumber: trEndAct)).
  23247.                     currentTr boundLower: trLowerBound.
  23248.                     currentTr boundUpper: trUpperBound.
  23249.                     cc := 1.
  23250.                     theString := ''.
  23251.                     [cc > trGuard size]
  23252.                         whileFalse: 
  23253.                             [theString = ''
  23254.                                 ifTrue: [theString := trGuard at: cc]
  23255.                                 ifFalse: [theString := theString , ' ' , (trGuard at: cc)].
  23256.                             cc := cc + 1].
  23257.                     currentTr myGuard: theString.
  23258.                     cc := 1.
  23259.                     theString := ''.
  23260.                     [cc > trAction size]
  23261.                         whileFalse: 
  23262.                             [theString = ''
  23263.                                 ifTrue: [theString := trAction at: cc]
  23264.                                 ifFalse: [theString := theString , ' ' , (trAction at: cc)].
  23265.                             cc := cc + 1].
  23266.                     currentTr myAction: theString.
  23267.                     trDepth = '#hidden'
  23268.                         ifTrue: [currentTr depth: #hidden]
  23269.                         ifFalse: [currentTr depth: #exposed].
  23270.                     arc := Arc2 new.
  23271.                     pt1 := TTMList stringToPoint: (trDimensions at: 1)
  23272.                                 at: (trDimensions at: 2).
  23273.                     pt2 := TTMList stringToPoint: (trDimensions at: 3)
  23274.                                 at: (trDimensions at: 4).
  23275.                     arc dimensions: (Rectangle origin: pt1 corner: pt2).
  23276.                     pt1 := TTMList stringToPoint: (trPoints at: 1)
  23277.                                 at: (trPoints at: 2).
  23278.                     pt2 := TTMList stringToPoint: (trPoints at: 3)
  23279.                                 at: (trPoints at: 4).
  23280.                     pt3 := TTMList stringToPoint: (trPoints at: 5)
  23281.                                 at: (trPoints at: 6).
  23282.                     pt4 := TTMList stringToPoint: (trPoints at: 7)
  23283.                                 at: (trPoints at: 8).
  23284.                     pt5 := TTMList stringToPoint: (trPoints at: 9)
  23285.                                 at: (trPoints at: 10).
  23286.                     pt6 := TTMList stringToPoint: (trPoints at: 11)
  23287.                                 at: (trPoints at: 12).
  23288.                     arc sourceStart: pt1.
  23289.                     arc sourceMid: pt2.
  23290.                     arc sourceEnd: pt3.
  23291.                     arc destStart: pt4.
  23292.                     arc destMid: pt5.
  23293.                     arc destEnd: pt6.
  23294.                     arc sourceArrow: (TTMList convertToNumber: (trArrows at: 1)).
  23295.                     arc destArrow: (TTMList convertToNumber: (trArrows at: 2)).
  23296.                     currentTr myArc: arc.
  23297.                     currentTrList add: currentTr.
  23298.                     count := count + 10].
  23299.             temporaryTTM transitionlist: currentTrList].
  23300.     packingSection = '*Note Pad'
  23301.         ifTrue: 
  23302.             [count := 1.
  23303.             note := ''.
  23304.             [count > allParts size]
  23305.                 whileFalse: 
  23306.                     [line := allParts at: count.
  23307.                     note := note , line , (String with: Character cr).
  23308.                     count := count + 1].
  23309.             temporaryTTM note: note.
  23310.             models add: temporaryTTM.
  23311.             temporaryTTM openWindows: (Array
  23312.                     with: 0
  23313.                     with: 0
  23314.                     with: 0
  23315.                     with: 0).
  23316.             self changed: #transaction]! !
  23317.  
  23318. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  23319.  
  23320. TTMList class
  23321.     instanceVariableNames: 'currentDirectory '!
  23322.  
  23323. !TTMList class methodsFor: 'type conversions'!
  23324. aValidNumber: aString 
  23325.     "Return true if aString is a valid number or the string 'infinity'."
  23326.  
  23327.     | valid count |
  23328.     aString size = 0
  23329.         ifTrue: [valid := false]
  23330.         ifFalse: 
  23331.             [valid := true.
  23332.             aString = 'infinity' | (aString = '-infinity')
  23333.                 ifFalse: 
  23334.                     [count := 1.
  23335.                     aString size
  23336.                         timesRepeat: 
  23337.                             [(aString at: count) isDigit | (count = 1 & ((aString at: count)
  23338.                                         = $-)) ifFalse: [valid := false].
  23339.                             count := count + 1]]].
  23340.     ^valid! !
  23341.  
  23342. !TTMList class methodsFor: 'type conversions'!
  23343. convertToNumber: aUsersString 
  23344.     "Return a number which is the integer equivalent of the string of digit 
  23345.     
  23346.     characters making up aString."
  23347.  
  23348.     | total current digit number aString neg |
  23349.     (aUsersString at: 1)
  23350.         = $-
  23351.         ifTrue: 
  23352.             [aString := aUsersString copyFrom: 2 to: aUsersString size.
  23353.             neg := true]
  23354.         ifFalse: 
  23355.             [aString := aUsersString.
  23356.             neg := false].
  23357.     total := 0.
  23358.     current := aString size.
  23359.     [current > 0]
  23360.         whileTrue: 
  23361.             [digit := aString at: current.
  23362.             number := 0.
  23363.             digit = $1 ifTrue: [number := 1].
  23364.             digit = $2 ifTrue: [number := 2].
  23365.             digit = $3 ifTrue: [number := 3].
  23366.             digit = $4 ifTrue: [number := 4].
  23367.             digit = $5 ifTrue: [number := 5].
  23368.             digit = $6 ifTrue: [number := 6].
  23369.             digit = $7 ifTrue: [number := 7].
  23370.             digit = $8 ifTrue: [number := 8].
  23371.             digit = $9 ifTrue: [number := 9].
  23372.             total := total + (number * (10 raisedToInteger: aString size - current)).
  23373.             current := current - 1].
  23374.     neg = true ifTrue: [total := total * -1].
  23375.     ^total! !
  23376.  
  23377. !TTMList class methodsFor: 'type conversions'!
  23378. convertToString: aUsersNumber 
  23379.     "Return a string which is the equivalent character string for the integer 
  23380.     
  23381.     aNumber. This is used for displaying when we dont want to use 
  23382.     printstring."
  23383.  
  23384.     | total digit number power totaldigits currentNumber aNumber |
  23385.     total := ''.
  23386.     aNumber := aUsersNumber.
  23387.     aNumber < 0
  23388.         ifTrue: 
  23389.             [total := '-'.
  23390.             aNumber := aNumber * -1].
  23391.     power := 10.
  23392.     totaldigits := 0.
  23393.     aNumber / power < 1 ifFalse: [[aNumber / power < 1]
  23394.             whileFalse: 
  23395.                 [totaldigits := totaldigits + 1.
  23396.                 power := power * 10]].
  23397.     currentNumber := aNumber.
  23398.     [totaldigits >= 0]
  23399.         whileTrue: 
  23400.             [digit := (currentNumber / (10 raisedToInteger: totaldigits)) floor.
  23401.             currentNumber := currentNumber - (digit * (10 raisedToInteger: totaldigits)).
  23402.             number := '0'.
  23403.             digit = 1 ifTrue: [number := '1'].
  23404.             digit = 2 ifTrue: [number := '2'].
  23405.             digit = 3 ifTrue: [number := '3'].
  23406.             digit = 4 ifTrue: [number := '4'].
  23407.             digit = 5 ifTrue: [number := '5'].
  23408.             digit = 6 ifTrue: [number := '6'].
  23409.             digit = 7 ifTrue: [number := '7'].
  23410.             digit = 8 ifTrue: [number := '8'].
  23411.             digit = 9 ifTrue: [number := '9'].
  23412.             total := total , number.
  23413.             totaldigits := totaldigits - 1].
  23414.     ^total! !
  23415.  
  23416. !TTMList class methodsFor: 'type conversions'!
  23417. pointToString: aPoint 
  23418.     ^aPoint x printString , ' ' , aPoint y printString! !
  23419.  
  23420. !TTMList class methodsFor: 'type conversions'!
  23421. stringToPoint: xcoord at: ycoord 
  23422.     | x y |
  23423.     x := TTMList convertToNumber: xcoord.
  23424.     y := TTMList convertToNumber: ycoord.
  23425.     ^Point x: x y: y! !
  23426.  
  23427. !TTMList class methodsFor: 'instance creation'!
  23428. new
  23429.     "Create a TTMList and initialize it."
  23430.  
  23431.     ^super new initialize! !
  23432.  
  23433. !TTMList class methodsFor: 'instance creation'!
  23434. open
  23435.     "Create a new TTMList and open a view on it."
  23436.     "TTMList open"
  23437.  
  23438.     self open: self new.
  23439.     self currentDirectory: Filename currentDirectory asString! !
  23440.  
  23441. !TTMList class methodsFor: 'instance creation'!
  23442. open: aTTMListModel 
  23443.     "Assemble the components of the view and open it on 
  23444.     aTTMListModel."
  23445.  
  23446.     | window container iButton eButton dataView activityView rButton gButton oButton sButton tButton hButton ttmListView myWrapper backColor partColor left top hsize vsize hspace vspace originalTop cButton notePadView sfHeadView sfView gsButton qiButton qButton |
  23447.     aTTMListModel currentDirectory: Filename currentDirectory.
  23448.     backColor := ColorValue veryLightGray.
  23449.     partColor := ColorValue white.
  23450.     window := ScheduledWindow new.
  23451.     window insideColor: partColor.
  23452.     window label: 'Build V.0.984'.
  23453.     window minimumSize: 550 @ 500.
  23454.     window model: TTMListWindow new.
  23455.     container := CompositePart new.
  23456.     originalTop := 0.83.
  23457.     left := 0.06.
  23458.     top := originalTop.
  23459.     hsize := 0.195.
  23460.     vsize := 0.04.
  23461.     hspace := 0.22.
  23462.     vspace := 0.05.
  23463.     (container add: ' ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  23464.         insideColor: backColor.    "Button for adding a ttm to the list"
  23465.     iButton := PushButton named: 'Add TTM'.
  23466.     iButton model: ((PluggableAdaptor on: aTTMListModel)
  23467.             getBlock: [:model | false]
  23468.             putBlock: [:model :value | model doAdd]
  23469.             updateBlock: [:model :value :parameter | false]).
  23470.     (container add: iButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23471.         insideColor: ColorValue white.
  23472.     top := top + vspace.    "Button for removing a ttm from the list"
  23473.     eButton := PushButton named: 'Remove TTM'.
  23474.     eButton model: ((PluggableAdaptor on: aTTMListModel)
  23475.             getBlock: [:model | false]
  23476.             putBlock: [:model :value | model doRemove]
  23477.             updateBlock: [:model :value :parameter | false]).
  23478.     (container add: eButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23479.         insideColor: ColorValue white.
  23480.     top := top + vspace.    "Button for renaming the current ttm"
  23481.     rButton := PushButton named: 'Rename TTM'.
  23482.     rButton model: ((PluggableAdaptor on: aTTMListModel)
  23483.             getBlock: [:model | false]
  23484.             putBlock: [:model :value | model doRename]
  23485.             updateBlock: [:model :value :parameter | false]).
  23486.     (container add: rButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23487.         insideColor: ColorValue white.
  23488.     top := originalTop.
  23489.     left := left + hspace.    "Button for copying the selected ttm."
  23490.     cButton := PushButton named: 'Copy TTM'.
  23491.     cButton model: ((PluggableAdaptor on: aTTMListModel)
  23492.             getBlock: [:model | false]
  23493.             putBlock: [:model :value | model doCopy]
  23494.             updateBlock: [:model :value :parameter | false]).
  23495.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23496.         insideColor: ColorValue white.
  23497.     top := top + vspace.    "Button for opening the selected ttm."
  23498.     oButton := PushButton named: 'Edit TTM'.
  23499.     oButton model: ((PluggableAdaptor on: aTTMListModel)
  23500.             getBlock: [:model | false]
  23501.             putBlock: [:model :value | model doEdit]
  23502.             updateBlock: [:model :value :parameter | false]).
  23503.     (container add: oButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23504.         insideColor: ColorValue white.
  23505.     top := top + vspace.    "Button for specifying ICs selected ttm"
  23506.     qiButton := PushButton named: 'Specify IC'.
  23507.     qiButton model: ((PluggableAdaptor on: aTTMListModel)
  23508.             getBlock: [:model | false]
  23509.             putBlock: [:model :value | model doConditions]
  23510.             updateBlock: [:model :value :parameter | false]).
  23511.     (container add: qiButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23512.         insideColor: ColorValue white.
  23513.     top := originalTop.
  23514.     left := left + hspace.    "Button for getting querying the TTM"
  23515.     tButton := PushButton named: 'Query TTM'.
  23516.     tButton model: ((PluggableAdaptor on: aTTMListModel)
  23517.             getBlock: [:model | false]
  23518.             putBlock: [:model :value | model doQuery]
  23519.             updateBlock: [:model :value :parameter | false]).
  23520.     (container add: tButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23521.         insideColor: ColorValue white.
  23522.     top := top + vspace.    "Button for simulation of selected ttm"
  23523.     sButton := PushButton named: 'Simulate TTM'.
  23524.     sButton model: ((PluggableAdaptor on: aTTMListModel)
  23525.             getBlock: [:model | false]
  23526.             putBlock: [:model :value | model doSimulate]
  23527.             updateBlock: [:model :value :parameter | false]).
  23528.     (container add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23529.         insideColor: ColorValue white.
  23530.     top := top + vspace.    "Button for generating code for the selected ttm"
  23531.     gButton := PushButton named: 'Generate Code'.
  23532.     gButton model: ((PluggableAdaptor on: aTTMListModel)
  23533.             getBlock: [:model | false]
  23534.             putBlock: [:model :value | model doGenerate]
  23535.             updateBlock: [:model :value :parameter | false]).
  23536.     (container add: gButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23537.         insideColor: ColorValue white.
  23538.     top := originalTop.
  23539.     left := left + hspace.    "Button for filing access"
  23540.     gsButton := PushButton named: 'File Access'.
  23541.     gsButton model: ((PluggableAdaptor on: aTTMListModel)
  23542.             getBlock: [:model | false]
  23543.             putBlock: [:model :value | model doFileAccess]
  23544.             updateBlock: [:model :value :parameter | false]).
  23545.     (container add: gsButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23546.         insideColor: ColorValue white.
  23547.     top := top + vspace.    "Button for getting help"
  23548.     hButton := PushButton named: 'Help' asText allBold.
  23549.     hButton model: ((PluggableAdaptor on: aTTMListModel)
  23550.             getBlock: [:model | false]
  23551.             putBlock: [:model :value | HelpScreens openHelp: 'introduction']
  23552.             updateBlock: [:model :value :parameter | false]).
  23553.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23554.         insideColor: ColorValue white.
  23555.     top := top + vspace.    "Button for quitting"
  23556.     qButton := PushButton named: 'Exit Program'.
  23557.     qButton model: ((PluggableAdaptor on: aTTMListModel)
  23558.             getBlock: [:model | false]
  23559.             putBlock: [:model :value | TTMList closeWindowAndConfirm]
  23560.             updateBlock: [:model :value :parameter | false]).
  23561.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23562.         insideColor: ColorValue white.    "TTM listing view"
  23563.     ttmListView := SelectionInListView
  23564.                 on: aTTMListModel
  23565.                 printItems: false
  23566.                 oneItem: false
  23567.                 aspect: #transaction
  23568.                 change: #selection:
  23569.                 list: #ttmList
  23570.                 menu: #ttmListMenu
  23571.                 initialSelection: nil
  23572.                 useIndex: true.
  23573.     myWrapper := self wrap: (LookPreferences edgeDecorator on: ttmListView).
  23574.     (container add: myWrapper borderedIn: (0.02 @ 0.06 extent: 0.5 @ 0.35))
  23575.         insideColor: partColor.
  23576.     self labelWrap: (container add: ' List Of Existing TTMs:' asText allBold asComposedText borderedIn: (0.02 @ 0.02 extent: 0.5 @ 0.04)).    "Note Pad View"
  23577.     notePadView := TextView
  23578.                 on: aTTMListModel
  23579.                 aspect: #noteList
  23580.                 change: #noteAccept:
  23581.                 menu: #noteMenu
  23582.                 initialSelection: nil.
  23583.     myWrapper := self wrap: (LookPreferences edgeDecorator on: notePadView).
  23584.     (container add: myWrapper borderedIn: (0.02 @ 0.46 extent: 0.5 @ 0.15))
  23585.         insideColor: partColor.
  23586.     self labelWrap: (container add: ' Note Pad:' asText allBold asComposedText borderedIn: (0.02 @ 0.42 extent: 0.5 @ 0.04)).    "Activity Variable view"
  23587.     activityView := SelectionInListView
  23588.                 on: aTTMListModel
  23589.                 printItems: false
  23590.                 oneItem: false
  23591.                 aspect: #avTransaction
  23592.                 change: #avSelection:
  23593.                 list: #avList
  23594.                 menu: #avMenu
  23595.                 initialSelection: nil
  23596.                 useIndex: true.
  23597.     myWrapper := self wrap: (LookPreferences edgeDecorator on: activityView).
  23598.     (container add: myWrapper borderedIn: (0.54 @ 0.06 extent: 0.44 @ 0.24))
  23599.         insideColor: partColor.
  23600.     self labelWrap: (container add: ' Activity Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.02 extent: 0.44 @ 0.04)).    "Data Variable view"
  23601.     dataView := SelectionInListView
  23602.                 on: aTTMListModel
  23603.                 printItems: false
  23604.                 oneItem: false
  23605.                 aspect: #dvTransaction
  23606.                 change: #dvSelection:
  23607.                 list: #dvList
  23608.                 menu: #dvMenu
  23609.                 initialSelection: nil
  23610.                 useIndex: true.
  23611.     myWrapper := self wrap: (LookPreferences edgeDecorator on: dataView).
  23612.     (container add: myWrapper borderedIn: (0.54 @ 0.36 extent: 0.44 @ 0.24))
  23613.         insideColor: partColor.
  23614.     self labelWrap: (container add: ' Data Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.32 extent: 0.44 @ 0.04)).    "channelView := SelectionInListView 
  23615.     on: aTTMListModel 
  23616.     printItems: false 
  23617.     oneItem: false 
  23618.     aspect: #chTransaction 
  23619.     change: #chSelection: 
  23620.     list: #chList 
  23621.     menu: #chMenu 
  23622.     initialSelection: nil 
  23623.     useIndex: true. 
  23624.     myWrapper := self wrap: (LookPreferences edgeDecorator on: 
  23625.     channelView). 
  23626.     (container add: myWrapper borderedIn: (0.54 @ 0.46 extent: 0.44 @ 
  23627.     0.15)) 
  23628.     insideColor: partColor. 
  23629.     self labelWrap: (container add: ' Communication Channels:' asText 
  23630.     allBold asComposedText borderedIn: (0.54 @ 0.42 extent: 0.44 @ 
  23631.     0.04))."
  23632.     sfHeadView := SelectionInListView
  23633.                 on: aTTMListModel
  23634.                 printItems: false
  23635.                 oneItem: false
  23636.                 aspect: #sfTransaction
  23637.                 change: #sfSelection:
  23638.                 list: #sfList
  23639.                 menu: #sfMenu
  23640.                 initialSelection: nil
  23641.                 useIndex: true.
  23642.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfHeadView).
  23643.     (container add: myWrapper borderedIn: (0.02 @ 0.66 extent: 0.28 @ 0.15))
  23644.         insideColor: partColor.
  23645.     self labelWrap: (container add: ' SFs:' asText allBold asComposedText borderedIn: (0.02 @ 0.62 extent: 0.28 @ 0.04)).
  23646.     sfView := TextView
  23647.                 on: aTTMListModel
  23648.                 aspect: #curSFList
  23649.                 change: #curSFAccept:
  23650.                 menu: #curSFMenu
  23651.                 initialSelection: nil.
  23652.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfView).
  23653.     (container add: myWrapper borderedIn: (0.32 @ 0.66 extent: 0.66 @ 0.15))
  23654.         insideColor: partColor.
  23655.     self labelWrap: (container add: ' Current SF:' asText allBold asComposedText borderedIn: (0.32 @ 0.62 extent: 0.66 @ 0.04)).
  23656.     window component: container.
  23657.     window open! !
  23658.  
  23659. !TTMList class methodsFor: 'decoration'!
  23660. labelWrap: aLabel 
  23661.     | newLabel |
  23662.     newLabel := aLabel.
  23663.     newLabel insideColor: ColorValue white.
  23664.     newLabel borderColor: ColorValue black.
  23665.     newLabel borderWidth: 1.
  23666.     ^newLabel! !
  23667.  
  23668. !TTMList class methodsFor: 'decoration'!
  23669. wrap: aWrapper 
  23670.     | newWrapper |
  23671.     newWrapper := aWrapper.
  23672.     newWrapper noMenuBar.
  23673.     ^newWrapper
  23674. "newWrapper borderColor: ColorValue black. 
  23675.     
  23676.     newWrapper borderWidth: 1."
  23677.     "newWrapper insideColor: ColorValue white."! !
  23678.  
  23679. !TTMList class methodsFor: 'dialog windows'!
  23680. buildBlanksCheckListFor: prompt with: choices 
  23681.     "How does this work, you may ask. Well it creates 
  23682.     
  23683.     a list of the initial values (they are assumed to be 
  23684.     
  23685.     strings) and the user can type over any of them 
  23686.     
  23687.     he/she wants to change. prompt is the header for 
  23688.     
  23689.     the dialogbox. choices is the set of initial values. 
  23690.     
  23691.     Returns an array of same size as choices with the 
  23692.     
  23693.     new values."
  23694.  
  23695.     | theModel theView count modelArray |
  23696.     choices size > 0
  23697.         ifTrue: 
  23698.             [modelArray := Array new: choices size.
  23699.             count := 1.
  23700.             [count > choices size]
  23701.                 whileFalse: 
  23702.                     [modelArray at: count put: ''.
  23703.                     count := count + 1].
  23704.             theModel := ValueHolder with: modelArray.
  23705.             theView := DialogView model: theModel.
  23706.             theView addVerticalSpace: 3; addTextLabel: prompt.
  23707.             count := 1.
  23708.             [count > choices size]
  23709.                 whileFalse: 
  23710.                     [theView addTextFieldOn: ((PluggableAdaptor on: theModel)
  23711.                             collectionIndex: count)
  23712.                         initially: (choices at: count).
  23713.                     count := count + 1].
  23714.             theView open.
  23715.             ^theModel value]
  23716.         ifFalse: [^nil]! !
  23717.  
  23718. !TTMList class methodsFor: 'dialog windows'!
  23719. closeWindow: windowNumber in: currentTTM 
  23720.     "Closes a specific TTM view and marks it as closed."
  23721.  
  23722.     currentTTM openWindows at: windowNumber put: 0.
  23723.     ScheduledControllers activeController close! !
  23724.  
  23725. !TTMList class methodsFor: 'dialog windows'!
  23726. closeWindowAndConfirm
  23727.     "Close the window, but first make sure it 
  23728.     
  23729.     is what the user wants to do."
  23730.  
  23731.     "(DialogView confirm: 'Are you certain you want to quit?')
  23732.         = true ifTrue: ["ScheduledControllers activeController close"]"! !
  23733.  
  23734. !TTMList class methodsFor: 'dialog windows'!
  23735. show: aString 
  23736.     Transcript nextPutAll: aString; cr; endEntry! !
  23737.  
  23738. !TTMList class methodsFor: 'dialog windows'!
  23739. speak: errormsg 
  23740.     "Reports the given error message."
  23741.  
  23742.     | window container left hsize top vsize qButton |
  23743.     errormsg isNil
  23744.         ifFalse: 
  23745.             [Transcript cr.
  23746.             Transcript show: errormsg.
  23747.             Transcript cr.
  23748.             window := ScheduledWindow new.
  23749.             window minimumSize: 300 @ 80.
  23750.             container := CompositePart new.
  23751.             window label: 'error encountered:'.
  23752.             (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  23753.                 insideColor: ColorValue gray.
  23754.             (container add: errormsg asComposedText borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.75))
  23755.                 insideColor: ColorValue white.
  23756.             left := 0.0.
  23757.             hsize := 0.195.
  23758.             top := 0.75.
  23759.             vsize := 0.25.
  23760.             qButton := PushButton named: 'Exit'.
  23761.             qButton model: ((PluggableAdaptor on: window)
  23762.                     getBlock: [:model | false]
  23763.                     putBlock: [:model :value | ScheduledControllers activeController close]
  23764.                     updateBlock: [:model :value :parameter | false]).
  23765.             (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  23766.                 insideColor: ColorValue white.
  23767.             window component: container.
  23768.             window open]! !
  23769.  
  23770. !TTMList class methodsFor: 'strings'!
  23771. aUsefulActLabel: aString 
  23772.     "Return true if aString has proper syntax for an activity."
  23773.  
  23774.     | count |
  23775.     count := 1.
  23776.     aString size < count ifTrue: [^false].
  23777.     [count > aString size]
  23778.         whileFalse: 
  23779.             [(aString at: count) isAlphaNumeric | ((aString at: count)
  23780.                     = $_) ifFalse: [^false].
  23781.             count := count + 1].
  23782.     ^true! !
  23783.  
  23784. !TTMList class methodsFor: 'strings'!
  23785. aUsefulTrLabel: aString 
  23786.     "Return true if aString has proper syntax for a transition."
  23787.  
  23788.     | valid count |
  23789.     valid := false.
  23790.     aString size = 0 ifFalse: [(aString at: 1) isLetter & (aString at: 1) isLowercase
  23791.             ifTrue: 
  23792.                 [valid := true.
  23793.                 count := 1.
  23794.                 aString size
  23795.                     timesRepeat: 
  23796.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  23797.                                 = $_) ifFalse: [valid := false].
  23798.                         count := count + 1]]].
  23799.     valid = false ifTrue: [TTMList speak: 'invalid text string'].
  23800.     ^valid! !
  23801.  
  23802. !TTMList class methodsFor: 'strings'!
  23803. aUsefulTTMName: aString 
  23804.     "Return true if aString has proper syntax for a variable name."
  23805.  
  23806.     | valid count |
  23807.     valid := false.
  23808.     aString size = 0 ifFalse: [(aString at: 1) isLetter
  23809.             ifTrue: 
  23810.                 [valid := true.
  23811.                 count := 1.
  23812.                 aString size
  23813.                     timesRepeat: 
  23814.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  23815.                                 = $_) ifFalse: [valid := false].
  23816.                         count := count + 1]]].
  23817.     ^valid! !
  23818.  
  23819. !TTMList class methodsFor: 'strings'!
  23820. collectTokensFrom: aString usingParser: aParser 
  23821.     | x t r |
  23822.     r := OrderedCollection new.
  23823.     x := aParser.
  23824.     x initScannerSource: aString.
  23825.     [(t := x nextTokenValue) ~= x endOfInputToken]
  23826.         whileTrue: 
  23827.             [r add: t.
  23828.             x scanner scanToken].
  23829.     ^r! !
  23830.  
  23831. !TTMList class methodsFor: 'strings'!
  23832. elementsFromLine: line 
  23833.     "divides given line at space characters"
  23834.  
  23835.     | parts count part |
  23836.     parts := OrderedCollection new.
  23837.     count := 1.
  23838.     part := ''.
  23839.     [count > line size]
  23840.         whileFalse: 
  23841.             [(line at: count)
  23842.                 = Character space
  23843.                 ifTrue: 
  23844.                     [parts add: part.
  23845.                     part := '']
  23846.                 ifFalse: [part := part , (String with: (line at: count))].
  23847.             count := count + 1].
  23848.     parts ~= '' ifTrue: [parts add: part].
  23849.     ^parts! !
  23850.  
  23851. !TTMList class methodsFor: 'strings'!
  23852. inString: aString replace: sub with: newSub 
  23853.     | result ind1 ind2 s1   |
  23854.     result := ''.
  23855.     s1 := aString size.
  23856.     s1 == 0 ifTrue: [^result].
  23857.     newSub size.
  23858.     ind1 := 1.
  23859.     [ind1 <= s1]
  23860.         whileTrue: 
  23861.             [ind2 := aString indexOfSubCollection: sub startingAt: ind1.
  23862.             ind2 > 0
  23863.                 ifTrue: 
  23864.                     [ind1 == ind2
  23865.                         ifTrue: [result := result , newSub]
  23866.                         ifFalse: [result := result , (aString copyFrom: ind1 to: ind2 - 1) , newSub].
  23867.                     ind1 := ind2 + sub size]
  23868.                 ifFalse: 
  23869.                     [result := result , (aString copyFrom: ind1 to: s1).
  23870.                     ind1 := s1 + 1]].
  23871.     ^result! !
  23872.  
  23873. !TTMList class methodsFor: 'strings'!
  23874. makeStringFromCollection: x 
  23875.     | result |
  23876.     result := ''.
  23877.     x do: [:y | result := result , y].
  23878.     ^result! !
  23879.  
  23880. !TTMList class methodsFor: 'strings'!
  23881. removeAllBlanksFrom: aString 
  23882.     "removes all the separator characters"
  23883.  
  23884.     | count newString c |
  23885.     count := 1.
  23886.     newString := ''.
  23887.     [count > aString size]
  23888.         whileFalse: 
  23889.             [c := aString at: count.
  23890.             c isSeparator ifFalse: [newString := newString , (String with: c)].
  23891.             count := count + 1].
  23892.     ^newString! !
  23893.  
  23894. !TTMList class methodsFor: 'strings'!
  23895. replace: aString instance: oldName to: newName 
  23896.     "replaces a substring within a string"
  23897.  
  23898.     | ic location startPosition continue |
  23899.     ic := aString copy.
  23900.     startPosition := 1.
  23901.     location := ic findString: oldName startingAt: startPosition.
  23902.     [location ~= 0]
  23903.         whileTrue: 
  23904.             [location = 1
  23905.                 ifTrue: [continue := true]
  23906.                 ifFalse: [continue := ((ic at: location - 1) isAlphaNumeric | ((ic at: location - 1)
  23907.                                     = $_)) not].
  23908.             continue ifTrue: [location = ic size ifFalse: [continue := ((ic at: location + oldName size) isAlphaNumeric | ((ic at: location + oldName size)
  23909.                                     = $_)) not]].
  23910.             continue
  23911.                 ifTrue: 
  23912.                     [ic := ic
  23913.                                 changeFrom: location
  23914.                                 to: location + oldName size - 1
  23915.                                 with: newName.
  23916.                     startPosition := location + newName size - 1]
  23917.                 ifFalse: [startPosition := location + oldName size].
  23918.             location := ic findString: oldName startingAt: startPosition].
  23919.     ^ic! !
  23920.  
  23921. !TTMList class methodsFor: 'strings'!
  23922. replaceString: old with: new in: collection 
  23923.     | t |
  23924.     t := OrderedCollection new.
  23925.     collection do: [:x | x = old
  23926.             ifTrue: [t add: new]
  23927.             ifFalse: [t add: x]].
  23928.     ^t! !
  23929.  
  23930. !TTMList class methodsFor: 'temporary - tgen'!
  23931. installTgen
  23932.     | sourceDir |
  23933.     sourceDir := '/tmp/T-gen/'.
  23934.     #('graphn.st' 'comppars.st' 'compscan.st' 'parstree.st' 'scanpars.st' 'changes.st' ) do: [:file | (sourceDir , file) asFilename fileIn]! !
  23935.  
  23936. !TTMList class methodsFor: 'temporary - tgen'!
  23937. installTgen1
  23938.     #('graphn.st' 'comppars.st' 'compscan.st' 'parstree.st' 'scanpars.st' 'changes.st' ) do: [:file | file asFilename fileIn]! !
  23939.  
  23940. !TTMList class methodsFor: 'currentDirectory'!
  23941. currentDirectory
  23942.     ^currentDirectory! !
  23943.  
  23944. !TTMList class methodsFor: 'currentDirectory'!
  23945. currentDirectory: aString 
  23946.     currentDirectory := aString! !
  23947.  
  23948. Model subclass: #EditingWindow
  23949.     instanceVariableNames: 'currentTTM currentList currentActivity editingView pending sourceNode destinationNode chosenTTM displayedActs exposedActs temporary duplicateOption ttmList '
  23950.     classVariableNames: ''
  23951.     poolDictionaries: ''
  23952.     category: 'Build'!
  23953.  
  23954. !EditingWindow methodsFor: 'initialize-release'!
  23955. initialize: ttm from: list 
  23956.     "initialize instance variables."
  23957.  
  23958.     self ttm: ttm.
  23959.     self mynode: self ttm activitytree getRoot.
  23960.     self mylist: list.
  23961.     self source: nil.
  23962.     self destination: nil.
  23963.     self myview: nil.
  23964.     self waitingFor: nil.
  23965.     displayedActs := OrderedCollection new.
  23966.     exposedActs := OrderedCollection new! !
  23967.  
  23968. !EditingWindow methodsFor: 'testing'!
  23969. visibleAllFor: currentTr 
  23970.  
  23971.      ^(self visibleDestFor: currentTr)
  23972.  
  23973.           & (self visibleSourceFor: currentTr)! !
  23974.  
  23975. !EditingWindow methodsFor: 'testing'!
  23976. visibleDestFor: currentTr 
  23977.  
  23978.      | end |
  23979.  
  23980.      end := currentTr endingAt.
  23981.  
  23982.      ^self displayedActs includes: end! !
  23983.  
  23984. !EditingWindow methodsFor: 'testing'!
  23985. visibleSourceFor: currentTr 
  23986.  
  23987.      | start |
  23988.  
  23989.      start := currentTr startingAt.
  23990.  
  23991.      ^self displayedActs includes: start! !
  23992.  
  23993. !EditingWindow methodsFor: 'updating'!
  23994. oldupdateDisplayedActs
  23995.  
  23996.      "DisplayedActs are those activities currently 
  23997.  
  23998.      displayed in the editing view."
  23999.  
  24000.  
  24001.  
  24002.      | child grandchild notdone |
  24003.  
  24004.      displayedActs := OrderedCollection new.
  24005.  
  24006.      child := self mynode left.
  24007.  
  24008.      child notNil ifTrue: [child myBox notNil
  24009.  
  24010.                ifTrue: [notdone := 1]
  24011.  
  24012.                ifFalse: [notdone := 0]].
  24013.  
  24014.      [child notNil & (notdone = 1)]
  24015.  
  24016.           whileTrue: 
  24017.  
  24018.                [displayedActs add: child.
  24019.  
  24020.                child myBox depth = #hidden
  24021.  
  24022.                     ifFalse: 
  24023.  
  24024.                          [grandchild := child left.
  24025.  
  24026.                          [grandchild notNil]
  24027.  
  24028.                               whileTrue: 
  24029.  
  24030.                                    [displayedActs add:
  24031.  
  24032. grandchild.
  24033.  
  24034.                                    grandchild := grandchild
  24035.  
  24036. right]].
  24037.  
  24038.                child := child right.
  24039.  
  24040.                child notNil ifTrue: [child myBox notNil ifFalse:
  24041.  
  24042. [notdone := 0]]]! !
  24043.  
  24044. !EditingWindow methodsFor: 'updating'!
  24045. oldupdateDisplayedTrs
  24046.     "Updates the start, end, and 
  24047.     
  24048.     mid points, and arc styles for the arcs of 
  24049.     
  24050.     the transitions currently displayed."
  24051.  
  24052.     | count trList currentTr m s e start end points askTTM mate box1 box2 |
  24053.     count := 1.
  24054.     trList := self ttm transitionlist.
  24055.     [count > trList size]
  24056.         whileFalse: 
  24057.             [currentTr := trList at: count.
  24058.             m := currentTr myArc sourceMid copy.
  24059.             s := currentTr myArc sourceStart copy.
  24060.             e := currentTr myArc sourceEnd copy.
  24061.             start := currentTr startingAt.
  24062.             end := currentTr endingAt.
  24063.             askTTM := self ttm activitytree.
  24064.             (self visibleSourceFor: currentTr)
  24065.                 ifTrue: [(self visibleDestFor: currentTr)
  24066.                         ifTrue: 
  24067.                             [currentTr myArc sourceStart: s.
  24068.                             currentTr myArc destStart: s.
  24069.                             currentTr myArc sourceMid: m.
  24070.                             currentTr myArc destMid: m.
  24071.                             currentTr myArc sourceEnd: e.
  24072.                             currentTr myArc destEnd: e.
  24073.                             currentTr myArc sourceArrow: 5.
  24074.                             currentTr myArc destArrow: 5]
  24075.                         ifFalse: [(askTTM is: start above: end)
  24076.                                 ifTrue: 
  24077.                                     [mate := askTTM ancestorOf: end onLevelOf: start.
  24078.                                     mate notNil
  24079.                                         ifTrue: 
  24080.                                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  24081.                                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  24082.                                             points := self myview boxPoints: box1 to: box2.
  24083.                                             s := points at: 1.
  24084.                                             e := points at: 2.
  24085.                                             m := s x + e x / 2 @ (s y + e y / 2).
  24086.                                             currentTr myArc sourceStart: s.
  24087.                                             currentTr myArc sourceMid: m.
  24088.                                             currentTr myArc sourceEnd: e.
  24089.                                             currentTr myArc sourceArrow: 2]]
  24090.                                 ifFalse: 
  24091.                                     [mate := askTTM ancestorOf: start onLevelOf: end.
  24092.                                     mate notNil
  24093.                                         ifTrue: 
  24094.                                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  24095.                                             box2 := end myBox dimensions copy moveBy: end myBox location.
  24096.                                             points := self myview boxPoints: box1 to: box2.
  24097.                                             m := points at: 2.
  24098.                                             e := self myview borderPointFrom: s through: m.
  24099.                                             currentTr myArc sourceStart: s.
  24100.                                             currentTr myArc sourceMid: m.
  24101.                                             currentTr myArc sourceEnd: e.
  24102.                                             currentTr myArc sourceArrow: 2]]]]
  24103.                 ifFalse: [(self visibleDestFor: currentTr)
  24104.                         ifTrue: [(askTTM is: start above: end)
  24105.                                 ifTrue: 
  24106.                                     [mate := askTTM ancestorOf: end onLevelOf: start.
  24107.                                     mate notNil
  24108.                                         ifTrue: 
  24109.                                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  24110.                                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  24111.                                             points := self myview boxPoints: box1 to: box2.
  24112.                                             m := points at: 1.
  24113.                                             s := self myview borderPointFrom: e through: m.
  24114.                                             currentTr myArc destStart: s.
  24115.                                             currentTr myArc destMid: m.
  24116.                                             currentTr myArc destEnd: e.
  24117.                                             currentTr myArc destArrow: 5]]
  24118.                                 ifFalse: 
  24119.                                     [mate := askTTM ancestorOf: start onLevelOf: end.
  24120.                                     mate notNil
  24121.                                         ifTrue: 
  24122.                                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  24123.                                             box2 := end myBox dimensions copy moveBy: end myBox location.
  24124.                                             points := self myview boxPoints: box1 to: box2.
  24125.                                             s := points at: 1.
  24126.                                             e := points at: 2.
  24127.                                             m := s x + e x / 2 @ (s y + e y / 2).
  24128.                                             currentTr myArc destStart: s.
  24129.                                             currentTr myArc destMid: m.
  24130.                                             currentTr myArc destEnd: e.
  24131.                                             currentTr myArc destArrow: 4]]]
  24132.                         ifFalse: []].
  24133.             count := count + 1]! !
  24134.  
  24135. !EditingWindow methodsFor: 'updating'!
  24136. readjustPointsFor: currentTr 
  24137.     "This is generally done after the transition has just 
  24138.     
  24139.     been added to the list. In case the source and dest 
  24140.     
  24141.     are not on the same level, we have to set things 
  24142.     
  24143.     right."
  24144.  
  24145.     | m s e start end askTTM mate box1 box2 points news newe newm |
  24146.     m := currentTr myArc sourceMid copy.
  24147.     s := currentTr myArc sourceStart copy.
  24148.     e := currentTr myArc sourceEnd copy.
  24149.     start := currentTr startingAt.
  24150.     end := currentTr endingAt.
  24151.     askTTM := self ttm activitytree.
  24152.     (self visibleAllFor: currentTr)
  24153.         ifTrue: 
  24154.             [currentTr myArc sourceStart: s.
  24155.             currentTr myArc destStart: s.
  24156.             currentTr myArc sourceMid: m.
  24157.             currentTr myArc destMid: m.
  24158.             currentTr myArc sourceEnd: e.
  24159.             currentTr myArc destEnd: e.
  24160.             currentTr myArc sourceArrow: 5.
  24161.             currentTr myArc destArrow: 5]
  24162.         ifFalse: [(askTTM is: start above: end)
  24163.                 ifTrue: 
  24164.                     [mate := askTTM ancestorOf: end onLevelOf: start.
  24165.                     mate notNil
  24166.                         ifTrue: 
  24167.                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  24168.                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  24169.                             points := self myview boxPoints: box1 to: box2.
  24170.                             news := points at: 1.
  24171.                             newe := points at: 2.
  24172.                             newm := self myview midPointOf: news and: newe.
  24173.                             currentTr myArc sourceStart: news.
  24174.                             currentTr myArc sourceMid: newm.
  24175.                             currentTr myArc sourceEnd: newe.
  24176.                             currentTr myArc sourceArrow: 2.
  24177.                             points := self myview boxPoints: box1 to: box2.
  24178.                             newm := points at: 1.
  24179.                             newe := e.
  24180.                             news := self myview borderPointFrom: newe through: newm.
  24181.                             currentTr myArc destStart: news.
  24182.                             currentTr myArc destMid: newm.
  24183.                             currentTr myArc destEnd: newe.
  24184.                             currentTr myArc destArrow: 5]
  24185.                         ifFalse: []]
  24186.                 ifFalse: 
  24187.                     [mate := askTTM ancestorOf: start onLevelOf: end.
  24188.                     mate notNil
  24189.                         ifTrue: 
  24190.                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  24191.                             box2 := end myBox dimensions copy moveBy: end myBox location.
  24192.                             points := self myview boxPoints: box1 to: box2.
  24193.                             newm := points at: 2.
  24194.                             news := s.
  24195.                             newe := self myview borderPointFrom: news through: newm.
  24196.                             currentTr myArc sourceStart: news.
  24197.                             currentTr myArc sourceMid: newm.
  24198.                             currentTr myArc sourceEnd: newe.
  24199.                             currentTr myArc sourceArrow: 2.
  24200.                             news := points at: 1.
  24201.                             newe := points at: 2.
  24202.                             newm := self myview midPointOf: news and: newe.
  24203.                             currentTr myArc destStart: news.
  24204.                             currentTr myArc destMid: newm.
  24205.                             currentTr myArc destEnd: newe.
  24206.                             currentTr myArc destArrow: 4]
  24207.                         ifFalse: []]]! !
  24208.  
  24209. !EditingWindow methodsFor: 'updating'!
  24210. updateDisplayedActs
  24211.  
  24212.      "DisplayedActs are those activities currently 
  24213.  
  24214.      displayed in the editing view."
  24215.  
  24216.  
  24217.  
  24218.      | child |
  24219.  
  24220.      displayedActs := OrderedCollection new.
  24221.  
  24222.      child := self mynode left.
  24223.  
  24224.      [child notNil]
  24225.  
  24226.           whileTrue: 
  24227.  
  24228.                [displayedActs add: child.
  24229.  
  24230.                child := child right]! !
  24231.  
  24232. !EditingWindow methodsFor: 'accessing'!
  24233. destination
  24234.  
  24235.      ^destinationNode! !
  24236.  
  24237. !EditingWindow methodsFor: 'accessing'!
  24238. destination: newDestination 
  24239.  
  24240.      destinationNode := newDestination! !
  24241.  
  24242. !EditingWindow methodsFor: 'accessing'!
  24243. displayedActs
  24244.  
  24245.      ^displayedActs! !
  24246.  
  24247. !EditingWindow methodsFor: 'accessing'!
  24248. duplicateOption
  24249.  
  24250.      ^duplicateOption! !
  24251.  
  24252. !EditingWindow methodsFor: 'accessing'!
  24253. duplicateOption: newOption
  24254.  
  24255.      duplicateOption := newOption! !
  24256.  
  24257. !EditingWindow methodsFor: 'accessing'!
  24258. exposedActs
  24259.  
  24260.      ^exposedActs! !
  24261.  
  24262. !EditingWindow methodsFor: 'accessing'!
  24263. mylist
  24264.  
  24265.      ^currentList! !
  24266.  
  24267. !EditingWindow methodsFor: 'accessing'!
  24268. mylist: newList 
  24269.  
  24270.      currentList := newList! !
  24271.  
  24272. !EditingWindow methodsFor: 'accessing'!
  24273. mynode
  24274.  
  24275.      ^currentActivity! !
  24276.  
  24277. !EditingWindow methodsFor: 'accessing'!
  24278. mynode: newActivity
  24279.  
  24280.      currentActivity := newActivity! !
  24281.  
  24282. !EditingWindow methodsFor: 'accessing'!
  24283. myview
  24284.  
  24285.      ^editingView! !
  24286.  
  24287. !EditingWindow methodsFor: 'accessing'!
  24288. myview: theView 
  24289.  
  24290.      editingView := theView! !
  24291.  
  24292. !EditingWindow methodsFor: 'accessing'!
  24293. source
  24294.  
  24295.      ^sourceNode! !
  24296.  
  24297. !EditingWindow methodsFor: 'accessing'!
  24298. source: newSource
  24299.  
  24300.      sourceNode := newSource! !
  24301.  
  24302. !EditingWindow methodsFor: 'accessing'!
  24303. ttm
  24304.  
  24305.      ^currentTTM! !
  24306.  
  24307. !EditingWindow methodsFor: 'accessing'!
  24308. ttm: newTTM
  24309.  
  24310.      currentTTM := newTTM! !
  24311.  
  24312. !EditingWindow methodsFor: 'accessing'!
  24313. ttmChosen
  24314.  
  24315.      ^chosenTTM! !
  24316.  
  24317. !EditingWindow methodsFor: 'accessing'!
  24318. ttmChosen: newChoice 
  24319.  
  24320.      chosenTTM := newChoice! !
  24321.  
  24322. !EditingWindow methodsFor: 'accessing'!
  24323. waitingFor
  24324.  
  24325.      ^pending! !
  24326.  
  24327. !EditingWindow methodsFor: 'accessing'!
  24328. waitingFor: newReason 
  24329.  
  24330.      pending := newReason! !
  24331.  
  24332. !EditingWindow methodsFor: 'button access'!
  24333. doCancel
  24334.     self source: nil.
  24335.     self destination: nil.
  24336.     self waitingFor: nil.
  24337.     self myview pending! !
  24338.  
  24339. !EditingWindow methodsFor: 'button access'!
  24340. doChangeDepth: depthType for: objectType 
  24341.     | children count current trs c |
  24342.     objectType = #act
  24343.         ifTrue: 
  24344.             ["TTMList speak: 'This feature is not yet implemented.', (String 
  24345.             with: 
  24346.             
  24347.             Character cr), 'Sorry for the inconvenience.'."
  24348.             children := self ttm activitytree listChildrenOf: self mynode.
  24349.             children removeFirst.
  24350.             count := 1.
  24351.             [count > children size]
  24352.                 whileFalse: 
  24353.                     [(children at: count) myBox depth: depthType.
  24354.                     count := count + 1].
  24355.             self myview displayOn: #dummy].
  24356.     objectType = #tr
  24357.         ifTrue: 
  24358.             [children := self ttm activitytree listChildrenOf: self mynode.
  24359.             children removeFirst.
  24360.             count := 1.
  24361.             [count > children size]
  24362.                 whileFalse: 
  24363.                     [current := children at: count.
  24364.                     trs := self ttm transitionlist TransitionsStartingAt: current.
  24365.                     c := 1.
  24366.                     [c > trs size]
  24367.                         whileFalse: 
  24368.                             [(trs at: c)
  24369.                                 depth: depthType.
  24370.                             c := c + 1].
  24371.                     trs := self ttm transitionlist TransitionsEndingAt: current.
  24372.                     c := 1.
  24373.                     [c > trs size]
  24374.                         whileFalse: 
  24375.                             [(trs at: c)
  24376.                                 depth: depthType.
  24377.                             c := c + 1].
  24378.                     count := count + 1].
  24379.             self myview displayOn: #dummy]! !
  24380.  
  24381. !EditingWindow methodsFor: 'button access'!
  24382. doCompose
  24383.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize temporary2 top2 labels2 |
  24384.     labels := self mylist ttmList.
  24385.     labels remove: self ttm named ifAbsent: [].
  24386.     self waitingFor = nil & (labels size > 0)
  24387.         ifTrue: 
  24388.             [prompt := 'Compose TTMs'.
  24389.             window := ScheduledWindow
  24390.                         model: nil
  24391.                         label: prompt
  24392.                         minimumSize: 300 @ 250.
  24393.             top := DialogView new.
  24394.             top2 := DialogView new.
  24395.             container := CompositePart new.
  24396.             temporary := OrderedCollection new.
  24397.             temporary add: nil; add: (Array with: nil with: nil).
  24398.             labels2 := Array with: 'duplicate variables shared' "with: 'duplicate transitions shared' ".
  24399.             topCorner := 0.1.
  24400.             hsize := 0.2.
  24401.             vsize := 0.15.
  24402.             okButton := PushButton named: 'accept'.
  24403.             okButton model: ((PluggableAdaptor on: self)
  24404.                     getBlock: [:model | false]
  24405.                     putBlock: [:model :value | model doRunCompose]
  24406.                     updateBlock: [:model :value :parameter | false]).
  24407.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  24408.                 borderColor: ColorValue black;
  24409.                 borderWidth: 1.
  24410.             notokButton := PushButton named: 'exit'.
  24411.             notokButton model: ((PluggableAdaptor on: self)
  24412.                     getBlock: [:model | false]
  24413.                     putBlock: [:model :value | ScheduledControllers activeController close]
  24414.                     updateBlock: [:model :value :parameter | false]).
  24415.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  24416.                 borderColor: ColorValue black;
  24417.                 borderWidth: 1.
  24418.             temporary at: 2 put: ((1 to: labels2 size)
  24419.                     collect: [:i | ValueHolder newBoolean]).
  24420.             top2 leftIndent: 70; rightIndent: 300; yPosition: 70;
  24421.                 addColumn: (1 to: (temporary at: 2) size)
  24422.                 fromX: 0
  24423.                 toX: 1
  24424.                 collect: 
  24425.                     [:i | 
  24426.                     | view |
  24427.                     view := LabeledBooleanView model: ((temporary at: 2)
  24428.                                     at: i).
  24429.                     view beRadioButton.
  24430.                     view controller beToggle.
  24431.                     view label: (labels2 at: i).
  24432.                     BorderedWrapper on: view].
  24433.             container add: top2.
  24434.             temporary2 := (1 to: labels size)
  24435.                         collect: [:i | ValueHolder newBoolean].
  24436.             temporary at: 1 put: (ValueHolder with: 1).
  24437.             top leftIndent: 70; rightIndent: 300; yPosition: 120;
  24438.                 addColumn: (1 to: temporary2 size)
  24439.                 fromX: 0
  24440.                 toX: 1
  24441.                 collect: 
  24442.                     [:i | 
  24443.                     | view |
  24444.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 1))
  24445.                                     selectValue: i).
  24446.                     view beSwitch.
  24447.                     view controller beToggle.
  24448.                     view label: (labels at: i).
  24449.                     BorderedWrapper on: view].
  24450.             container add: top.
  24451.             bigSize := top preferredBounds extent copy.
  24452.             bigSize y: bigSize y + 20.
  24453.             window component: container.
  24454.             window openWithExtent: bigSize]! !
  24455.  
  24456. !EditingWindow methodsFor: 'button access'!
  24457. doHierarchy
  24458.     | current aList ancestors selected chosen count |
  24459.     self waitingFor isNil ifFalse: [self waitingFor = #addTransition | (self waitingFor = #changeDestination) ifFalse: [^self]].
  24460.     current := self mynode.
  24461.     aList := OrderedCollection new.
  24462.     ancestors := 0.
  24463.     [current notNil]
  24464.         whileTrue: 
  24465.             [aList addFirst: current myName.
  24466.             ancestors := ancestors + 1.
  24467.             current := self ttm activitytree parentOf: current].
  24468.     selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  24469.     selected = 0
  24470.         ifFalse: 
  24471.             [chosen := ancestors - selected.
  24472.             chosen = 0
  24473.                 ifFalse: 
  24474.                     [count := 0.
  24475.                     current := self mynode.
  24476.                     [count ~= chosen]
  24477.                         whileTrue: 
  24478.                             [current := self ttm activitytree parentOf: current.
  24479.                             count := count + 1].
  24480.                     self mynode: current.
  24481.                     self myview displayOn: #dummy]]! !
  24482.  
  24483. !EditingWindow methodsFor: 'button access'!
  24484. doInsertTTM
  24485.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize temporary2 top2 labels2 top3 labels3 temporary3 |
  24486.     labels := self mylist ttmList.
  24487.     labels remove: self ttm named ifAbsent: [].
  24488.     self waitingFor = nil & (labels size > 0)
  24489.         ifTrue: 
  24490.             [prompt := 'Insert TTMs'.
  24491.             window := ScheduledWindow
  24492.                         model: nil
  24493.                         label: prompt
  24494.                         minimumSize: 300 @ 300.
  24495.             top := DialogView new.
  24496.             top2 := DialogView new.
  24497.             top3 := DialogView new.
  24498.             container := CompositePart new.
  24499.             temporary := OrderedCollection new.
  24500.             temporary add: nil; add: (Array with: nil with: nil); add: nil.
  24501.             labels2 := Array with: 'duplicate variables shared' "with: 'duplicate transitions shared'".
  24502.             labels3 := Array with: 'insert sequentially' with: 'insert concurrently'.
  24503.             topCorner := 0.1.
  24504.             hsize := 0.2.
  24505.             vsize := 0.15.
  24506.             okButton := PushButton named: 'accept'.
  24507.             okButton model: ((PluggableAdaptor on: self)
  24508.                     getBlock: [:model | false]
  24509.                     putBlock: [:model :value | model doRunInsertTTM]
  24510.                     updateBlock: [:model :value :parameter | false]).
  24511.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  24512.                 borderColor: ColorValue black;
  24513.                 borderWidth: 1.
  24514.             notokButton := PushButton named: 'exit'.
  24515.             notokButton model: ((PluggableAdaptor on: self)
  24516.                     getBlock: [:model | false]
  24517.                     putBlock: [:model :value | ScheduledControllers activeController close]
  24518.                     updateBlock: [:model :value :parameter | false]).
  24519.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  24520.                 borderColor: ColorValue black;
  24521.                 borderWidth: 1.
  24522.             temporary at: 2 put: ((1 to: labels2 size)
  24523.                     collect: [:i | ValueHolder newBoolean]).
  24524.             top2 leftIndent: 70; rightIndent: 300; yPosition: 90;
  24525.                 addColumn: (1 to: (temporary at: 2) size)
  24526.                 fromX: 0
  24527.                 toX: 1
  24528.                 collect: 
  24529.                     [:i | 
  24530.                     | view |
  24531.                     view := LabeledBooleanView model: ((temporary at: 2)
  24532.                                     at: i).
  24533.                     view beRadioButton.
  24534.                     view controller beToggle.
  24535.                     view label: (labels2 at: i).
  24536.                     BorderedWrapper on: view].
  24537.             container add: top2.
  24538.             "temporary3 := (1 to: labels3 size)
  24539.                         collect: [:i | ValueHolder newBoolean].
  24540.             temporary at: 3 put: (ValueHolder with: 1).
  24541.             top3 leftIndent: 70; rightIndent: 300; yPosition: 120;
  24542.                 addColumn: (1 to: temporary3 size)
  24543.                 fromX: 0
  24544.                 toX: 1
  24545.                 collect: 
  24546.                     [:i | 
  24547.                     | view |
  24548.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 3))
  24549.                                     selectValue: i).
  24550.                     view beRadioButton.
  24551.                     view controller beToggle.
  24552.                     view label: (labels3 at: i).
  24553.                     BorderedWrapper on: view].
  24554.             container add: top3."
  24555.             temporary2 := (1 to: labels size)
  24556.                         collect: [:i | ValueHolder newBoolean].
  24557.             temporary at: 1 put: (ValueHolder with: 1).
  24558.             top leftIndent: 70; rightIndent: 300; yPosition: 170;
  24559.                 addColumn: (1 to: temporary2 size)
  24560.                 fromX: 0
  24561.                 toX: 1
  24562.                 collect: 
  24563.                     [:i | 
  24564.                     | view |
  24565.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 1))
  24566.                                     selectValue: i).
  24567.                     view beSwitch.
  24568.                     view controller beToggle.
  24569.                     view label: (labels at: i).
  24570.                     BorderedWrapper on: view].
  24571.             container add: top.
  24572.             bigSize := top preferredBounds extent copy.
  24573.             bigSize y: bigSize y + 20.
  24574.             window component: container.
  24575.             window openWithExtent: bigSize]! !
  24576.  
  24577. !EditingWindow methodsFor: 'button access'!
  24578. doWaitForUser: waitType check: checkType 
  24579.     "checkType = 1 means we cant be waiting for anything already. 
  24580.     checkType = 2 
  24581.     
  24582.     means above and there must be an activity at this level."
  24583.  
  24584.     | valid |
  24585.     valid := false.
  24586.     checkType = 1 ifTrue: [valid := self waitingFor = nil].
  24587.     checkType = 2 ifTrue: [valid := self waitingFor = nil & self mynode left notNil].
  24588.     valid = true
  24589.         ifTrue: 
  24590.             [self waitingFor: waitType.
  24591.             self myview pending]! !
  24592.  
  24593. !EditingWindow methodsFor: 'button access'!
  24594. doZoomout
  24595.     "Zoom out i.e. move up the activity tree."
  24596.  
  24597.     | father |
  24598.     self waitingFor isNil ifFalse: [self waitingFor = #addTransition | (self waitingFor = #changeDestination | (self waitingFor = #addTransition1)) ifFalse: [^nil]].
  24599.     (self ttm activitytree isRoot: currentActivity)
  24600.         ifTrue: []
  24601.         ifFalse: 
  24602.             [father := self ttm activitytree parentOf: currentActivity.
  24603.             father isNil
  24604.                 ifTrue: []
  24605.                 ifFalse: 
  24606.                     [self mynode: father.
  24607.                     self myview notNil ifTrue: [self myview displayOn: #dummy]]]! !
  24608.  
  24609. !EditingWindow methodsFor: 'composition'!
  24610. doRunCompose
  24611.     | count listOfTTMs listOfNames index choice restrict ttmIndex userOption |
  24612.     ttmIndex := (temporary at: 1) value.
  24613.     ttmIndex isNil
  24614.         ifTrue: 
  24615.             [self ttmChosen: nil.
  24616.             ^nil].
  24617.     userOption := OrderedCollection new.
  24618.     ((temporary at: 2)
  24619.         at: 1) value = true
  24620.         ifTrue: [userOption add: #ALL]
  24621.         ifFalse: [userOption add: #NONE].
  24622.     "((temporary at: 2)
  24623.         at: 2) value = true
  24624.         ifTrue: [userOption add: #ALL]
  24625.         ifFalse: [userOption add: #NONE]."
  24626.     self duplicateOption: userOption.
  24627.     listOfTTMs := self mylist realTTMList.
  24628.     listOfNames := self mylist ttmList.
  24629.     listOfNames remove: self ttm named ifAbsent: [].
  24630.     count := 1.
  24631.     [count > listOfTTMs size]
  24632.         whileFalse: 
  24633.             [(listOfNames at: ttmIndex)
  24634.                 = (listOfTTMs at: count) named
  24635.                 ifTrue: 
  24636.                     [choice := listOfTTMs at: count.
  24637.                     count := listOfTTMs size].
  24638.             count := count + 1].
  24639.     (Delay forSeconds: 0.1) wait.
  24640.     choice activitytree listOfActivities do: [:x | x exposedAncestor: nil].    "*************"
  24641.     choice saveNecessarySelfReferences: currentList.
  24642.     self ttmChosen: choice aCopy.
  24643.     choice restoreNecessarySelfReferences: currentList.    "Need to reassess behaviour of following code"
  24644.     "restrict := 1. self mynode collectionType ~= #cluster ifTrue: [index := 1] 
  24645.     ifFalse: 
  24646.     
  24647.     [self mynode left isNil ifTrue: [restrict := 2] ifFalse: [self mynode left right 
  24648.     notNil 
  24649.     
  24650.     ifTrue: [restrict := 2]]. restrict = 2 ifTrue: [index := 2] ifFalse: [index := 1]]."
  24651.     index := 1.
  24652.     index = 1
  24653.         ifTrue: 
  24654.             [self waitingFor: #inConcurrently.
  24655.             self myview pending].
  24656.     index = 2
  24657.         ifTrue: 
  24658.             [self waitingFor: #inSerially.
  24659.             self myview pending]! !
  24660.  
  24661. !EditingWindow methodsFor: 'composition'!
  24662. doRunInsertTTM
  24663.     | listOfTTMs index listOfNames count choice restrict ttmIndex userOption insertType |
  24664.     ttmIndex := (temporary at: 1) value.
  24665.     ttmIndex isNil
  24666.         ifTrue: 
  24667.             [self ttmChosen: nil.
  24668.             ^nil].
  24669.     userOption := OrderedCollection new.
  24670.     ((temporary at: 2)
  24671.         at: 1) value = true
  24672.         ifTrue: [userOption add: #ALL]
  24673.         ifFalse: [userOption add: #NONE].
  24674.       userOption add: #ALL.
  24675.     "((temporary at: 2)
  24676.         at: 2) value = true
  24677.         ifTrue: [userOption add: #ALL]
  24678.         ifFalse: [userOption add: #NONE]."
  24679.     self duplicateOption: userOption.
  24680.     insertType := 1.
  24681.     insertType isNil
  24682.         ifTrue: 
  24683.             [self ttmChosen: nil.
  24684.             ^nil].
  24685.     listOfTTMs := self mylist realTTMList.
  24686.     listOfNames := self mylist ttmList.
  24687.     listOfNames remove: self ttm named ifAbsent: [].
  24688.     count := 1.
  24689.     [count > listOfTTMs size]
  24690.         whileFalse: 
  24691.             [(listOfNames at: ttmIndex)
  24692.                 = (listOfTTMs at: count) named
  24693.                 ifTrue: 
  24694.                     [choice := listOfTTMs at: count.
  24695.                     count := listOfTTMs size].
  24696.             count := count + 1].
  24697.     (Delay forSeconds: 0.1) wait.
  24698.     choice activitytree listOfActivities do: [:x | x exposedAncestor: nil].
  24699.     self ttmChosen: choice aCopy.
  24700.     restrict := 1.
  24701.     self mynode collectionType ~= #cluster
  24702.         ifTrue: [insertType = 1
  24703.                 ifTrue: [index := 3]
  24704.                 ifFalse: [index := 2]]
  24705.         ifFalse: 
  24706.             [self mynode left isNil
  24707.                 ifTrue: [restrict := 2]
  24708.                 ifFalse: [self mynode left right notNil ifTrue: [restrict := 2]].
  24709.             restrict = 2
  24710.                 ifTrue: [insertType = 2
  24711.                         ifTrue: [index := 3]
  24712.                         ifFalse: [index := 1]]
  24713.                 ifFalse: [index := insertType]].
  24714.     index = 2
  24715.         ifTrue: 
  24716.             [self waitingFor: #inConcurrently.
  24717.             self myview pending].
  24718.     index = 1
  24719.         ifTrue: 
  24720.             [self waitingFor: #inSerially.
  24721.             self myview pending].
  24722.     index = 3 ifTrue: [self ttmChosen: nil]! !
  24723.  
  24724. !EditingWindow methodsFor: 'closing'!
  24725. removeDependent: aDependent 
  24726.  
  24727.     currentTTM openWindows at: 2 put: 0.
  24728.  
  24729.     super removeDependent: aDependent! !
  24730.  
  24731. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  24732.  
  24733. EditingWindow class
  24734.     instanceVariableNames: ''!
  24735.  
  24736. !EditingWindow class methodsFor: 'instance creation'!
  24737. new: ttm from: list 
  24738.     "Create a TTMWindow and initialize it."
  24739.  
  24740.     ^super new initialize: ttm from: list! !
  24741.  
  24742. !EditingWindow class methodsFor: 'instance creation'!
  24743. open: currentTTM from: list 
  24744.     "Create a new TTMWindow and open a view on it."
  24745.     "TTMWindow open: currentTTM"
  24746.  
  24747.     self open: (self new: currentTTM from: list)
  24748.         with: currentTTM! !
  24749.  
  24750. !EditingWindow class methodsFor: 'instance creation'!
  24751. open: aTTMWindow with: currentTTM 
  24752.     "Create an instance of a TTM editing window for the 
  24753.     
  24754.     current TTM."
  24755.  
  24756.     | window container zoButton addAButton hButton ttmView inButton windowLabel down up left size heButton buttonColor boardColor hspace vspace ziButton addTButton caButton defButton qButton expAButton expTButton hidAButton hidTButton comButton |
  24757.     up := 0.
  24758.     down := 0.04.
  24759.     left := 0.
  24760.     size := 0.2.
  24761.     hspace := 0.2.
  24762.     vspace := 0.04.
  24763.     window := ScheduledWindow new.
  24764.     windowLabel := 'Editing TTM: ' , currentTTM named.
  24765.     window label: windowLabel.
  24766.     window minimumSize: 500 @ 500.
  24767.     window insideColor: ColorValue lightGray.
  24768.     buttonColor := ColorValue white.
  24769.     boardColor := ColorValue lightGray.
  24770.     container := CompositePart new.    "Button for zooming in -- going down the tree"
  24771.     ziButton := PushButton named: 'Zoom In'.
  24772.     ziButton model: ((PluggableAdaptor on: aTTMWindow)
  24773.             getBlock: [:model | false]
  24774.             putBlock: [:model :value | model doWaitForUser: #zoomin check: 2]
  24775.             updateBlock: [:model :value :parameter | false]).
  24776.     (container add: ziButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24777.         insideColor: buttonColor.
  24778.     left := left + hspace.    "Button for add Activity"
  24779.     addAButton := PushButton named: 'Add Activity'.
  24780.     addAButton model: ((PluggableAdaptor on: aTTMWindow)
  24781.             getBlock: [:model | false]
  24782.             putBlock: [:model :value | model doWaitForUser: #addActivity check: 1]
  24783.             updateBlock: [:model :value :parameter | false]).
  24784.     (container add: addAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24785.         insideColor: buttonColor.
  24786.     left := left + hspace.    "Button for add Transition"
  24787.     addTButton := PushButton named: 'Add Transition'.
  24788.     addTButton model: ((PluggableAdaptor on: aTTMWindow)
  24789.             getBlock: [:model | false]
  24790.             putBlock: [:model :value | model doWaitForUser: #addTransition1 check: 1]
  24791.             updateBlock: [:model :value :parameter | false]).
  24792.     (container add: addTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24793.         insideColor: buttonColor.
  24794.     left := left + hspace.    "Button for insert a TTM as an Activity"
  24795.     inButton := PushButton named: 'XOR TTMs'.
  24796.     inButton model: ((PluggableAdaptor on: aTTMWindow)
  24797.             getBlock: [:model | false]
  24798.             putBlock: [:model :value | model doInsertTTM]
  24799.             updateBlock: [:model :value :parameter | false]).
  24800.     (container add: inButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24801.         insideColor: buttonColor.
  24802.     left := left + hspace.    "Button for cancelling selected option"
  24803.     caButton := PushButton named: 'Cancel'.
  24804.     caButton model: ((PluggableAdaptor on: aTTMWindow)
  24805.             getBlock: [:model | false]
  24806.             putBlock: [:model :value | model doCancel]
  24807.             updateBlock: [:model :value :parameter | false]).
  24808.     (container add: caButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24809.         insideColor: buttonColor.
  24810.     left := 0.
  24811.     up := up + vspace.
  24812.     down := down + vspace.    "Button for zooming out -- going up the tree"
  24813.     zoButton := PushButton named: 'Zoom Out'.
  24814.     zoButton model: ((PluggableAdaptor on: aTTMWindow)
  24815.             getBlock: [:model | false]
  24816.             putBlock: [:model :value | model doZoomout]
  24817.             updateBlock: [:model :value :parameter | false]).
  24818.     (container add: zoButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24819.         insideColor: buttonColor.
  24820.     left := left + hspace.    "Button for exposing all activities"
  24821.     expAButton := PushButton named: 'Expose Acts.'.
  24822.     expAButton model: ((PluggableAdaptor on: aTTMWindow)
  24823.             getBlock: [:model | false]
  24824.             putBlock: [:model :value | model doChangeDepth: #exposed for: #act]
  24825.             updateBlock: [:model :value :parameter | false]).
  24826.     (container add: expAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24827.         insideColor: buttonColor.
  24828.     left := left + hspace.    "Button for exposing all Transitions"
  24829.     expTButton := PushButton named: 'Expose Trans.'.
  24830.     expTButton model: ((PluggableAdaptor on: aTTMWindow)
  24831.             getBlock: [:model | false]
  24832.             putBlock: [:model :value | model doChangeDepth: #exposed for: #tr]
  24833.             updateBlock: [:model :value :parameter | false]).
  24834.     (container add: expTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24835.         insideColor: buttonColor.
  24836.     left := left + hspace.    "Button for composing TTMs - a subset of insertion"
  24837.     comButton := PushButton named: 'AND TTMs'.
  24838.     comButton model: ((PluggableAdaptor on: aTTMWindow)
  24839.             getBlock: [:model | false]
  24840.             putBlock: [:model :value | model doCompose]
  24841.             updateBlock: [:model :value :parameter | false]).
  24842.     (container add: comButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24843.         insideColor: buttonColor.
  24844.     left := left + hspace.    "Button for getting help on this editing window stuff"
  24845.     heButton := PushButton named: 'Help' asText allBold.
  24846.     heButton model: ((PluggableAdaptor on: aTTMWindow)
  24847.             getBlock: [:model | false]
  24848.             putBlock: [:model :value | HelpScreens openHelp: 'editing']
  24849.             updateBlock: [:model :value :parameter | false]).
  24850.     (container add: heButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24851.         insideColor: buttonColor.
  24852.     left := 0.
  24853.     up := up + vspace.
  24854.     down := down + vspace.    "Button for showing hierarchy of current TTM"
  24855.     hButton := PushButton named: 'Hierarchy'.
  24856.     hButton model: ((PluggableAdaptor on: aTTMWindow)
  24857.             getBlock: [:model | false]
  24858.             putBlock: [:model :value | model doHierarchy]
  24859.             updateBlock: [:model :value :parameter | false]).
  24860.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24861.         insideColor: buttonColor.
  24862.     left := left + hspace.    "Button for hiding all Activities"
  24863.     hidAButton := PushButton named: 'Hide Acts.'.
  24864.     hidAButton model: ((PluggableAdaptor on: aTTMWindow)
  24865.             getBlock: [:model | false]
  24866.             putBlock: [:model :value | model doChangeDepth: #hidden for: #act]
  24867.             updateBlock: [:model :value :parameter | false]).
  24868.     (container add: hidAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24869.         insideColor: buttonColor.
  24870.     left := left + hspace.    "Button for hiding all Transitions"
  24871.     hidTButton := PushButton named: 'Hide Trans.'.
  24872.     hidTButton model: ((PluggableAdaptor on: aTTMWindow)
  24873.             getBlock: [:model | false]
  24874.             putBlock: [:model :value | model doChangeDepth: #hidden for: #tr]
  24875.             updateBlock: [:model :value :parameter | false]).
  24876.     (container add: hidTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24877.         insideColor: buttonColor.
  24878.     left := left + hspace.    "Button for setting default for this activity"
  24879.     defButton := PushButton named: 'Reset Default'.
  24880.     defButton model: ((PluggableAdaptor on: aTTMWindow)
  24881.             getBlock: [:model | false]
  24882.             putBlock: [:model :value | model doWaitForUser: #setDefault check: 2]
  24883.             updateBlock: [:model :value :parameter | false]).
  24884.     (container add: defButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24885.         insideColor: buttonColor.
  24886.     left := left + hspace.    "Button for quitting"
  24887.     qButton := PushButton named: 'Exit'.
  24888.     qButton model: ((PluggableAdaptor on: aTTMWindow)
  24889.             getBlock: [:model | false]
  24890.             putBlock: [:model :value | TTMList closeWindow: 2 in: currentTTM]
  24891.             updateBlock: [:model :value :parameter | false]).
  24892.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  24893.         insideColor: buttonColor.
  24894.     left := left + hspace.    "Drawing Board for TTM"
  24895.     ttmView := EditingView model: aTTMWindow.
  24896.     ttmView aspect: #currentTTM.
  24897. (ttmView controller) ttmList: aTTMWindow mylist.
  24898.     (ttmView controller) currentTTM: currentTTM.
  24899.     (container add: ttmView borderedIn: (0 @ 0.12 extent: 1.0 @ 0.88))
  24900.         insideColor: boardColor.
  24901.     window component: container.
  24902.     window open! !
  24903.  
  24904. ListView subclass: #AlteredListView
  24905.     instanceVariableNames: ''
  24906.     classVariableNames: ''
  24907.     poolDictionaries: ''
  24908.     category: 'Build'!
  24909.  
  24910. !AlteredListView methodsFor: 'initialize-release'!
  24911. initialize
  24912.     "Altered method of class ListView. 
  24913.     
  24914.     Changed so that it uses the altered version of 
  24915.     
  24916.     TextList below. Used so that display is in 
  24917.     
  24918.     fixed font style and no delimiters used."
  24919.  
  24920.     super initialize.
  24921.     isEmpty := true.
  24922.     list := AlteredTextList onList: Array new.
  24923.     self setToTop.
  24924.     selection := 0! !
  24925.  
  24926. AlteredListView subclass: #AlteredTableView
  24927.     instanceVariableNames: 'itemList partMsg listMsg '
  24928.     classVariableNames: ''
  24929.     poolDictionaries: ''
  24930.     category: 'Build'!
  24931.  
  24932. !AlteredTableView methodsFor: 'initialize-release'!
  24933. on: anObject aspect: m1 list: m2 
  24934.     "Set the instance variables for the receiver."
  24935.  
  24936.     partMsg := m1.
  24937.     listMsg := m2.
  24938.     self noTopDelimiter; noBottomDelimiter.
  24939.     self model: anObject! !
  24940.  
  24941. !AlteredTableView methodsFor: 'list/controller access'!
  24942. changeModelSelection: anInteger 
  24943.  
  24944.      "Called by controller so this method should 
  24945.  
  24946.      not be deleted although it does nothing."! !
  24947.  
  24948. !AlteredTableView methodsFor: 'list/controller access'!
  24949. defaultControllerClass
  24950.     ^"SelectionInListController" Controller! !
  24951.  
  24952. !AlteredTableView methodsFor: 'list/controller access'!
  24953. list: anArray 
  24954.  
  24955.     "Set the receiver's list to be anArray."
  24956.  
  24957.  
  24958.  
  24959.     itemList := anArray.
  24960.  
  24961.     anArray == nil
  24962.  
  24963.         ifTrue: 
  24964.  
  24965.             [isEmpty := true.
  24966.  
  24967.             selection := 0.
  24968.  
  24969.             self listLines: nil.
  24970.  
  24971.             ^self changeModelSelection: 0].
  24972.  
  24973.     isEmpty := false.
  24974.  
  24975.     self listLines: anArray.
  24976.  
  24977.     offset := 6 @ 0.
  24978.  
  24979.     selection := 0! !
  24980.  
  24981. !AlteredTableView methodsFor: 'list/controller access'!
  24982. yellowButtonMenu
  24983.  
  24984.      "Called by the controller, so this method 
  24985.  
  24986.      should not be deleted."
  24987.  
  24988.  
  24989.  
  24990.      ^nil! !
  24991.  
  24992. !AlteredTableView methodsFor: 'updating'!
  24993. update: aSymbol 
  24994.  
  24995.     "If aSymbol is equal to partMst then change the receiver's 
  24996.  
  24997.     list and list selection. 
  24998.  
  24999.     If aSymbol is equal to initialSelectionMsg then only change 
  25000.  
  25001.     the receiver's selection. 
  25002.  
  25003.     If aSymbol is equal to #empty then reset the receiver."
  25004.  
  25005.  
  25006.  
  25007.     self isOpen ifFalse: [^self].
  25008.  
  25009.     aSymbol == partMsg ifTrue: [^self setNewList].
  25010.  
  25011.     aSymbol == nil ifTrue: [^self setNewSelection].
  25012.  
  25013.     aSymbol == #empty ifTrue: [isEmpty
  25014.  
  25015.             ifFalse: 
  25016.  
  25017.                 [self reset.
  25018.  
  25019.                 self invalidate.
  25020.  
  25021.                 self updateControls]]! !
  25022.  
  25023. !AlteredTableView methodsFor: 'model/region access'!
  25024. clippingBox
  25025.  
  25026.     "Answer the rectangle in which the model can be 
  25027.  
  25028.     displayed--this 
  25029.  
  25030.     is the displayBox inset by the height of a line for an 
  25031.  
  25032.     item."
  25033.  
  25034.  
  25035.  
  25036.     | box grid |
  25037.  
  25038.     box := self bounds.
  25039.  
  25040.     grid := self lineGrid.
  25041.  
  25042.     box height: (box height truncateTo: grid).
  25043.  
  25044.     ^box! !
  25045.  
  25046. !AlteredTableView methodsFor: 'model/region access'!
  25047. getList
  25048.  
  25049.      "Answer the list to be displayed."
  25050.  
  25051.  
  25052.  
  25053.      ^model perform: listMsg! !
  25054.  
  25055. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  25056.  
  25057. AlteredTableView class
  25058.     instanceVariableNames: ''!
  25059.  
  25060. !AlteredTableView class methodsFor: 'instance creation'!
  25061. on: anObject aspect: aspectMsg list: listMsg 
  25062.     "This is a reduced version of SelectionInListView. 
  25063.     
  25064.     It uses an index; oneItem, printItem, and initialSelection 
  25065.     
  25066.     are false; and it does not use a menu. Basically, 
  25067.     
  25068.     it is used to display a scrolling array of lines that 
  25069.     
  25070.     can be formatted with regard to style and spacing."
  25071.  
  25072.     ^self new
  25073.         on: anObject
  25074.         aspect: aspectMsg
  25075.         list: listMsg! !
  25076.  
  25077. ControllerWithMenu subclass: #EditingController
  25078.     instanceVariableNames: 'pointedTransition pointedActivity currentTransition oldCursorPt tempResult tempIndent detailDictionary ttmList currentTTM '
  25079.     classVariableNames: ''
  25080.     poolDictionaries: ''
  25081.     category: 'Build'!
  25082.  
  25083. !EditingController methodsFor: 'ac menu options'!
  25084. doAddTransition
  25085.     model waitingFor isNil
  25086.         ifTrue: 
  25087.             [model waitingFor: #addTransition.
  25088.             model source: pointedActivity.
  25089.             view pending]! !
  25090.  
  25091. !EditingController methodsFor: 'ac menu options'!
  25092. doEditActivity
  25093.     model waitingFor isNil
  25094.         ifTrue: 
  25095.             [pointedActivity myBox depth = #hidden
  25096.                 ifTrue: [pointedActivity myBox depth: #exposed]
  25097.                 ifFalse: [pointedActivity myBox depth: #hidden].
  25098.             model updateDisplayedActs.
  25099.             view displayOn: #dummy]! !
  25100.  
  25101. !EditingController methodsFor: 'ac menu options'!
  25102. doMoveActivity
  25103.     model waitingFor isNil
  25104.         ifTrue: 
  25105.             [model source: pointedActivity.
  25106.             model waitingFor: #moveActivity.
  25107.             view pending]! !
  25108.  
  25109. !EditingController methodsFor: 'ac menu options'!
  25110. doRemoveActivity
  25111.     | isDefault parent child |
  25112.     model waitingFor isNil
  25113.         ifTrue: 
  25114.             [child := pointedActivity left.
  25115.             child notNil ifTrue: [model ttm transitionlist removeSubtreeTrsFrom: child].
  25116.             model ttm transitionlist removeMyTransitions: pointedActivity.
  25117.             model ttm transitionlist reassessDefaultsForDeletedActivity: pointedActivity.
  25118.             isDefault := pointedActivity default.
  25119.             parent := model mynode.
  25120.             child notNil ifTrue: [(model ttm activitytree listOnlyChildrenOf: pointedActivity)
  25121.                     do: 
  25122.                         [:x | 
  25123.                         model ttm removeActivityVariableNamed: (x av at: 1).
  25124.                         x selfAV notNil = true ifTrue: [model ttm removeActivityVariableNamed: (x selfAV at: 1)]]].
  25125.             pointedActivity selfAV notNil = true ifTrue: [model ttm removeActivityVariableNamed: (pointedActivity selfAV at: 1)].
  25126.             model ttm activitytree removeActivity: pointedActivity.
  25127.             isDefault = true & parent left notNil ifTrue: [parent left default: true].
  25128.             parent left isNil ifTrue: [parent collectionType: #cluster].    "model ttm checkAllAVsStillUsed."
  25129.             ttmList changed: #avTransaction.
  25130.             ttmList changed: #curSFList.
  25131.             view displayOn: #dummy]! !
  25132.  
  25133. !EditingController methodsFor: 'ac menu options'!
  25134. doRenameActivity
  25135.     | newname hsize old reject |
  25136.     reject := true.
  25137.     model waitingFor isNil & pointedActivity notNil
  25138.         ifTrue: 
  25139.             [old := pointedActivity myName.
  25140.             [reject = false]
  25141.                 whileFalse: 
  25142.                     [newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  25143.                     newname isEmpty ifTrue: [^self].
  25144.                     (TTMList aUsefulActLabel: newname)
  25145.                         ifFalse: [reject := true]
  25146.                         ifTrue: [(model ttm name: newname isChildOfClusterActivity: model mynode)
  25147.                                 ifTrue: 
  25148.                                     [reject := true.
  25149.                                     TTMList speak: 'activity name already in use.']
  25150.                                 ifFalse: [reject := false]]].
  25151.             reject = false
  25152.                 ifTrue: 
  25153.                     [hsize := (newname size * 7.5) ceiling + 5.
  25154.                     hsize + pointedActivity myBox location x < view boundary right
  25155.                         ifTrue: 
  25156.                             [pointedActivity myName: newname.
  25157.                             hsize > pointedActivity myBox dimensions right
  25158.                                 ifTrue: 
  25159.                                     [pointedActivity myBox dimensions right: hsize.
  25160.                                     self reAssessTransitionsAll.
  25161.                                     view displayOn: #dummy]]
  25162.                         ifFalse: [TTMList speak: 'name too large to fit on view']]]! !
  25163.  
  25164. !EditingController methodsFor: 'ac menu options'!
  25165. doRenameActivityNew
  25166.     | newname hsize old reject |
  25167.     reject := true.
  25168.     model waitingFor isNil & pointedActivity notNil
  25169.         ifTrue: 
  25170.             [old := pointedActivity myName.
  25171.             [reject = false]
  25172.                 whileFalse: 
  25173.                     [newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  25174.                     newname isEmpty ifTrue: [^self].
  25175.                     (TTMList aUsefulActLabel: newname)
  25176.                         ifFalse: [reject := true]
  25177.                         ifTrue: [(model ttm name: newname isChildOfClusterActivity: model mynode)
  25178.                                 ifTrue: 
  25179.                                     [reject := true.
  25180.                                     TTMList speak: 'activity name already in use.']
  25181.                                 ifFalse: [reject := false]]].
  25182.             reject = false
  25183.                 ifTrue: 
  25184.                     [hsize := (newname size * 7.5) ceiling + 5.
  25185.                     hsize + pointedActivity myBox location x < view boundary right
  25186.                         ifTrue: 
  25187.                             [pointedActivity myName: newname.
  25188.                             hsize > pointedActivity myBox dimensions right
  25189.                                 ifTrue: 
  25190.                                     [pointedActivity myBox dimensions right: hsize.
  25191.                                     self reAssessTransitionsAll.
  25192.                                     view displayOn: #dummy]]
  25193.                         ifFalse: [TTMList speak: 'name too large to fit on view']]]! !
  25194.  
  25195. !EditingController methodsFor: 'ac menu options'!
  25196. doRenameActivityOld
  25197.     | newname hsize old |
  25198.     model waitingFor isNil & pointedActivity notNil
  25199.         ifTrue: 
  25200.             [old := pointedActivity myName.
  25201.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  25202.             newname isEmpty ifTrue: [^self].
  25203.             (TTMList aUsefulActLabel: newname)
  25204.                 ifTrue: 
  25205.                     [newname := model ttm
  25206.                                 check: newname
  25207.                                 asNewActivityNameFor: model mynode av
  25208.                                 canBe: old.
  25209.                     hsize := (newname size * 7.5) ceiling + 5.
  25210.                     hsize + pointedActivity myBox location x < view boundary right
  25211.                         ifTrue: 
  25212.                             [pointedActivity myName: newname.
  25213.                             hsize > pointedActivity myBox dimensions right
  25214.                                 ifTrue: 
  25215.                                     [pointedActivity myBox dimensions right: hsize.
  25216.                                     self reAssessTransitionsAll.
  25217.                                     view displayOn: #dummy]]
  25218.                         ifFalse: [TTMList speak: 'name too large to fit on view']]
  25219.                 ifFalse: [TTMList speak: 'syntax error in name']]! !
  25220.  
  25221. !EditingController methodsFor: 'ac menu options'!
  25222. doResizeActivity
  25223.     model waitingFor isNil
  25224.         ifTrue: 
  25225.             [model source: pointedActivity.
  25226.             model waitingFor: #resizeActivity.
  25227.             view pending]! !
  25228.  
  25229. !EditingController methodsFor: 'ac menu options'!
  25230. doZoomin
  25231.     model waitingFor isNil
  25232.         ifTrue: 
  25233.             [model mynode: pointedActivity.
  25234.             view displayOn: #dummy]
  25235.         ifFalse: [model waitingFor = #addTransition | (model waitingFor = #changeDestination)
  25236.                 ifTrue: 
  25237.                     [model mynode: pointedActivity.
  25238.                     view displayOn: #dummy]]! !
  25239.  
  25240. !EditingController methodsFor: 'testing'!
  25241. isInActivity: aPoint 
  25242.     "Return activity if the cursor is in one of the 
  25243.     
  25244.     existing activities. Else return nil."
  25245.  
  25246.     | contained child siblingBox current |
  25247.     contained := false.
  25248.     child := model mynode left.
  25249.     current := nil.
  25250.     [child notNil & (contained = false)]
  25251.         whileTrue: 
  25252.             [child myBox notNil
  25253.                 ifTrue: 
  25254.                     [current := child.
  25255.                     siblingBox := child myBox dimensions copy moveBy: child myBox location.
  25256.                     contained := siblingBox containsPoint: aPoint].
  25257.             child := child right].
  25258.     contained
  25259.         ifTrue: [^current]
  25260.         ifFalse: [^nil]! !
  25261.  
  25262. !EditingController methodsFor: 'testing'!
  25263. isInTransition: aPoint 
  25264.     "Return transition if the cursor is in one of the 
  25265.     
  25266.     existing labels. Else return nil."
  25267.  
  25268.     | contained trList currentTr currentLabel trCount m |
  25269.     contained := false.
  25270.     trList := model ttm transitionlist.
  25271.     trCount := 1.
  25272.     [trCount <= trList size & (contained = false)]
  25273.         whileTrue: 
  25274.             [currentTr := trList at: trCount.
  25275.             (model displayedActs includes: (trList at: trCount) startingAt)
  25276.                 | (model displayedActs includes: (trList at: trCount) endingAt)
  25277.                 ifTrue: 
  25278.                     [(model visibleSourceFor: currentTr)
  25279.                         ifTrue: [m := currentTr myArc sourceMid]
  25280.                         ifFalse: [m := currentTr myArc destMid].
  25281.                     currentLabel := currentTr myArc dimensions copy moveBy: m.
  25282.                     contained := currentLabel containsPoint: aPoint].
  25283.             contained = false ifTrue: [trCount := trCount + 1]].
  25284.     contained
  25285.         ifTrue: [^currentTr]
  25286.         ifFalse: [^nil]! !
  25287.  
  25288. !EditingController methodsFor: 'mouse buttons'!
  25289. menu
  25290.     "This is the middle button menu. When the middle 
  25291.     
  25292.     mouse button is clicked, this is called."
  25293.  
  25294.     pointedTransition := self isInTransition: self sensor cursorPoint.
  25295.     pointedTransition isNil ifFalse: [^self menuForTransition]
  25296.         ifTrue: 
  25297.             [pointedActivity := self isInActivity: self sensor cursorPoint.
  25298.             pointedActivity isNil ifFalse: [^self menuForActivity]
  25299.                 ifTrue: [^nil]]! !
  25300.  
  25301. !EditingController methodsFor: 'mouse buttons'!
  25302. menuForActivity
  25303.     | menuValues labelValues1 labelValues2 |
  25304.     menuValues := #(#doZoomin #doMoveActivity #doResizeActivity #doRenameActivity #doEditActivity #doRemoveActivity #doAddTransition ).
  25305.     labelValues1 := #(#(#'zoom in' ) #(#move #resize #rename #expose #remove ) #(#'add tr.' ) ).
  25306.     labelValues2 := #(#(#'zoom in' ) #(#move #resize #rename #hide #remove ) #(#'add tr.' ) ).
  25307.     pointedActivity myBox depth = #hidden
  25308.         ifTrue: [^PopUpMenu labelList: labelValues1 values: menuValues]
  25309.         ifFalse: [^PopUpMenu labelList: labelValues2 values: menuValues]! !
  25310.  
  25311. !EditingController methodsFor: 'mouse buttons'!
  25312. menuForTransition
  25313.     | menuValues labelValues1 labelValues2 |
  25314.     menuValues := #(#doRenameTransition #doLowerTransition #doUpperTransition #doGuardTransition #doFunctionTransition #doEditTransition #doMoveTransition #doChangeTrDestination #doRemoveTransition #doSharedTransition #doDetail ).
  25315.     labelValues1 := #(#(#rename #'lower b.' #'upper b.' #guard #function ) #(#expose #move #'dest.' #remove #shared #detail ) ).
  25316.     labelValues2 := #(#(#rename #'lower b.' #'upper b.' #guard #function ) #(#hide #move #'dest.' #remove #shared #detail ) ).
  25317.     pointedTransition depth = #hidden
  25318.         ifTrue: [^PopUpMenu labelList: labelValues1 values: menuValues]
  25319.         ifFalse: [^PopUpMenu labelList: labelValues2 values: menuValues]! !
  25320.  
  25321. !EditingController methodsFor: 'mouse buttons'!
  25322. redButtonActivity
  25323.     "This is the left mouse button monitor. When it 
  25324.     
  25325.     is clicked this method is activated."
  25326.  
  25327.     | wait |
  25328.     wait := model waitingFor.
  25329.     wait = #addActivity
  25330.         ifTrue: [self performAddActivity]
  25331.         ifFalse: [wait = #addTransition
  25332.                 ifTrue: [self performAddTransition]
  25333.                 ifFalse: [wait = #moveActivity
  25334.                         ifTrue: [self performMoveActivity]
  25335.                         ifFalse: [wait = #moveTransition
  25336.                                 ifTrue: [self performMoveTransition]
  25337.                                 ifFalse: [wait = #resizeActivity
  25338.                                         ifTrue: [self performResizeActivity]
  25339.                                         ifFalse: [wait = #zoomin
  25340.                                                 ifTrue: [self performZoomin]
  25341.                                                 ifFalse: [wait = #addTransition1
  25342.                                                         ifTrue: [self performAddTrSource]
  25343.                                                         ifFalse: [wait = #setDefault
  25344.                                                                 ifTrue: [self performSetDefault]
  25345.                                                                 ifFalse: [wait = #inConcurrently
  25346.                                                                         ifTrue: [self performInsertConcurrently]
  25347.                                                                         ifFalse: [wait = #inSerially
  25348.                                                                                 ifTrue: [self performInsertSerially]
  25349.                                                                                 ifFalse: [wait = #selfloop
  25350.                                                                                         ifTrue: [self performSelfLoop]
  25351.                                                                                         ifFalse: [wait = #changeDestination
  25352.                                                                                                 ifTrue: [self performChangeDest]
  25353.                                                                                                 ifFalse: [wait = #changeselfloop
  25354.                                                                                                         ifTrue: [self performChangeToSelfLoop]
  25355.                                                                                                         ifFalse: []]]]]]]]]]]]]! !
  25356.  
  25357. !EditingController methodsFor: 'tr menu options'!
  25358. compressString: s 
  25359.     | r |
  25360.     r := ''.
  25361.     s do: [:x | x ~= $  ifTrue: [r := r , x asString]].
  25362.     ^r! !
  25363.  
  25364. !EditingController methodsFor: 'tr menu options'!
  25365. doChangeTrDestination
  25366.     model waitingFor isNil
  25367.         ifTrue: 
  25368.             [model waitingFor: #changeDestination.
  25369.             model source: pointedTransition.
  25370.             view pending]! !
  25371.  
  25372. !EditingController methodsFor: 'tr menu options'!
  25373. doDetail
  25374.     model waitingFor isNil ifTrue: [DetailWindow new: pointedTransition from: self]! !
  25375.  
  25376. !EditingController methodsFor: 'tr menu options'!
  25377. doEditTransition
  25378.     model waitingFor isNil
  25379.         ifTrue: 
  25380.             [pointedTransition depth = #hidden
  25381.                 ifTrue: [pointedTransition depth: #exposed]
  25382.                 ifFalse: [pointedTransition depth: #hidden].
  25383.             view displayOn: #dummy]! !
  25384.  
  25385. !EditingController methodsFor: 'tr menu options'!
  25386. doFunctionTransition
  25387.     | oldValue newValue accept ast undefined |
  25388.     accept := false.
  25389.     model waitingFor isNil
  25390.         ifTrue: 
  25391.             [oldValue := pointedTransition myAction.
  25392.             newValue := DialogView request: 'new action for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  25393.             newValue := self compressString: newValue.
  25394.             newValue isEmpty ifTrue: [newValue := 'nil'].
  25395.             newValue = oldValue
  25396.                 ifFalse: 
  25397.                     [newValue asString = 'nil'
  25398.                         ifTrue: [pointedTransition myAction: newValue]
  25399.                         ifFalse: 
  25400.                             [accept := true.
  25401.                             ast := BuildTFParser new parseForAST: newValue
  25402.                                         ifFail: 
  25403.                                             [TTMList speak: newValue , ' : Invalid function for transition'.
  25404.                                             accept := false]].
  25405.                     accept = false ifFalse: [ast rhsVars do: [:x | (model ttm anExistingAV2: x)
  25406.                                 = false & ((model ttm anExistingDV2: x)
  25407.                                     = false)
  25408.                                 ifTrue: 
  25409.                                     [undefined isNil ifTrue: [undefined := ''].
  25410.                                     undefined := undefined , '  ' , x]]].
  25411.                     accept = false | undefined notNil = true
  25412.                         ifTrue: [undefined notNil ifTrue: [TTMList speak: (newValue , ' : Invalid function for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs]]
  25413.                         ifFalse: 
  25414.                             [pointedTransition myAction: newValue.
  25415.                             view displayOn: #dummy]]]! !
  25416.  
  25417. !EditingController methodsFor: 'tr menu options'!
  25418. doFunctionTransitionOld
  25419.     | oldValue newValue accept |
  25420.     accept := false.
  25421.     model waitingFor isNil
  25422.         ifTrue: 
  25423.             [oldValue := pointedTransition myAction.
  25424.             newValue := DialogView request: 'new action for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  25425.             newValue isEmpty ifTrue: [newValue := 'nil'].
  25426.             newValue = oldValue
  25427.                 ifFalse: 
  25428.                     [newValue asString = 'nil'
  25429.                         ifTrue: [accept := true]
  25430.                         ifFalse: [(ParseTree functionSyntaxCheck: newValue from: model ttm)
  25431.                                 ifFalse: [accept := true]].
  25432.                     accept = false
  25433.                         ifTrue: [TTMList speak: 'illegal function for transition']
  25434.                         ifFalse: [pointedTransition myAction: newValue]]]! !
  25435.  
  25436. !EditingController methodsFor: 'tr menu options'!
  25437. doGuardTransition
  25438.     | oldValue newValue accept ast undefined |
  25439.     accept := false.
  25440.     model waitingFor isNil
  25441.         ifTrue: 
  25442.             [oldValue := pointedTransition myGuard.
  25443.             newValue := DialogView request: 'new guard for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  25444.             newValue := self compressString: newValue.
  25445.             newValue isEmpty ifTrue: [newValue := 'nil'].
  25446.             newValue = oldValue
  25447.                 ifFalse: 
  25448.                     [newValue asString = 'nil'
  25449.                         ifTrue: [pointedTransition myGuard: newValue]
  25450.                         ifFalse: 
  25451.                             [accept := true.
  25452.                             ast := BuildBoolParser new parseForAST: newValue
  25453.                                         ifFail: 
  25454.                                             [TTMList speak: newValue , ' : Invalid guard for transition'.
  25455.                                             accept := false]].
  25456.                     accept = false ifFalse: [ast rhsVars do: [:x | (model ttm anExistingAV: x)
  25457.                                 = false & ((model ttm anExistingDV: x)
  25458.                                     = false)
  25459.                                 ifTrue: 
  25460.                                     [undefined isNil ifTrue: [undefined := ''].
  25461.                                     undefined := undefined , '  ' , x]]].
  25462.                     accept = false | undefined notNil = true
  25463.                         ifTrue: [undefined notNil ifTrue: [TTMList speak: (newValue , ' : Invalid guard for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs]]
  25464.                         ifFalse: 
  25465.                             [pointedTransition myGuard: newValue.
  25466.                             view displayOn: #dummy]]]! !
  25467.  
  25468. !EditingController methodsFor: 'tr menu options'!
  25469. doGuardTransitionOld
  25470.     | oldValue newValue accept |
  25471.     accept := false.
  25472.     model waitingFor isNil
  25473.         ifTrue: 
  25474.             [oldValue := pointedTransition myGuard.
  25475.             newValue := DialogView request: 'new guard for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  25476.             newValue isEmpty ifTrue: [newValue := 'nil'].
  25477.             newValue = oldValue
  25478.                 ifFalse: 
  25479.                     [newValue asString = 'nil'
  25480.                         ifTrue: [accept := true]
  25481.                         ifFalse: [(ParseTree guardSyntaxCheck: newValue from: model ttm)
  25482.                                 ifFalse: [accept := true]].
  25483.                     accept = false
  25484.                         ifTrue: [TTMList speak: 'illegal guard for transition']
  25485.                         ifFalse: [pointedTransition myGuard: newValue]]]! !
  25486.  
  25487. !EditingController methodsFor: 'tr menu options'!
  25488. doHideTransition
  25489.     model waitingFor isNil ifTrue: [pointedTransition depth = #hidden
  25490.             ifTrue: [pointedTransition depth: #exposed]
  25491.             ifFalse: [pointedTransition depth: #hidden]]! !
  25492.  
  25493. !EditingController methodsFor: 'tr menu options'!
  25494. doLowerTransition
  25495.     | oldValue newValue |
  25496.     model waitingFor isNil
  25497.         ifTrue: 
  25498.             [oldValue := pointedTransition boundLower.
  25499.             newValue := DialogView request: 'new lower bound?' initialAnswer: oldValue.
  25500.             newValue isEmpty | (newValue = oldValue) ifFalse: [(TTMList aValidNumber: newValue)
  25501.                     & (newValue ~= 'infinity')
  25502.                     ifTrue: 
  25503.                         [pointedTransition boundLower: newValue.
  25504.                         view displayOn: #dummy]
  25505.                     ifFalse: [TTMList speak: 'invalid lower bound']]]! !
  25506.  
  25507. !EditingController methodsFor: 'tr menu options'!
  25508. doMoveTransition
  25509.     model waitingFor isNil
  25510.         ifTrue: 
  25511.             [model source: pointedTransition.
  25512.             model waitingFor: #moveTransition.
  25513.             view pending]! !
  25514.  
  25515. !EditingController methodsFor: 'tr menu options'!
  25516. doRemoveTransition
  25517.     model waitingFor isNil
  25518.         ifTrue: 
  25519.             [model ttm transitionlist remove: pointedTransition.
  25520.             view displayOn: #dummy]! !
  25521.  
  25522. !EditingController methodsFor: 'tr menu options'!
  25523. doRenameTransition
  25524.     | oldName newName hsize ans m |
  25525.     model waitingFor isNil
  25526.         ifTrue: 
  25527.             [oldName := pointedTransition myName.
  25528.             newName := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for transition?' initialAnswer: oldName.
  25529.             newName isEmpty | (oldName = newName)
  25530.                 ifFalse: 
  25531.                     [(model ttm transitionlist TransitionsNamed: newName) size = 0
  25532.                         ifFalse: 
  25533.                             [ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  25534.                             ans = false ifTrue: [^nil]].
  25535.                     hsize := (newName size * 7.5) ceiling + 5.
  25536.                     (model visibleSourceFor: pointedTransition)
  25537.                         ifTrue: [m := pointedTransition myArc sourceMid]
  25538.                         ifFalse: [m := pointedTransition myArc destMid].
  25539.                     hsize + m x < view boundary right
  25540.                         ifTrue: 
  25541.                             [pointedTransition myName: newName.
  25542.                             pointedTransition myArc dimensions right: hsize.
  25543.                             view displayOn: #dummy]
  25544.                         ifFalse: [TTMList speak: 'name to large to fit on view']]]! !
  25545.  
  25546. !EditingController methodsFor: 'tr menu options'!
  25547. doSharedTransition
  25548.     | default |
  25549.     model waitingFor isNil
  25550.         ifTrue: 
  25551.             [default := pointedTransition shared = true.
  25552.             default := DialogView
  25553.                         choose: 'Set  Transition To:'
  25554.                         labels: #('Shared' 'not Shared' )
  25555.                         values: #(true false )
  25556.                         default: default.
  25557.             pointedTransition shared: default.
  25558.             view displayOn: #dummy]! !
  25559.  
  25560. !EditingController methodsFor: 'tr menu options'!
  25561. doUpperTransition
  25562.     | oldValue newValue |
  25563.     model waitingFor isNil
  25564.         ifTrue: 
  25565.             [oldValue := pointedTransition boundUpper.
  25566.             newValue := DialogView request: 'new upper bound?' initialAnswer: oldValue.
  25567.             newValue isEmpty | (newValue = oldValue) ifFalse: [(TTMList aValidNumber: newValue)
  25568.                     ifTrue: 
  25569.                         [pointedTransition boundUpper: newValue.
  25570.                         view displayOn: #dummy]
  25571.                     ifFalse: [TTMList speak: 'invalid upper bound']]]! !
  25572.  
  25573. !EditingController methodsFor: 'DetailWindow access'!
  25574. getSubStructureFor: anActivity 
  25575.     tempResult := OrderedCollection new.
  25576.     self findAV: anActivity withIndent: 1.
  25577.     ^tempResult! !
  25578.  
  25579. !EditingController methodsFor: 'performing'!
  25580. findAV: anActivity 
  25581.     "TTMList show: 'Entering findAV for ',anActivity myName."
  25582.  
  25583.     | anAV def temp |
  25584.     anActivity collectionType = #parallel
  25585.         ifTrue: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25586.                 do: [:act2 | self findAV: act2]]
  25587.         ifFalse: 
  25588.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25589.                 do: [:x | "TTMList show: x myName."
  25590.                     x default ifTrue: ["TTMList show: 'default for ' , anActivity myName 
  25591.                         , ' is ' , 
  25592.                         
  25593.                         def myName"
  25594.                         def := x]].
  25595.             def isNil
  25596.                 ifTrue: ["TTMList show: 'no default for ' , anActivity myName."
  25597.                     ^self]
  25598.                 ifFalse: 
  25599.                     [anAV := def av at: 1.
  25600.                     temp := Array new: 2.
  25601.                     temp at: 1 put: anAV.
  25602.                     temp at: 2 put: def myName.
  25603.                     tempResult add: temp.
  25604.                     def left isNil ifFalse: [self findAV: def]]]! !
  25605.  
  25606. !EditingController methodsFor: 'performing'!
  25607. findAV: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  25608.     tempResult := OrderedCollection new.
  25609.     detailDictionary := aNewDictionary.
  25610.     self
  25611.         findAV: anActivity
  25612.         withIndent: 1
  25613.         withDefault: aDictionary.
  25614.     ^tempResult! !
  25615.  
  25616. !EditingController methodsFor: 'performing'!
  25617. findAV: anActivity withIndent: anInteger 
  25618.     | def temp |
  25619.     "TTMList show: anActivity myName , '   ' , anActivity collectionType asString."
  25620.     (((model ttm activitytree) parentOf: anActivity) collectionType)
  25621.         = #cluster
  25622.         ifTrue: 
  25623.             [temp := Array new: 2.
  25624.             temp at: 1 put: anActivity.
  25625.             temp at: 2 put: anInteger.
  25626.             tempResult add: temp.
  25627.             TTMList show: 'The above line is in tempResult'].
  25628.     anActivity collectionType = #cluster
  25629.         ifTrue: 
  25630.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25631.                 do: [:x | x default ifTrue: [def := x]].
  25632.             def isNil
  25633.                 ifTrue: [^self]
  25634.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]
  25635.         ifFalse: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25636.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]! !
  25637.  
  25638. !EditingController methodsFor: 'performing'!
  25639. findAV: anActivity withIndent: anInteger withDefault: aDictionary 
  25640.     | def temp defAct children ass |
  25641.     (((model ttm activitytree) parentOf: anActivity) collectionType)
  25642.         = #cluster
  25643.         ifTrue: 
  25644.             [temp := Array new: 2.
  25645.     temp at: 1 put: anActivity.
  25646.     temp at: 2 put: anInteger.
  25647.     tempResult add: temp.].
  25648.     children := model ttm activitytree allImmediateChildrenOf: anActivity.
  25649.     anActivity collectionType = #parallel
  25650.         ifTrue: [children do: [:act2 | self
  25651.                     findAV: act2
  25652.                     withIndent: anInteger + 1
  25653.                     withDefault: aDictionary]]
  25654.         ifFalse: [children isEmpty
  25655.                 ifFalse: 
  25656.                     [(defAct := aDictionary at: ((children at: 1) av at: 1)
  25657.                                 ifAbsent: []) isNil
  25658.                         ifTrue: [children do: [:x | x default ifTrue: [def := x]]]
  25659.                         ifFalse: 
  25660.                             [def := defAct.
  25661.                             ass := Association new.
  25662.                             ass key: (def av at: 1)
  25663.                                 value: def.
  25664.                             detailDictionary add: ass].
  25665.                     def isNil
  25666.                         ifTrue: [^nil]
  25667.                         ifFalse: [self
  25668.                                 findAV: def
  25669.                                 withIndent: anInteger + 1
  25670.                                 withDefault: aDictionary]]]! !
  25671.  
  25672. !EditingController methodsFor: 'performing'!
  25673. findAVsafe: anActivity withIndent: anInteger 
  25674.     | def temp |
  25675.     temp := Array new: 2.
  25676.     temp at: 1 put: anActivity.
  25677.     temp at: 2 put: anInteger.
  25678.     tempResult add: temp.
  25679.     TTMList show: anActivity myName.
  25680.     anActivity collectionType = #parallel
  25681.         ifTrue: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25682.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]
  25683.         ifFalse: 
  25684.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  25685.                 do: [:x | x default ifTrue: [def := x]].
  25686.             def isNil
  25687.                 ifTrue: [^self]
  25688.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]! !
  25689.  
  25690. !EditingController methodsFor: 'performing'!
  25691. findAVSource2: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  25692.     tempResult := OrderedCollection new.
  25693.     detailDictionary := aNewDictionary.
  25694.     self
  25695.         findAVSource: anActivity
  25696.         withIndent: 1
  25697.         withDefault: aDictionary.
  25698.     ^tempResult! !
  25699.  
  25700. !EditingController methodsFor: 'performing'!
  25701. findAVSource: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  25702.     tempResult := OrderedCollection new.
  25703.     detailDictionary := aNewDictionary.
  25704.     self
  25705.         findAVSource: anActivity
  25706.         withIndent: 0
  25707.         withDefault: aDictionary.
  25708.     ^tempResult! !
  25709.  
  25710. !EditingController methodsFor: 'performing'!
  25711. findAVSource: anActivity withIndent: anInteger withDefault: aDictionary 
  25712.     | temp defAct children p flag ass |
  25713.     p := model ttm activitytree parentOf: anActivity.
  25714.     p notNil
  25715.         ifTrue: [flag := p collectionType = #cluster]
  25716.         ifFalse: [flag := true].
  25717.     flag = true
  25718.         ifTrue: 
  25719.             [temp := Array new: 2.
  25720.             temp at: 1 put: anActivity.
  25721.             temp at: 2 put: anInteger.
  25722.             tempResult add: temp].
  25723.     anActivity collectionType = #cluster
  25724.         ifTrue: [(defAct := aDictionary at: (anActivity selfAV at: 1)
  25725.                         ifAbsent: [^nil]) isNil
  25726.                 ifFalse: 
  25727.                     [ass := Association new.
  25728.                     ass key: (defAct av at: 1)
  25729.                         value: defAct.
  25730.                     detailDictionary add: ass.
  25731.                     self
  25732.                         findAVSource: defAct
  25733.                         withIndent: anInteger + 1
  25734.                         withDefault: aDictionary]]
  25735.         ifFalse: 
  25736.             [children := model ttm activitytree allImmediateChildrenOf: anActivity.
  25737.             children do: [:act2 | self
  25738.                     findAVSource: act2
  25739.                     withIndent: anInteger + 1
  25740.                     withDefault: aDictionary]]! !
  25741.  
  25742. !EditingController methodsFor: 'performing'!
  25743. getActivityTranformationsFor: anActivity 
  25744.     |  |
  25745.     tempResult := OrderedCollection new.
  25746.     self findAV: anActivity withIndent: 1.
  25747.     ^tempResult! !
  25748.  
  25749. !EditingController methodsFor: 'performing'!
  25750. performAddActivity
  25751.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber typeResponse |
  25752.     reject := false.
  25753.     typeResponse := nil.
  25754.     cursorPosition := self sensor cursorPoint.
  25755.     avList := model ttm typeForAV: model mynode selfAV.
  25756.     avList size = 1
  25757.         ifTrue: [totalNumber := 0]
  25758.         ifFalse: [totalNumber := avList size].
  25759.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode selfAV]
  25760.         whileTrue: [totalNumber := totalNumber + 1].
  25761.     model mynode left isNil
  25762.         ifTrue: 
  25763.             [typeResponse := DialogView
  25764.                         choose: 'Choose type for TTM : ' , model mynode myName
  25765.                         labels: #('XOR' 'AND' )
  25766.                         values: #(true false )
  25767.                         default: true.
  25768.             typeResponse = true
  25769.                 ifTrue: [model mynode collectionType: #cluster]
  25770.                 ifFalse: [model mynode collectionType: #parallel]].
  25771.     aLabel := DialogView
  25772.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  25773.                 initialAnswer: totalNumber printString
  25774.                 onCancel: [^nil].
  25775.     aLabel isNil
  25776.         ifTrue: [reject := true]
  25777.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  25778.                 ifFalse: [reject := true]
  25779.                 ifTrue: [(model ttm name: aLabel isChildOfClusterActivity: model mynode)
  25780.                         ifTrue: 
  25781.                             [reject := true.
  25782.                             TTMList speak: 'activity name already in use.']]].
  25783.     reject = false
  25784.         ifTrue: 
  25785.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  25786.             activityDim isNil
  25787.                 ifFalse: 
  25788.                     [newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  25789.                     oldCursorPt := self sensor cursorPoint.
  25790.                     model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  25791.                         ifTrue: 
  25792.                             [avName := '1'.
  25793.                             [(model ttm aValidVariableName: avName)
  25794.                                 = false | ((model ttm anExistingAV: avName)
  25795.                                     = true) | ((model ttm anExistingDV: avName)
  25796.                                     = true)]
  25797.                                 whileTrue: 
  25798.                                     [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  25799.                                     self sensor cursorPoint: oldCursorPt.
  25800.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  25801.                                     avName isEmpty ifTrue: [avName := '1']].
  25802.                             avType := Array with: avName with: 'True'.
  25803.                             model ttm activityvariable: (avType at: 1)
  25804.                                 initial: (avType at: 2).
  25805.                             model mynode selfAV: avType.
  25806.                             model mynode hasAV: true].
  25807.                     newNode av: model mynode selfAV.
  25808.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  25809.                     model doCancel]]
  25810.         ifFalse: 
  25811.             [TTMList speak: 'illegal activity name given'.
  25812.             model doCancel].
  25813.     model mynode collectionType = #parallel & model mynode selfAV notNil
  25814.         ifTrue: 
  25815.             [model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  25816.             model mynode hasAV: false].
  25817.     ttmList changed: #avTransaction.
  25818.     ttmList changed: #curSFList.
  25819.     view displayOn: #dummy! !
  25820.  
  25821. !EditingController methodsFor: 'performing'!
  25822. performAddActivity1
  25823.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber newAVNeeded |
  25824.     reject := false.
  25825.     cursorPosition := self sensor cursorPoint.
  25826.     avList := model ttm typeForAV: model mynode av.
  25827.     avList size = 1
  25828.         ifTrue: [totalNumber := 0]
  25829.         ifFalse: [totalNumber := avList size].
  25830.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode av]
  25831.         whileTrue: [totalNumber := totalNumber + 1].
  25832.     aLabel := DialogView
  25833.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  25834.                 initialAnswer: totalNumber printString
  25835.                 onCancel: [^nil].
  25836.     aLabel isNil
  25837.         ifTrue: [reject := true]
  25838.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  25839.                 ifFalse: [reject := true]
  25840.                 ifTrue: [(model ttm name: aLabel alreadyExistsFor: model mynode av)
  25841.                         ifTrue: 
  25842.                             [reject := true.
  25843.                             TTMList speak: 'activity name already in use.']]].
  25844.     reject = false
  25845.         ifTrue: 
  25846.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  25847.             activityDim isNil
  25848.                 ifFalse: 
  25849.                     [newAVNeeded := (model ttm activitytree parentOf: model mynode)
  25850.                                 ~= nil & (model mynode left = nil).
  25851.                     newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  25852.                     model mynode collectionType = #cluster & (newAVNeeded = false)
  25853.                         ifTrue: [avType := model mynode selfAV]
  25854.                         ifFalse: 
  25855.                             [oldCursorPt := self sensor cursorPoint.
  25856.                             avName := model mynode av at: 1.
  25857.                             [(model ttm aValidVariableName: avName)
  25858.                                 & (avName ~= (model mynode av at: 1))]
  25859.                                 whileFalse: 
  25860.                                     [aRequest := 'Please supply a unique activity variable for ' , newNode myName , ':'.
  25861.                                     self sensor cursorPoint: oldCursorPt.
  25862.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  25863.                                     avName isEmpty ifTrue: [avName := model mynode av at: 1]].
  25864.                             avType := Array with: avName with: 'True'.
  25865.                             model ttm activityvariable: (avType at: 1)
  25866.                                 initial: (avType at: 2)].
  25867.                     model mynode selfAV: avType.
  25868.                     newNode av: avType.
  25869.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  25870.                     model doCancel]]
  25871.         ifFalse: 
  25872.             [TTMList speak: 'illegal activity name given'.
  25873.             model doCancel].
  25874.     view displayOn: #dummy! !
  25875.  
  25876. !EditingController methodsFor: 'performing'!
  25877. performAddActivityLast
  25878.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber typeResponse c t x |
  25879.     reject := false.
  25880.     typeResponse := nil.
  25881.     cursorPosition := self sensor cursorPoint.
  25882.     avList := model ttm typeForAV: model mynode selfAV.
  25883.     avList size = 1
  25884.         ifTrue: [totalNumber := 0]
  25885.         ifFalse: [totalNumber := avList size].
  25886.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode selfAV]
  25887.         whileTrue: [totalNumber := totalNumber + 1].
  25888.     model mynode left isNil
  25889.         ifTrue: 
  25890.             [typeResponse := DialogView
  25891.                         choose: 'Choose type for TTM : ' , model mynode myName
  25892.                         labels: #('XOR' 'AND' )
  25893.                         values: #(true false )
  25894.                         default: true.
  25895.             typeResponse = true
  25896.                 ifTrue: [model mynode collectionType: #cluster]
  25897.                 ifFalse: [model mynode collectionType: #parallel]].
  25898.     aLabel := DialogView
  25899.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  25900.                 initialAnswer: totalNumber printString
  25901.                 onCancel: [^nil].
  25902.     aLabel isNil
  25903.         ifTrue: [reject := true]
  25904.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  25905.                 ifFalse: [reject := true]
  25906.                 ifTrue: 
  25907.                     [c := 1.
  25908.                     t := model ttm activitytree allImmediateChildrenOf: model mynode.
  25909.                     [reject = false & (c < t size)]
  25910.                         whileTrue: 
  25911.                             [x := t at: c.
  25912.                             x myName = aLabel
  25913.                                 ifTrue: 
  25914.                                     [reject := true.
  25915.                                     TTMList speak: 'activity name already in use.'].
  25916.                             c := c + 1]]].
  25917.     reject = false
  25918.         ifTrue: 
  25919.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  25920.             activityDim isNil
  25921.                 ifFalse: 
  25922.                     [newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  25923.                     oldCursorPt := self sensor cursorPoint.
  25924.                     model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  25925.                         ifTrue: 
  25926.                             [avName := '1'.
  25927.                             [(model ttm aValidVariableName: avName)
  25928.                                 = false | ((model ttm anExistingAV: avName)
  25929.                                     = true) | ((model ttm anExistingDV: avName)
  25930.                                     = true)]
  25931.                                 whileTrue: 
  25932.                                     [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  25933.                                     self sensor cursorPoint: oldCursorPt.
  25934.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  25935.                                     avName isEmpty ifTrue: [avName := '1']].
  25936.                             avType := Array with: avName with: 'True'.
  25937.                             model ttm activityvariable: (avType at: 1)
  25938.                                 initial: (avType at: 2).
  25939.                             model mynode selfAV: avType.
  25940.                             model mynode hasAV: true].
  25941.                     newNode av: model mynode selfAV.
  25942.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  25943.                     model doCancel]]
  25944.         ifFalse: 
  25945.             [TTMList speak: 'illegal activity name given'.
  25946.             model doCancel].
  25947.     model mynode collectionType = #parallel & model mynode selfAV notNil
  25948.         ifTrue: 
  25949.             [model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  25950.             model mynode hasAV: false].
  25951.     ttmList changed: #avTransaction.
  25952.     ttmList changed: #curSFList.
  25953.     view displayOn: #dummy! !
  25954.  
  25955. !EditingController methodsFor: 'performing'!
  25956. performAddTransition
  25957.     | newTransition newArc box1 box2 points newname ans existingDest t |
  25958.     model mynode collectionType = #parallel
  25959.         ifTrue: 
  25960.             [DialogView warn: 'Cannot add transition between concurrent events'.
  25961.             model doCancel.
  25962.             ^nil].
  25963.     pointedActivity := self isInActivity: self sensor cursorPoint.
  25964.     pointedActivity isNil
  25965.         ifFalse: 
  25966.             [
  25967.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New transition name?'.
  25968.             newname isEmpty ifTrue: [^nil].
  25969.             (TTMList aUsefulTrLabel: newname)
  25970.                 ifTrue: [(model ttm transitionlist TransitionsNamed: newname) size = 0
  25971.                         ifFalse: 
  25972.                             ["existingDest := ((model ttm 
  25973.                             
  25974.                             transitionlist TransitionsNamed: newname) 
  25975.                             
  25976.                             at: 1) 
  25977.                             
  25978.                             endingAt. 
  25979.                             
  25980.                             pointedActivity ~= 
  25981.                             
  25982.                             existingDest ifTrue: [(model ttm activitytree 
  25983.                             is: 
  25984.                             
  25985.                             pointedActivity 
  25986.                             
  25987.                             concurrentWith: existingDest) 
  25988.                             
  25989.                             ifFalse: 
  25990.                             
  25991.                             [TTMList speak: 
  25992.                             
  25993.                             'not a permissible destination', (String with: 
  25994.                             
  25995.                             Character cr), 
  25996.                             
  25997.                             'for a branch or shared transition.'. 
  25998.                             
  25999.                             ^nil]]."
  26000.                             ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  26001.                             ans = false ifTrue: [^nil]]]
  26002.                 ifFalse: 
  26003.                     [TTMList speak: 'invalid transition name'.
  26004.                     ^nil].
  26005.             model source = pointedActivity
  26006.                 ifTrue: 
  26007.                     [model waitingFor: #selfloop.
  26008.                     model source: (Array with: model source with: newname).
  26009.                     view pending.
  26010.                     ^self].    "*****************"
  26011.             t := self getActivityTranformationsFor: pointedActivity.
  26012.             newTransition := model ttm transitionlist
  26013.                         addTransitionFrom: model source
  26014.                         to: pointedActivity
  26015.                         withName: newname.
  26016.             box1 := model source myBox dimensions copy moveBy: model source myBox location.
  26017.             box2 := pointedActivity myBox dimensions copy moveBy: pointedActivity myBox location.
  26018.             points := view boxPoints: box1 to: box2.
  26019.             newArc := Arc2
  26020.                         start: (points at: 1)
  26021.                         end: (points at: 2)
  26022.                         mid: (view midPointOf: (points at: 1)
  26023.                                 and: (points at: 2)).
  26024.             newArc dimensions: (Rectangle
  26025.                     left: 0
  26026.                     right: (newTransition myName size * 7.5) ceiling + 5
  26027.                     top: 0
  26028.                     bottom: 20).
  26029.             newTransition myArc: newArc.
  26030.             model readjustPointsFor: newTransition.
  26031.             model doCancel].
  26032.     view displayOn: #dummy! !
  26033.  
  26034. !EditingController methodsFor: 'performing'!
  26035. performAddTransitionOld
  26036.     | newTransition newArc box1 box2 points newname ans existingDest |
  26037.     pointedActivity := self isInActivity: self sensor cursorPoint.
  26038.     pointedActivity isNil
  26039.         ifFalse: 
  26040.             [(model ttm activitytree is: pointedActivity concurrentWith: model source)
  26041.                 ifTrue: 
  26042.                     [model doCancel.
  26043.                     TTMList speak: 'activities cannot be concurrent'.
  26044.                     ^nil].
  26045.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New transition name?'.
  26046.             newname isEmpty ifTrue: [^nil].
  26047.             (TTMList aUsefulTrLabel: newname)
  26048.                 ifTrue: [(model ttm transitionlist TransitionsNamed: newname) size = 0
  26049.                         ifFalse: 
  26050.                             [existingDest := ((model ttm transitionlist TransitionsNamed: newname)
  26051.                                         at: 1) endingAt.
  26052.                             pointedActivity ~= existingDest ifTrue: [(model ttm activitytree is: pointedActivity concurrentWith: existingDest)
  26053.                                     ifFalse: 
  26054.                                         [TTMList speak: 'not a permissible destination' , (String with: Character cr) , 'for a branch or shared transition.'.
  26055.                                         ^nil]].
  26056.                             ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  26057.                             ans = false ifTrue: [^nil]]]
  26058.                 ifFalse: 
  26059.                     [TTMList speak: 'invalid transition name'.
  26060.                     ^nil].
  26061.             model source = pointedActivity
  26062.                 ifTrue: 
  26063.                     [model waitingFor: #selfloop.
  26064.                     model source: (Array with: model source with: newname).
  26065.                     view pending.
  26066.                     ^self].
  26067.             newTransition := model ttm transitionlist
  26068.                         addTransitionFrom: model source
  26069.                         to: pointedActivity
  26070.                         withName: newname.
  26071.             box1 := model source myBox dimensions copy moveBy: model source myBox location.
  26072.             box2 := pointedActivity myBox dimensions copy moveBy: pointedActivity myBox location.
  26073.             points := view boxPoints: box1 to: box2.
  26074.             newArc := Arc2
  26075.                         start: (points at: 1)
  26076.                         end: (points at: 2)
  26077.                         mid: (view midPointOf: (points at: 1)
  26078.                                 and: (points at: 2)).
  26079.             newArc dimensions: (Rectangle
  26080.                     left: 0
  26081.                     right: (newTransition myName size * 7.5) ceiling + 5
  26082.                     top: 0
  26083.                     bottom: 20).
  26084.             newTransition myArc: newArc.
  26085.             model readjustPointsFor: newTransition.
  26086.             model doCancel].
  26087.     view displayOn: #dummy! !
  26088.  
  26089. !EditingController methodsFor: 'performing'!
  26090. performAddTrSource
  26091.  
  26092.      pointedActivity := self isInActivity: self sensor
  26093.  
  26094. cursorPoint.
  26095.  
  26096.      pointedActivity isNil
  26097.  
  26098.           ifFalse: 
  26099.  
  26100.                [model waitingFor: #addTransition.
  26101.  
  26102.                model source: pointedActivity.
  26103.  
  26104.                view pending.
  26105.  
  26106.                (Delay forSeconds: 1) wait]! !
  26107.  
  26108. !EditingController methodsFor: 'performing'!
  26109. performChangeDest
  26110.     | newTransition box1 box2 points newArc |
  26111.     pointedActivity := self isInActivity: self sensor cursorPoint.
  26112.     pointedActivity isNil
  26113.         ifFalse: 
  26114.             [newTransition := model source.
  26115.             newTransition endingAt: pointedActivity.
  26116.             newTransition startingAt = newTransition endingAt
  26117.                 ifTrue: 
  26118.                     [model source: newTransition.
  26119.                     (Delay forSeconds: 1) wait.
  26120.                     model waitingFor: #changeselfloop.
  26121.                     view pending.
  26122.                     ^self].
  26123.             box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  26124.             box2 := newTransition endingAt myBox dimensions copy moveBy: newTransition endingAt myBox location.
  26125.             points := view boxPoints: box1 to: box2.
  26126.             newArc := Arc2
  26127.                         start: (points at: 1)
  26128.                         end: (points at: 2)
  26129.                         mid: (view midPointOf: (points at: 1)
  26130.                                 and: (points at: 2)).
  26131.             newArc dimensions: (Rectangle
  26132.                     left: 0
  26133.                     right: (newTransition myName size * 7.5) ceiling + 5
  26134.                     top: 0
  26135.                     bottom: 20).
  26136.             newTransition myArc: newArc.
  26137.             model readjustPointsFor: newTransition.
  26138.             model doCancel.
  26139.             view displayOn: #dummy]! !
  26140.  
  26141. !EditingController methodsFor: 'performing'!
  26142. performChangeToSelfLoop
  26143.     "This is the case where the new destination for an existing transition is its 
  26144.     source. I.E. it becomes a self-loop."
  26145.  
  26146.     | box1 points newArc newTransition myMidpt endingPt startingPt |
  26147.     myMidpt := self sensor cursorPoint.
  26148.     newTransition := model source.
  26149.     box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  26150.     points := view
  26151.                 boxPoints: box1
  26152.                 to: box1
  26153.                 via: myMidpt.
  26154.     endingPt := points at: 2.
  26155.     startingPt := self selfLoopStartingPtFor: endingPt with: box1.
  26156.     newArc := Arc2
  26157.                 start: startingPt
  26158.                 end: endingPt
  26159.                 mid: myMidpt.
  26160.     newArc dimensions: (Rectangle
  26161.             left: 0
  26162.             right: (newTransition myName size * 7.5) ceiling + 5
  26163.             top: 0
  26164.             bottom: 20).
  26165.     newTransition myArc: newArc.
  26166.     model readjustPointsFor: newTransition.
  26167.     model doCancel.
  26168.     view displayOn: #dummy! !
  26169.  
  26170. !EditingController methodsFor: 'performing'!
  26171. performInsertConcurrently
  26172.     "Insert ttmChosen into the current TTM concurrently."
  26173.     "MUST CHANGE AVs OF NEW SIBLING TOO!!"
  26174.  
  26175.     | aLabel cursorPosition activityDim newNode mySibling oldSiblingAV newSiblingAV choice |
  26176.     model mynode collectionType = #cluster & (model mynode left ~= nil)
  26177.         ifTrue: 
  26178.             [DialogView warn: 'Cannot perform parallel insertion into a seriel TTM'.
  26179.             model doCancel.
  26180.             ^nil].
  26181.     aLabel := model ttmChosen activitytree getRoot myName.
  26182.     cursorPosition := self sensor cursorPoint.
  26183.     activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  26184.     activityDim isNil
  26185.         ifFalse: 
  26186.             [oldCursorPt := self sensor cursorPoint.
  26187.             self addingOfAVsInParallel.
  26188.             self addingOfDVs: (model duplicateOption at: 1).
  26189.             self addingOfChannels.
  26190.             self combineStateFormulas.
  26191.             self combineInitialConditions.
  26192.             newNode := self addingActivitiesInParallel.
  26193.             self addingTransitionsInParallel: nil.
  26194.             mySibling := self model mynode left.
  26195.             oldSiblingAV := mySibling av.
  26196.             newSiblingAV := mySibling av copy.
  26197.             newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  26198.             self model mynode collectionType: #parallel.
  26199.             model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  26200.             model mynode hasAV: false.
  26201.             model ttm updateSpecificIC.
  26202.                  "model ttm checkAllAVsStillUsed."
  26203.             ttmList changed: #avTransaction.
  26204.             ttmList changed: #curSFList.
  26205.             model doCancel.
  26206.             model doCancel.
  26207.             view displayOn: #dummy].
  26208.     model mynode selfAV isNil ifFalse: [newNode av: model mynode selfAV]! !
  26209.  
  26210. !EditingController methodsFor: 'performing'!
  26211. performInsertSerially
  26212.     "Insert ttmChosen into the current TTM sequentially. 
  26213.     
  26214.     Rename root 
  26215.     activity if necessary, get display box, 
  26216.     
  26217.     then add the AVs, DVs, 
  26218.     activities, and finally the 
  26219.     
  26220.     transitions. Then add the root activity as a 
  26221.     child of 
  26222.     
  26223.     the current activity being displayed."
  26224.  
  26225.     | aLabel cursorPosition activityDim newNode avName aRequest avType |
  26226.     model mynode collectionType = #parallel & (model mynode left ~= nil)
  26227.         ifTrue: 
  26228.             [DialogView warn: 'Cannot perform serial insertion into a parallel TTM'.
  26229.             model doCancel.
  26230.             ^nil].
  26231.     aLabel := model ttmChosen activitytree getRoot myName.
  26232.     aLabel := model ttm
  26233.                 check: aLabel
  26234.                 asNewActivityNameFor: model mynode av
  26235.                 canBe: nil.
  26236.     model ttmChosen activitytree getRoot myName: aLabel.
  26237.     cursorPosition := self sensor cursorPoint.
  26238.     activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  26239.     activityDim isNil
  26240.         ifFalse: 
  26241.             [oldCursorPt := self sensor cursorPoint.
  26242.             self addingOfAVsInSerial.
  26243.             self addingOfDVs: (model duplicateOption at: 1).
  26244.             self addingOfChannels.
  26245.             self combineStateFormulas.
  26246.             self combineInitialConditions.
  26247.             newNode := self addingActivitiesInSerial.
  26248.             self addingTransitionsInSerial.
  26249.             model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  26250.                 ifTrue: 
  26251.                     [avName := '1'.
  26252.                     [(model ttm aValidVariableName: avName)
  26253.                         = false | ((model ttm anExistingAV: avName)
  26254.                             = true)]
  26255.                         whileTrue: 
  26256.                             [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  26257.                             self sensor cursorPoint: oldCursorPt.
  26258.                             avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  26259.                             avName isEmpty ifTrue: [avName := '1']].
  26260.                     avType := Array with: avName with: 'True'.
  26261.                     model ttm activityvariable: (avType at: 1)
  26262.                         initial: (avType at: 2).
  26263.                     model mynode selfAV: avType.
  26264.                     model mynode hasAV: true].
  26265.             newNode av: model mynode selfAV.
  26266.             newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  26267.             model ttm updateSpecificIC.    "model ttm checkAllAVsStillUsed."
  26268.             ttmList changed: #avTransaction.
  26269.             ttmList changed: #curSFList.
  26270.             model doCancel.
  26271.             view displayOn: #dummy]! !
  26272.  
  26273. !EditingController methodsFor: 'performing'!
  26274. performMoveActivity
  26275.     | cursorPosition hsize vsize maxRight maxBottom intersection locationBox child siblingBox |
  26276.     cursorPosition := self sensor cursorPoint.
  26277.     hsize := model source myBox dimensions right.
  26278.     vsize := model source myBox dimensions bottom.
  26279.     maxRight := view boundary right.
  26280.     maxBottom := view boundary bottom.
  26281.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  26282.         ifTrue: 
  26283.             [intersection := false.
  26284.             locationBox := model source myBox dimensions copy moveBy: cursorPosition.
  26285.             child := model mynode left.
  26286.             [child notNil & (intersection = false)]
  26287.                 whileTrue: 
  26288.                     [child myBox notNil ifTrue: [child ~~ model source
  26289.                             ifTrue: 
  26290.                                 [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  26291.                                 intersection := locationBox intersects: siblingBox]].
  26292.                     child := child right].
  26293.             intersection
  26294.                 ifFalse: 
  26295.                     [model source myBox location: cursorPosition.
  26296.                     self reAssessTransitionsAll.
  26297.                     model doCancel.
  26298.                     view displayOn: #dummy]]! !
  26299.  
  26300. !EditingController methodsFor: 'performing'!
  26301. performMoveTransition
  26302.     | cursorPosition hsize vsize maxRight maxBottom box1 box2 points startingPt askTTM trSource trDest |
  26303.     cursorPosition := self sensor cursorPoint.
  26304.     hsize := model source myArc dimensions right.
  26305.     vsize := model source myArc dimensions bottom.
  26306.     askTTM := model ttm activitytree.
  26307.     maxRight := view boundary right.
  26308.     maxBottom := view boundary bottom.
  26309.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  26310.         ifTrue: 
  26311.             [(model visibleSourceFor: model source)
  26312.                 ifTrue: 
  26313.                     [trSource := model source startingAt.
  26314.                     model source myArc sourceMid: cursorPosition.
  26315.                     (model visibleDestFor: model source)
  26316.                         ifFalse: [(askTTM is: model source startingAt above: model source endingAt)
  26317.                                 ifTrue: [trDest := askTTM ancestorOf: model source endingAt onLevelOf: trSource]
  26318.                                 ifFalse: [trDest := nil]]].
  26319.             (model visibleDestFor: model source)
  26320.                 ifTrue: 
  26321.                     [trDest := model source endingAt.
  26322.                     model source myArc destMid: cursorPosition.
  26323.                     (model visibleSourceFor: model source)
  26324.                         ifFalse: [(askTTM is: model source endingAt above: model source startingAt)
  26325.                                 ifTrue: [trSource := askTTM ancestorOf: model source startingAt onLevelOf: trDest]
  26326.                                 ifFalse: [trSource := nil]]].
  26327.             trSource notNil & trDest notNil
  26328.                 ifTrue: 
  26329.                     [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  26330.                     trSource = trDest
  26331.                         ifTrue: [box2 := box1]
  26332.                         ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  26333.                     points := view
  26334.                                 boxPoints: box1
  26335.                                 to: box2
  26336.                                 via: cursorPosition.
  26337.                     trSource = trDest
  26338.                         ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  26339.                                         with: box1]
  26340.                         ifFalse: [startingPt := points at: 1].
  26341.                     (model visibleSourceFor: model source)
  26342.                         ifTrue: 
  26343.                             [model source myArc sourceStart: startingPt.
  26344.                             model source myArc sourceEnd: (points at: 2)].
  26345.                     (model visibleDestFor: model source)
  26346.                         ifTrue: 
  26347.                             [model source myArc destStart: startingPt.
  26348.                             model source myArc destEnd: (points at: 2)]]
  26349.                 ifFalse: [].
  26350.             model doCancel.
  26351.             view displayOn: #noUpdate]! !
  26352.  
  26353. !EditingController methodsFor: 'performing'!
  26354. performResizeActivity
  26355.     | cursorPosition current hmax vmax hmin vmin right bottom smallestPoint largestPoint intersection aBox locationBox child siblingBox |
  26356.     cursorPosition := self sensor cursorPoint.
  26357.     current := model source.
  26358.     hmax := view boundary right - current myBox location x.
  26359.     vmax := view boundary bottom - current myBox location y.
  26360.     hmin := (current myName size * 7.5) ceiling + 5.
  26361.     vmin := 20.
  26362.     smallestPoint := current myBox location x + hmin @ (current myBox location y + vmin).
  26363.     largestPoint := current myBox location x + hmax @ (current myBox location y + vmax).
  26364.     cursorPosition > smallestPoint & (cursorPosition < largestPoint)
  26365.         ifTrue: 
  26366.             [intersection := false.
  26367.             right := cursorPosition x - current myBox location x.
  26368.             bottom := cursorPosition y - current myBox location y.
  26369.             aBox := Rectangle
  26370.                         left: current myBox dimensions left
  26371.                         right: right
  26372.                         top: current myBox dimensions top
  26373.                         bottom: bottom.
  26374.             locationBox := aBox copy moveBy: current myBox location.
  26375.             child := model mynode left.
  26376.             [child notNil & (intersection = false)]
  26377.                 whileTrue: 
  26378.                     [child myBox notNil ifTrue: [child ~~ current
  26379.                             ifTrue: 
  26380.                                 [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  26381.                                 intersection := locationBox intersects: siblingBox]].
  26382.                     child := child right].
  26383.             intersection
  26384.                 ifFalse: 
  26385.                     [current myBox dimensions: aBox.
  26386.                     self reAssessTransitionsAll.
  26387.                     model doCancel.
  26388.                     view displayOn: #dummy]]! !
  26389.  
  26390. !EditingController methodsFor: 'performing'!
  26391. performSelfLoop
  26392.     | box1 points newArc newTransition myMidpt endingPt startingPt |
  26393.     myMidpt := self sensor cursorPoint.
  26394.     newTransition := model ttm transitionlist
  26395.                 addTransitionFrom: (model source at: 1)
  26396.                 to: (model source at: 1)
  26397.                 withName: (model source at: 2).
  26398.     box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  26399.     points := view
  26400.                 boxPoints: box1
  26401.                 to: box1
  26402.                 via: myMidpt.
  26403.     endingPt := points at: 2.
  26404.     startingPt := self selfLoopStartingPtFor: endingPt with: box1.
  26405.     newArc := Arc2
  26406.                 start: startingPt
  26407.                 end: endingPt
  26408.                 mid: myMidpt.
  26409.     newArc dimensions: (Rectangle
  26410.             left: 0
  26411.             right: (newTransition myName size * 7.5) ceiling + 5
  26412.             top: 0
  26413.             bottom: 20).
  26414.     newTransition myArc: newArc.
  26415.     model doCancel.    "view drawTransitionArcFor: newTransition"
  26416.     view displayOn: #dummy! !
  26417.  
  26418. !EditingController methodsFor: 'performing'!
  26419. performSetDefault
  26420.     | parent oldDefault |
  26421.     pointedActivity := self isInActivity: self sensor cursorPoint.
  26422.     pointedActivity isNil
  26423.         ifFalse: 
  26424.             [parent := model ttm activitytree parentOf: pointedActivity.
  26425.             parent collectionType ~= #cluster
  26426.                 ifTrue: 
  26427.                     [model doCancel.
  26428.                     ^nil].
  26429.             oldDefault := model ttm activitytree currentDefaultOf: parent.
  26430.             oldDefault default: false.
  26431.             pointedActivity default: true.
  26432.             model ttm changeDefaultForAV: (parent selfAV at: 1)
  26433.                 to: pointedActivity.
  26434.             view
  26435.                 drawActivity: oldDefault myBox dimensions
  26436.                 at: oldDefault myBox location
  26437.                 withLabel: oldDefault myName
  26438.                 isDefault: oldDefault default
  26439.                 collect: model mynode collectionType.
  26440.             view
  26441.                 drawActivity: pointedActivity myBox dimensions
  26442.                 at: pointedActivity myBox location
  26443.                 withLabel: pointedActivity myName
  26444.                 isDefault: pointedActivity default
  26445.                 collect: model mynode collectionType.
  26446.             model doCancel]! !
  26447.  
  26448. !EditingController methodsFor: 'performing'!
  26449. performZoomin
  26450.  
  26451.     pointedActivity := self isInActivity: self sensor cursorPoint.
  26452.  
  26453.     pointedActivity isNil
  26454.  
  26455.         ifFalse: 
  26456.  
  26457.             [model mynode: pointedActivity.
  26458.  
  26459.             model doCancel.
  26460.  
  26461.             view displayOn: #dummy]! !
  26462.  
  26463. !EditingController methodsFor: 'insertion of ttms'!
  26464. addingActivitiesInParallel
  26465.     "I just tack the root on to the current node of the 
  26466.     
  26467.     ttm we are editing. Should 
  26468.     
  26469.     be performed only AFTER ADDINGOFAVS"
  26470.  
  26471.     | myroot |
  26472.     myroot := model ttmChosen activitytree getRoot.
  26473.     ^model ttm activitytree addCreatedNode: myroot to: model mynode! !
  26474.  
  26475. !EditingController methodsFor: 'insertion of ttms'!
  26476. addingActivitiesInSerial
  26477.     "I just tack the root on to the current node of the      
  26478.     ttm we are editing. But first check whether there      
  26479.     will result any duplicate labelled activities. Should      
  26480.     be performed only AFTER ADDINGOFAVS"
  26481.  
  26482.     | myroot mykids count currentKid choice hsize newAVNeeded newNode avName aRequest avType |
  26483.     myroot := model ttmChosen activitytree getRoot.
  26484.     mykids := model ttmChosen activitytree listChildrenOf: myroot.
  26485.     count := 2.
  26486.     [count > mykids size]
  26487.         whileFalse: 
  26488.             [currentKid := mykids at: count.
  26489.             currentKid av = myroot av
  26490.                 ifTrue: 
  26491.                     [choice := model ttm
  26492.                                 check: currentKid myName
  26493.                                 asNewActivityNameFor: myroot av
  26494.                                 canBe: nil.
  26495.                     currentKid myName: choice.
  26496.                     hsize := (choice size * 7.5) ceiling + 5.
  26497.                     hsize > currentKid myBox dimensions right
  26498.                         ifTrue: 
  26499.                             [currentKid myBox dimensions right: hsize.
  26500.                             self reAssessTransitionsFor: currentKid from: model ttmChosen]].
  26501.             count := count + 1].
  26502.     newAVNeeded := (model ttm activitytree parentOf: model mynode)
  26503.                 ~= nil & (model mynode left = nil).
  26504.     newNode := model ttm activitytree addCreatedNode: myroot to: model mynode.
  26505.     model mynode selfAV isNil ifFalse: [newNode av: model mynode selfAV].
  26506.     "newAVNeeded = true
  26507.         ifTrue: 
  26508.             [avName := model mynode av at: 1.
  26509.             [(model ttm aValidVariableName: avName)
  26510.                 & (avName ~= (model mynode av at: 1))]
  26511.                 whileFalse: 
  26512.                     [aRequest := 'Please supply a unique activity variable for ' , newNode myName , ':'.
  26513.                     self sensor cursorPoint: oldCursorPt.
  26514.                     avName := DialogView request: aRequest initialAnswer: 'X_', model mynode myName.
  26515.                     avName isEmpty ifTrue: [avName := model mynode av at: 1]].
  26516.             avType := Array with: avName with: 'True'.
  26517.             model ttm activityvariable: (avType at: 1)
  26518.                 initial: (avType at: 2).
  26519.             model mynode selfAV: avType.
  26520.             newNode av: avType]."
  26521.     ^newNode! !
  26522.  
  26523. !EditingController methodsFor: 'insertion of ttms'!
  26524. addingOfAVsInParallel
  26525.     "Rename duplicate AVs before adding them."
  26526.  
  26527.     | ttm myAVs |
  26528.     ttm := model ttmChosen.
  26529.     myAVs := ttm activityvariable.
  26530.     self changeAVsInSet: myAVs! !
  26531.  
  26532. !EditingController methodsFor: 'insertion of ttms'!
  26533. addingOfAVsInSerial
  26534.     "First, I change the root AV to this ttm's new 
  26535.     parent's AV. Then process remaining AVs."
  26536.  
  26537.     | ttm newrootAV oldrootAV myAVs |
  26538.     ttm := model ttmChosen.
  26539.     newrootAV := model mynode av.
  26540.     oldrootAV := ttm activitytree getRoot av.
  26541.     ttm renameVariable: oldrootAV to: newrootAV.
  26542.     ttm activitytree getRoot av: newrootAV.
  26543.     myAVs := ttm activityvariable.
  26544.     self changeAVsInSet: myAVs! !
  26545.  
  26546. !EditingController methodsFor: 'insertion of ttms'!
  26547. addingOfChannels
  26548.     "For those channels that are duplicated, I give 
  26549.     
  26550.     the user the option to rename them."
  26551.  
  26552.     | ttm myChannels count currentCh aRequest response continue choice |
  26553.     ttm := model ttmChosen.
  26554.     myChannels := ttm commchannel.
  26555.     count := 1.
  26556.     [count > myChannels size]
  26557.         whileFalse: 
  26558.             [currentCh := myChannels at: count.
  26559.             (model ttm anExistingCh: (currentCh at: 1) asString)
  26560.                 ifTrue: 
  26561.                     [aRequest := 'A communication channel ' , (currentCh at: 1) asString , ' already exists.' , (String with: Character cr) , 'Do you wish to rename it?'.
  26562.                     self sensor cursorPoint: oldCursorPt.
  26563.                     response := DialogView confirm: aRequest.
  26564.                     response = true
  26565.                         ifTrue: 
  26566.                             [continue := false.
  26567.                             [continue = false]
  26568.                                 whileTrue: 
  26569.                                     [aRequest := 'Please supply a new name:'.
  26570.                                     self sensor cursorPoint: oldCursorPt.
  26571.                                     choice := DialogView request: aRequest.
  26572.                                     choice isEmpty ifFalse: [continue := (model ttm anExistingCh: choice) not]].
  26573.                             ttm renameVariable: (currentCh at: 1)
  26574.                                 to: choice.
  26575.                             model ttm commchannel: choice]]
  26576.                 ifFalse: [model ttm commchannel: (currentCh at: 1) copy].
  26577.             count := count + 1]! !
  26578.  
  26579. !EditingController methodsFor: 'insertion of ttms'!
  26580. addingOfDVs: userOption 
  26581.     "For those DVs that are duplicated, I give 
  26582.     
  26583.     the user the option to rename them."
  26584.  
  26585.     | ttm myDVs count currentDV aRequest response continue choice |
  26586.     ttm := model ttmChosen.
  26587.     myDVs := ttm datavariable.
  26588.     count := 1.
  26589.     [count > myDVs size]
  26590.         whileFalse: 
  26591.             [currentDV := myDVs at: count.
  26592.             (model ttm anExistingDV: (currentDV at: 1) asString)
  26593.                 ifTrue: 
  26594.                     [userOption = #ALL
  26595.                         ifTrue: [response := false]
  26596.                         ifFalse: 
  26597.                             [aRequest := 'A data variable ' , (currentDV at: 1) asString , ' already exists.' , (String with: Character cr) , 'Do you wish to rename it?'.
  26598.                             self sensor cursorPoint: oldCursorPt.
  26599.                             response := DialogView confirm: aRequest].
  26600.                     response = true
  26601.                         ifTrue: 
  26602.                             [continue := false.
  26603.                             [continue = false]
  26604.                                 whileTrue: 
  26605.                                     [aRequest := 'Please supply a new name:'.
  26606.                                     self sensor cursorPoint: oldCursorPt.
  26607.                                     choice := DialogView request: aRequest.
  26608.                                     choice isEmpty ifFalse: [continue := (model ttm anExistingDV: choice) not]].
  26609.                             ttm renameVariable: (currentDV at: 1)
  26610.                                 to: choice.
  26611.                             model ttm
  26612.                                 datavariable: choice
  26613.                                 lrange: (currentDV at: 2) copy
  26614.                                 hrange: (currentDV at: 3) copy
  26615.                                 initial: (currentDV at: 4) copy]]
  26616.                 ifFalse: [model ttm
  26617.                         datavariable: (currentDV at: 1) copy
  26618.                         lrange: (currentDV at: 2) copy
  26619.                         hrange: (currentDV at: 3) copy
  26620.                         initial: (currentDV at: 4) copy].
  26621.             count := count + 1]! !
  26622.  
  26623. !EditingController methodsFor: 'insertion of ttms'!
  26624. addingTransitionsInParallel: userOption 
  26625.     "MUST DEAL WITH COMMUNICATION!!"
  26626.     "call me AFTER ADDINGACTIVITIES"
  26627.     "Communication pairs should be taken 
  26628.     
  26629.     care of. Also, should prompt to see that 
  26630.     
  26631.     duplicates SHOULD be shared transitions 
  26632.     
  26633.     ore renamed. Other than that - nothing needs to 
  26634.     
  26635.     be done."
  26636.  
  26637.     | myTrList |
  26638.     myTrList := model ttmChosen transitionlist.
  26639.     myTrList do: [:currentTr | (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0 ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  26640.                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  26641.                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]].
  26642.     myTrList do: [:currentTr | model ttm transitionlist add: currentTr]! !
  26643.  
  26644. !EditingController methodsFor: 'insertion of ttms'!
  26645. addingTransitionsInParallelNew: userOption 
  26646.     "MUST DEAL WITH COMMUNICATION!!"
  26647.     "call me AFTER ADDINGACTIVITIES"
  26648.     "Communication pairs should be taken 
  26649.     
  26650.     care of. Also, should prompt to see that 
  26651.     
  26652.     duplicates SHOULD be shared transitions 
  26653.     
  26654.     ore renamed. Other than that - nothing needs to 
  26655.     
  26656.     be done."
  26657.  
  26658.     | myTrList |
  26659.     myTrList := model ttmChosen transitionlist.
  26660.     myTrList do: [:currentTr | (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0 ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  26661.                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  26662.                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]].
  26663.     myTrList do: [:currentTr | model ttm transitionlist add: currentTr]! !
  26664.  
  26665. !EditingController methodsFor: 'insertion of ttms'!
  26666. addingTransitionsInParallelOld: userOption 
  26667.     "MUST DEAL WITH COMMUNICATION!!"
  26668.     "call me AFTER ADDINGACTIVITIES"
  26669.     "Communication pairs should be taken 
  26670.     
  26671.     care of. Also, should prompt to see that 
  26672.     
  26673.     duplicates SHOULD be shared transitions 
  26674.     
  26675.     ore renamed. Other than that - nothing needs to 
  26676.     
  26677.     be done."
  26678.  
  26679.     | count myTrList currentTr aRequest response newname |
  26680.     count := 1.
  26681.     myTrList := model ttmChosen transitionlist.
  26682.     [count > myTrList size]
  26683.         whileFalse: 
  26684.             [currentTr := myTrList at: count.
  26685.             (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0
  26686.                 ifTrue: 
  26687.                     [userOption = #ALL
  26688.                         ifTrue: [response := true]
  26689.                         ifFalse: 
  26690.                             [aRequest := 'A transition named ' , currentTr myName , ' already exists.' , (String with: Character cr) , 'Make it shared transition?'.
  26691.                             self sensor cursorPoint: oldCursorPt.
  26692.                             response := DialogView confirm: aRequest].
  26693.                     response = true
  26694.                         ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  26695.                                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  26696.                                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]
  26697.                         ifFalse: [[(model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0]
  26698.                                 whileTrue: 
  26699.                                     [aRequest := 'Please supply new transition name:'.
  26700.                                     self sensor cursorPoint: oldCursorPt.
  26701.                                     newname := DialogView request: aRequest.
  26702.                                     newname isEmpty | (TTMList aUsefulTrLabel: newname) not ifFalse: [currentTr myName: newname]]]].
  26703.             count := count + 1].
  26704.     count := 1.
  26705.     [count > myTrList size]
  26706.         whileFalse: 
  26707.             [currentTr := myTrList at: count.
  26708.             model ttm transitionlist add: currentTr.
  26709.             count := count + 1]! !
  26710.  
  26711. !EditingController methodsFor: 'insertion of ttms'!
  26712. addingTransitionsInSerial
  26713.     "I just tack all the transitions on to the 
  26714.     
  26715.     transitionlist of the ttm we are editing . 
  26716.     
  26717.     There should be NO duplicate transition labels. 
  26718.     
  26719.     Should be called AFTER ADDINGACTIVITIES"
  26720.  
  26721.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  26722.     count := 1.
  26723.     myTrList := model ttmChosen transitionlist.
  26724.     [count > myTrList size]
  26725.         whileFalse: 
  26726.             [currentTr := myTrList at: count.
  26727.             ""
  26728.             model ttm transitionlist add: currentTr.
  26729.             count := count + 1]! !
  26730.  
  26731. !EditingController methodsFor: 'insertion of ttms'!
  26732. addingTransitionsInSerialNew
  26733.     "I just tack all the transitions on to the 
  26734.     
  26735.     transitionlist of the ttm we are editing . 
  26736.     
  26737.     There should be NO duplicate transition labels. 
  26738.     
  26739.     Should be called AFTER ADDINGACTIVITIES"
  26740.  
  26741.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  26742.     count := 1.
  26743.     myTrList := model ttmChosen transitionlist.
  26744.     [count > myTrList size]
  26745.         whileFalse: 
  26746.             [currentTr := myTrList at: count.
  26747.             "(model ttm transitionlist TransitionsNamed: currentTr myName) size = 0
  26748.                 ifFalse: 
  26749.                     [checkCount := 1.
  26750.                     duplicate := false.
  26751.                     [checkCount > myTrList size]
  26752.                         whileFalse: 
  26753.                             [count ~= checkCount ifTrue: [(myTrList at: checkCount) myName = currentTr myName ifTrue: [duplicate := true]].
  26754.                             checkCount := checkCount + 1].
  26755.                     duplicate = false
  26756.                         ifTrue: 
  26757.                             [continue := false.
  26758.                             errorname := currentTr myName.
  26759.                             [continue = false]
  26760.                                 whileTrue: 
  26761.                                     [aRequest := 'A transition named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  26762.                                     self sensor cursorPoint: oldCursorPt.
  26763.                                     choice := DialogView request: aRequest.
  26764.                                     choice isEmpty ifFalse: [(TTMList aUsefulTrLabel: choice asString)
  26765.                                             ifTrue: 
  26766.                                                 [continue := (model ttm transitionlist TransitionsNamed: choice) size = 0.
  26767.                                                 continue = false ifTrue: [errorname := choice]]]].
  26768.                             currentTr myName: choice]]."
  26769.             model ttm transitionlist add: currentTr.
  26770.             count := count + 1]! !
  26771.  
  26772. !EditingController methodsFor: 'insertion of ttms'!
  26773. addingTransitionsInSerialOld
  26774.     "I just tack all the transitions on to the 
  26775.     
  26776.     transitionlist of the ttm we are editing . 
  26777.     
  26778.     There should be NO duplicate transition labels. 
  26779.     
  26780.     Should be called AFTER ADDINGACTIVITIES"
  26781.  
  26782.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  26783.     count := 1.
  26784.     myTrList := model ttmChosen transitionlist.
  26785.     [count > myTrList size]
  26786.         whileFalse: 
  26787.             [currentTr := myTrList at: count.
  26788.             (model ttm transitionlist TransitionsNamed: currentTr myName) size = 0
  26789.                 ifFalse: 
  26790.                     [checkCount := 1.
  26791.                     duplicate := false.
  26792.                     [checkCount > myTrList size]
  26793.                         whileFalse: 
  26794.                             [count ~= checkCount ifTrue: [(myTrList at: checkCount) myName = currentTr myName ifTrue: [duplicate := true]].
  26795.                             checkCount := checkCount + 1].
  26796.                     duplicate = false
  26797.                         ifTrue: 
  26798.                             [continue := false.
  26799.                             errorname := currentTr myName.
  26800.                             [continue = false]
  26801.                                 whileTrue: 
  26802.                                     [aRequest := 'A transition named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  26803.                                     self sensor cursorPoint: oldCursorPt.
  26804.                                     choice := DialogView request: aRequest.
  26805.                                     choice isEmpty ifFalse: [(TTMList aUsefulTrLabel: choice asString)
  26806.                                             ifTrue: 
  26807.                                                 [continue := (model ttm transitionlist TransitionsNamed: choice) size = 0.
  26808.                                                 continue = false ifTrue: [errorname := choice]]]].
  26809.                             currentTr myName: choice]].
  26810.             model ttm transitionlist add: currentTr.
  26811.             count := count + 1]! !
  26812.  
  26813. !EditingController methodsFor: 'insertion of ttms'!
  26814. changeAVsInSet: myAVs 
  26815.     "Go through myAvs. If they are duplicated, 
  26816.     
  26817.     then demand a new name for them before 
  26818.     
  26819.     adding them."
  26820.  
  26821.     | ttm count currentAV continue aRequest choice |
  26822.     ttm := model ttmChosen.
  26823.     count := 1.
  26824.     [count > myAVs size]
  26825.         whileFalse: 
  26826.             [currentAV := myAVs at: count.
  26827.             (model ttm anExistingAV: (currentAV at: 1) asString)
  26828.                 ifTrue: 
  26829.                     [continue := false.
  26830.                     [continue = false]
  26831.                         whileTrue: 
  26832.                             [aRequest := 'An activity variable ' , (currentAV at: 1) asString , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  26833.                             self sensor cursorPoint: oldCursorPt.
  26834.                             choice := DialogView request: aRequest.
  26835.                             choice isEmpty ifFalse: [continue := model ttm aValidVariableName: choice]].
  26836.                     ttm renameActivityVariable: (currentAV at: 1)
  26837.                         to: choice.
  26838.                     ttm renameVariable: (currentAV at: 1)
  26839.                         to: choice.
  26840.                     currentAV at: 1 put: choice].
  26841.             model ttm activityvariable: (currentAV at: 1)
  26842.                 initial: (currentAV at: 2).
  26843.             count := count + 1]! !
  26844.  
  26845. !EditingController methodsFor: 'insertion of ttms'!
  26846. combineInitialConditions
  26847.     | chosenIC chosenSIC count number contents |
  26848.     chosenIC := model ttmChosen initialcondition copy.
  26849.     chosenIC = 'nil'
  26850.         ifFalse: 
  26851.             [model ttm initialcondition = 'nil' ifFalse: [chosenIC := model ttm initialcondition copy , (String with: Character cr) , ',(' , chosenIC , ')'].
  26852.             model ttm initialcondition: chosenIC].
  26853.     chosenSIC := model ttmChosen specificIC.
  26854.     count := 1.
  26855.     [count > chosenSIC size]
  26856.         whileFalse: 
  26857.             [number := ((chosenSIC at: count)
  26858.                         at: 1) copy.
  26859.             contents := ((chosenSIC at: count)
  26860.                         at: 2) copy.
  26861.             model ttm specificIC add: (Array with: number with: contents).
  26862.             count := count + 1]! !
  26863.  
  26864. !EditingController methodsFor: 'insertion of ttms'!
  26865. combineStateFormulas
  26866.     | chosenSF count number contents continue ans c current |
  26867.     chosenSF := model ttmChosen stateFormulas.
  26868.     count := 1.
  26869.     [count > chosenSF size]
  26870.         whileFalse: 
  26871.             [number := ((chosenSF at: count)
  26872.                         at: 1) copy.
  26873.             contents := ((chosenSF at: count)
  26874.                         at: 2) copy.
  26875.             continue := 0.
  26876.             [continue = 0]
  26877.                 whileTrue: [(TTMList aUsefulActLabel: number)
  26878.                         ifTrue: [continue := 2]
  26879.                         ifFalse: 
  26880.                             [ans := DialogView confirm: 'SF number ' , number , ' is already in use' , (String with: Character cr) , 'combine the SFs?'.
  26881.                             ans = true
  26882.                                 ifTrue: 
  26883.                                     [c := 1.
  26884.                                     [c > model ttm stateFormulas size]
  26885.                                         whileFalse: 
  26886.                                             [current := model ttm stateFormulas at: c.
  26887.                                             number = (current at: 1) & (contents ~= 'nil')
  26888.                                                 ifTrue: 
  26889.                                                     [(current at: 2)
  26890.                                                         ~= 'nil' ifTrue: [contents := (current at: 2)
  26891.                                                                     , (String with: Character cr) , ',(' , contents , ')'].
  26892.                                                     current at: 2 put: contents.
  26893.                                                     model ttm stateFormulas at: c put: current].
  26894.                                             c := c + 1].
  26895.                                     continue := 1]
  26896.                                 ifFalse: 
  26897.                                     [ans := DialogView request: 'Please provide a new number for the SF:'.
  26898.                                     ans isEmpty not & (TTMList aUsefulActLabel: ans)
  26899.                                         ifTrue: 
  26900.                                             [number := ans.
  26901.                                             continue := 2]]]].
  26902.             continue = 2 ifTrue: [model ttm stateFormulas add: (Array with: number with: contents)].
  26903.             count := count + 1]! !
  26904.  
  26905. !EditingController methodsFor: 'insertion of ttms'!
  26906. performCommunicationOn: currentTr 
  26907.     "Given a transition that has a ? or !! in its 
  26908.     
  26909.     action & there exists a shared transition, 
  26910.     
  26911.     we want to replace a pair of 'C?X C!!Y' 
  26912.     
  26913.     with 'X:Y'. We change the shared transition 
  26914.     
  26915.     action and return the modified currentTr 
  26916.     
  26917.     action. We might need to do this SEVERAL 
  26918.     
  26919.     times for the same currentTr"
  26920.  
  26921.     | type action location trlist match count c channel exit pattern s e matchAction e1 segment1 segment2 replacement |
  26922.     action := TTMList removeAllBlanksFrom: currentTr myAction.
  26923.     exit := (action findString: '?' startingAt: 1)
  26924.                 = 0 & ((action findString: '!!' startingAt: 1)
  26925.                     = 0).
  26926.     [exit = false]
  26927.         whileTrue: 
  26928.             [trlist := model ttm transitionlist TransitionsNamed: currentTr myName.
  26929.             location := action findString: '?' startingAt: 1.
  26930.             location = 0
  26931.                 ifTrue: 
  26932.                     [type := #send.
  26933.                     location := action findString: '!!' startingAt: 1]
  26934.                 ifFalse: [type := #receive].
  26935.             c := location - 1.
  26936.             [c > 1 & ((action at: c) isAlphaNumeric | ((action at: c)
  26937.                         = $_))]
  26938.                 whileTrue: [c := c - 1].
  26939.             c = 1 ifFalse: [c := c + 1].
  26940.             channel := action copyFrom: c to: location - 1.
  26941.             e1 := location + 1.
  26942.             [e1 < action size & ((action at: e1) isAlphaNumeric | ((action at: e1)
  26943.                         = $_))]
  26944.                 whileTrue: [e1 := e1 + 1].
  26945.             e1 = action size ifFalse: [e1 := e1 - 1].
  26946.             segment1 := action copyFrom: location + 1 to: e1.
  26947.             match := nil.
  26948.             type = #receive
  26949.                 ifTrue: [pattern := channel , '!!']
  26950.                 ifFalse: [pattern := channel , '?'].
  26951.             count := 1.
  26952.             [count > trlist size | match notNil]
  26953.                 whileFalse: 
  26954.                     [((trlist at: count) myAction findString: pattern startingAt: 1)
  26955.                         ~= 0 ifTrue: [match := trlist at: count].
  26956.                     count := count + 1].
  26957.             match notNil
  26958.                 ifTrue: 
  26959.                     [matchAction := TTMList removeAllBlanksFrom: match myAction copy.
  26960.                     s := matchAction findString: pattern startingAt: 1.
  26961.                     e := s + pattern size.
  26962.                     [e < matchAction size & (matchAction at: e) isAlphaNumeric]
  26963.                         whileTrue: [e := e + 1].
  26964.                     e = matchAction size ifFalse: [e := e - 1].
  26965.                     segment2 := matchAction copyFrom: s + pattern size to: e.
  26966.                     s = 1 ifFalse: [s := s - 1]
  26967.                         ifTrue: [e = matchAction size ifFalse: [e := e + 1]].
  26968.                     match myAction: (matchAction
  26969.                             changeFrom: s
  26970.                             to: e
  26971.                             with: '').
  26972.                     match myAction isEmpty ifTrue: [match myAction: 'nil'].
  26973.                     type = #receive
  26974.                         ifTrue: [replacement := segment1 , ':' , segment2]
  26975.                         ifFalse: [replacement := segment2 , ':' , segment1].
  26976.                     action := action
  26977.                                 changeFrom: c
  26978.                                 to: e1
  26979.                                 with: replacement].
  26980.             match isNil
  26981.                 ifTrue: [exit := true]
  26982.                 ifFalse: [exit := (action findString: '?' startingAt: 1)
  26983.                                 = 0 & ((action findString: '!!' startingAt: 1)
  26984.                                     = 0)]].
  26985.     ^action! !
  26986.  
  26987. !EditingController methodsFor: 'private performing'!
  26988. reAssessTransitionsAll
  26989.     "Once an activity is moved or resized, the 
  26990.     
  26991.     Transition arcs may have to be repositioned."
  26992.  
  26993.     | trList supplement count currentTr trSource trDest box1 box2 points startingPt m askTTM anActivity |
  26994.     askTTM := model ttm activitytree.
  26995.     anActivity := model mynode left.
  26996.     [anActivity notNil]
  26997.         whileTrue: 
  26998.             [trList := model ttm transitionlist TransitionsStartingAt: anActivity.
  26999.             supplement := model ttm transitionlist TransitionsEndingAt: anActivity.
  27000.             count := 1.
  27001.             [count > supplement size]
  27002.                 whileFalse: 
  27003.                     [(trList includes: (supplement at: count))
  27004.                         ifFalse: [trList add: (supplement at: count)].
  27005.                     count := count + 1].
  27006.             count := 1.
  27007.             [count > trList size]
  27008.                 whileFalse: 
  27009.                     [currentTr := trList at: count.
  27010.                     (model visibleSourceFor: currentTr)
  27011.                         ifTrue: 
  27012.                             [trSource := currentTr startingAt.
  27013.                             m := currentTr myArc sourceMid.
  27014.                             (model visibleDestFor: currentTr)
  27015.                                 ifFalse: [(askTTM is: currentTr startingAt above: currentTr endingAt)
  27016.                                         ifTrue: [trDest := askTTM ancestorOf: currentTr endingAt onLevelOf: trSource]
  27017.                                         ifFalse: [trDest := nil]]].
  27018.                     (model visibleDestFor: currentTr)
  27019.                         ifTrue: 
  27020.                             [trDest := currentTr endingAt.
  27021.                             m := currentTr myArc destMid.
  27022.                             (model visibleSourceFor: currentTr)
  27023.                                 ifFalse: [(askTTM is: currentTr endingAt above: currentTr startingAt)
  27024.                                         ifTrue: [trSource := askTTM ancestorOf: currentTr startingAt onLevelOf: trDest]
  27025.                                         ifFalse: [trSource := nil]]].
  27026.                     trSource notNil & trDest notNil
  27027.                         ifTrue: 
  27028.                             [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  27029.                             trSource = trDest
  27030.                                 ifTrue: [box2 := box1]
  27031.                                 ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  27032.                             points := view
  27033.                                         boxPoints: box1
  27034.                                         to: box2
  27035.                                         via: m.
  27036.                             trSource = trDest
  27037.                                 ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  27038.                                                 with: box1]
  27039.                                 ifFalse: [startingPt := points at: 1].
  27040.                             (model visibleSourceFor: currentTr)
  27041.                                 ifTrue: 
  27042.                                     [currentTr myArc sourceStart: startingPt.
  27043.                                     currentTr myArc sourceEnd: (points at: 2)].
  27044.                             (model visibleDestFor: currentTr)
  27045.                                 ifTrue: 
  27046.                                     [currentTr myArc destStart: startingPt.
  27047.                                     currentTr myArc destEnd: (points at: 2)]]
  27048.                         ifFalse: [trSource isNil & trDest isNil
  27049.                                 ifTrue: []
  27050.                                 ifFalse: [trSource isNil
  27051.                                         ifTrue: 
  27052.                                             [box2 := trDest myBox dimensions copy moveBy: trDest myBox location.
  27053.                                             points := view
  27054.                                                         boxPointsPoint: currentTr myArc destStart
  27055.                                                         to: box2
  27056.                                                         via: m.
  27057.                                             currentTr myArc destEnd: (points at: 2)]
  27058.                                         ifFalse: 
  27059.                                             [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  27060.                                             points := view
  27061.                                                         boxPoints: box1
  27062.                                                         toPoint: currentTr myArc sourceEnd
  27063.                                                         via: m.
  27064.                                             currentTr myArc sourceStart: (points at: 1)]]].
  27065.                     count := count + 1].
  27066.             anActivity := anActivity right]! !
  27067.  
  27068. !EditingController methodsFor: 'private performing'!
  27069. reAssessTransitionsFor: anActivity from: ttm 
  27070.     "Once an activity is moved or resized, the 
  27071.     
  27072.     Transition arcs may have to be repositioned."
  27073.  
  27074.     | trList supplement count currentTr trSource trDest box1 box2 points startingPt m askTTM |
  27075.     askTTM := ttm activitytree.
  27076.     trList := ttm transitionlist TransitionsStartingAt: anActivity.
  27077.     supplement := ttm transitionlist TransitionsEndingAt: anActivity.
  27078.     count := 1.
  27079.     [count > supplement size]
  27080.         whileFalse: 
  27081.             [(trList includes: (supplement at: count))
  27082.                 ifFalse: [trList add: (supplement at: count)].
  27083.             count := count + 1].
  27084.     count := 1.
  27085.     [count > trList size]
  27086.         whileFalse: 
  27087.             [currentTr := trList at: count.
  27088.             (model visibleSourceFor: currentTr)
  27089.                 ifTrue: 
  27090.                     [trSource := currentTr startingAt.
  27091.                     m := currentTr myArc sourceMid.
  27092.                     (model visibleDestFor: currentTr)
  27093.                         ifFalse: [(askTTM is: currentTr startingAt above: currentTr endingAt)
  27094.                                 ifTrue: [trDest := askTTM ancestorOf: currentTr endingAt onLevelOf: trSource]
  27095.                                 ifFalse: [trDest := nil]]].
  27096.             (model visibleDestFor: currentTr)
  27097.                 ifTrue: 
  27098.                     [trDest := currentTr endingAt.
  27099.                     m := currentTr myArc destMid.
  27100.                     (model visibleSourceFor: currentTr)
  27101.                         ifFalse: [(askTTM is: currentTr endingAt above: currentTr startingAt)
  27102.                                 ifTrue: [trSource := askTTM ancestorOf: currentTr startingAt onLevelOf: trDest]
  27103.                                 ifFalse: [trSource := nil]]].
  27104.             trSource notNil & trDest notNil
  27105.                 ifTrue: 
  27106.                     [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  27107.                     trSource = trDest
  27108.                         ifTrue: [box2 := box1]
  27109.                         ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  27110.                     points := view
  27111.                                 boxPoints: box1
  27112.                                 to: box2
  27113.                                 via: m.
  27114.                     trSource = trDest
  27115.                         ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  27116.                                         with: box1]
  27117.                         ifFalse: [startingPt := points at: 1].
  27118.                     (model visibleSourceFor: currentTr)
  27119.                         ifTrue: 
  27120.                             [currentTr myArc sourceStart: startingPt.
  27121.                             currentTr myArc sourceEnd: (points at: 2)].
  27122.                     (model visibleDestFor: currentTr)
  27123.                         ifTrue: 
  27124.                             [currentTr myArc destStart: startingPt.
  27125.                             currentTr myArc destEnd: (points at: 2)]]
  27126.                 ifFalse: [].
  27127.             count := count + 1]! !
  27128.  
  27129. !EditingController methodsFor: 'private performing'!
  27130. selfLoopStartingPtFor: endingPt with: box1 
  27131.     | startingPt |
  27132.     endingPt x = box1 topLeft x | (endingPt y = box1 topLeft y)
  27133.         ifTrue: [startingPt := box1 topLeft]
  27134.         ifFalse: [startingPt := box1 bottomRight].
  27135.     ^startingPt! !
  27136.  
  27137. !EditingController methodsFor: 'variable access'!
  27138. currentTTM: aTTM 
  27139.     currentTTM := aTTM! !
  27140.  
  27141. !EditingController methodsFor: 'variable access'!
  27142. ttmList: aTTMList 
  27143.     ttmList := aTTMList! !
  27144.  
  27145. FileBrowser subclass: #FileList
  27146.     instanceVariableNames: 'currentDirectory filenameObject aTTMList '
  27147.     classVariableNames: 'FileMenuFL TextMenuFL '
  27148.     poolDictionaries: ''
  27149.     category: 'Build'!
  27150.  
  27151. !FileList methodsFor: 'variable access'!
  27152. aTTMList: tL 
  27153.     aTTMList := tL! !
  27154.  
  27155. !FileList methodsFor: 'variable access'!
  27156. currentDirectory
  27157.     ^currentDirectory! !
  27158.  
  27159. !FileList methodsFor: 'variable access'!
  27160. currentDirectory: aDirectory 
  27161.     currentDirectory := aDirectory! !
  27162.  
  27163. !FileList methodsFor: 'file name list'!
  27164. addFile! !
  27165.  
  27166. !FileList methodsFor: 'file name list'!
  27167. addSubDir! !
  27168.  
  27169. !FileList methodsFor: 'file name list'!
  27170. directoryPattern
  27171.     "Set the pattern to be the path to the selected directory."
  27172.  
  27173.     | newPattern |
  27174.     newPattern := fileName.
  27175.     newPattern == nil 
  27176.         ifFalse: [self pattern: (newPattern asFilename constructString: '*') asString.
  27177.                 self changed: #pattern.
  27178.                 self acceptPattern: self pattern asText from: nil]! !
  27179.  
  27180. !FileList methodsFor: 'file name list'!
  27181. fileListMenu
  27182.  
  27183.      "Answer the menu."
  27184.  
  27185.  
  27186.  
  27187.      "Evaluate this when you change this method:
  27188.  
  27189.           FileBrowser flushMenus"
  27190.  
  27191.       "^nil"
  27192.  
  27193.      "fileName == nil
  27194.  
  27195.           ifTrue: [^PopUpMenu
  27196.  
  27197.                          labels: 'make directory' withCRs
  27198.  
  27199.                          lines: #()
  27200.  
  27201.                          values: #(makeDir)]."
  27202.  
  27203.  
  27204.  
  27205.      "If fileName exists and is a directory, return a special
  27206.  
  27207. menu"
  27208.  
  27209.      selectionState = #directory
  27210.  
  27211.           ifTrue: [^PopUpMenu
  27212.  
  27213.                          labels: 'new pattern' withCRs
  27214.  
  27215.                          
  27216.  
  27217.                          values: #(directoryPattern)  ].
  27218.  
  27219.      ^nil
  27220.  
  27221.      "If fileName does not exist or is not a directory return the
  27222.  
  27223. standard menu"
  27224.  
  27225.      "fileName == nil ifTrue: [^nil]."
  27226.  
  27227.       
  27228.  
  27229.      "FileMenuFL == nil ifTrue:
  27230.  
  27231.           [FileMenuFL :=
  27232.  
  27233.                PopUpMenu
  27234.  
  27235.                     labels: 'load' withCRs
  27236.  
  27237.                     
  27238.  
  27239.                     values: #(load )]."
  27240.  
  27241.      
  27242.  
  27243.      "^FileMenuFL"! !
  27244.  
  27245. !FileList methodsFor: 'file name list'!
  27246. fileListMenuX
  27247.  
  27248.      "Answer the menu."
  27249.  
  27250.  
  27251.  
  27252.      "Evaluate this when you change this method:
  27253.  
  27254.           FileBrowser flushMenus"
  27255.  
  27256.       "^nil"
  27257.  
  27258.      "fileName == nil
  27259.  
  27260.           ifTrue: [^PopUpMenu
  27261.  
  27262.                          labels: 'make directory' withCRs
  27263.  
  27264.                          lines: #()
  27265.  
  27266.                          values: #(makeDir)]."
  27267.  
  27268.  
  27269.  
  27270.      "If fileName exists and is a directory, return a special
  27271.  
  27272. menu"
  27273.  
  27274.      selectionState = #directory
  27275.  
  27276.           ifTrue: [^PopUpMenu
  27277.  
  27278.                          labels: 'new pattern' withCRs
  27279.  
  27280.                          
  27281.  
  27282.                          values: #(directoryPattern)  ].
  27283.  
  27284.      ^nil
  27285.  
  27286.      "If fileName does not exist or is not a directory return the
  27287.  
  27288. standard menu"
  27289.  
  27290.      "fileName == nil ifTrue: [^nil]."
  27291.  
  27292.       
  27293.  
  27294.      "FileMenuFL == nil ifTrue:
  27295.  
  27296.           [FileMenuFL :=
  27297.  
  27298.                PopUpMenu
  27299.  
  27300.                     labels: 'load' withCRs
  27301.  
  27302.                     
  27303.  
  27304.                     values: #(load )]."
  27305.  
  27306.      
  27307.  
  27308.      "^FileMenuFL"! !
  27309.  
  27310. !FileList methodsFor: 'file name list'!
  27311. fileLoad: aTTMList1 
  27312.     aTTMList1 fileSelection: fileName.
  27313.     aTTMList1 fileLoad! !
  27314.  
  27315. !FileList methodsFor: 'file name list'!
  27316. fileName: selection 
  27317.     "If selection is not nil, it is either the name of a file to be viewed, or a 
  27318.     directory"
  27319.  
  27320.     | file |
  27321.     fileName = selection ifTrue: [^self].
  27322.     file := nil.
  27323.     lastModified := nil.
  27324.     selection == nil
  27325.         ifTrue: [selectionState := nil]
  27326.         ifFalse: 
  27327.             [file := selection.
  27328.             selectionState := #fileInfo.
  27329.             Filename errorReporter errorSignal handle: [:ex | ex return]
  27330.                 do: 
  27331.                     [| fn |
  27332.                     fn := file asFilename.
  27333.                     fn isDirectory
  27334.                         ifTrue: [selectionState := #directory]
  27335.                         ifFalse: [selectionState := #fileInfo]]].
  27336.     (fileName := selection) notNil
  27337.         ifTrue: 
  27338.             [filenameObject := Filename named: selection.
  27339.             "filenameObject isDirectory ifFalse: [currentDirectory := filenameObject head]
  27340.                 ifTrue: [currentDirectory := filenameObject].
  27341.             aTTMList currentDirectory: currentDirectory."
  27342.             self changed: #pattern.    "Reset the pattern, in case it has changed"
  27343.             self changed: #text]! !
  27344.  
  27345. !FileList methodsFor: 'file name list'!
  27346. fileSave: aTTMList 
  27347.  
  27348.     aTTMList fileSave notNil ifTrue: [self acceptPattern: self pattern asText from: nil]! !
  27349.  
  27350. !FileList methodsFor: 'pattern'!
  27351. acceptPattern: aText from: aController 
  27352.     (super acceptPattern: aText from: aController)
  27353.         = true
  27354.         ifTrue: 
  27355.             [filenameObject := Filename named: aText string.
  27356.             (filenameObject isDirectoryErrInto: BuildDummy new)
  27357.                 = true ifFalse: [currentDirectory := filenameObject head]
  27358.                 ifTrue: [currentDirectory := filenameObject].
  27359.             aTTMList currentDirectory: currentDirectory.
  27360.             TTMList currentDirectory: currentDirectory.
  27361.             ^true]
  27362.         ifFalse: [^false]! !
  27363.  
  27364. !FileList methodsFor: 'pattern'!
  27365. patternMenuX
  27366.     "Answer a Menu of operations on the file name pattern that 
  27367.     
  27368.     is to be displayed 
  27369.     
  27370.     when the operate menu button is pressed."
  27371.     "FileBrowser flushMenus."
  27372.  
  27373.     PatternMenu == nil ifTrue: [PatternMenu := PopUpMenu labels: 'volumes' withCRs values: #(#chooseVolume:from: )].
  27374.     ^PatternMenu! !
  27375.  
  27376. !FileList methodsFor: 'pattern'!
  27377. patternX: aString 
  27378.     "Set a new pattern for the receiver. Inform any dependents 
  27379.     
  27380.     so that the labels 
  27381.     
  27382.     for the receiver's views can be updated."
  27383.  
  27384.     myPattern := aString asText.
  27385.     self changed: #fileNameList.
  27386.     self changed: #windowLabel with: 'File Access on ' , aString! !
  27387.  
  27388. !FileList methodsFor: 'private'!
  27389. changedX: pat 
  27390.     pat = #pattern ifTrue: [true inspect].
  27391.     super changed: pat! !
  27392.  
  27393. !FileList methodsFor: 'private'!
  27394. listX: aList 
  27395.     "Set my list of files."
  27396.  
  27397.     aList add: '..'.
  27398.     super list: aList! !
  27399.  
  27400. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  27401.  
  27402. FileList class
  27403.     instanceVariableNames: ''!
  27404.  
  27405. !FileList class methodsFor: 'instance creation'!
  27406. flushMenus
  27407.     "Cause all menus to be newly created (so changes appear)."
  27408.     "FileBrowser flushMenus."
  27409.  
  27410.     TextMenuFL := nil.
  27411.     PatternMenu := nil.
  27412.     FileMenuFL := nil! !
  27413.  
  27414. !FileList class methodsFor: 'instance creation'!
  27415. openOnPattern: aPattern for: aTTMList 
  27416.     "Create and schedule a view of a new instance of the 
  27417.     
  27418.     receiver 
  27419.     
  27420.     using the pattern aPattern. For example, evaluate 
  27421.     
  27422.     FileList openOnPattern: '*.mdl'"
  27423.  
  27424.     | topView aFileList patternView label topWindow patternHeight qButton ldButton sButton left top hsize vsize path |
  27425.     patternHeight := [LookPreferences menuBarHeight + TextAttributes defaultLineGrid + 6].
  27426.     aFileList := self new.
  27427.     aFileList aTTMList: aTTMList.
  27428.     path := (Filename named: (TTMList currentDirectory)) constructString: aPattern.
  27429.     aPattern = ''
  27430.         ifFalse: 
  27431.             [Cursor read showWhile: [aFileList list: (SortedCollection new addAll: (aFileList filesMatching: path))].
  27432.             label := 'File Access on ' , aPattern asString]
  27433.         ifTrue: [label := 'File Access'].
  27434.     aFileList pattern: path.
  27435.     topWindow := ScheduledWindow
  27436.                 model: aFileList
  27437.                 label: label
  27438.                 minimumSize: 200 @ 200.
  27439.     topView := CompositePart new.
  27440.     topWindow component: topView.
  27441.     patternView := TextView
  27442.                 on: aFileList
  27443.                 aspect: #pattern
  27444.                 change: #acceptPattern:from:
  27445.                 menu: #patternMenu
  27446.                 initialSelection: nil.
  27447.     patternView controller dispatchOn: Character cr to: #alwaysAcceptKey:.
  27448.     patternView controller dispatchOn: #Enter to: #alwaysAcceptKey:.
  27449.     patternView := LookPreferences edgeDecorator on: patternView.
  27450.     patternView noVerticalScrollBar.
  27451.     left := 0.02.
  27452.     hsize := 0.3.
  27453.     top := 0.9.
  27454.     vsize := 0.09.
  27455.     topView add: patternView in: ((LayoutFrame new) leftOffset: 0; topOffset: 0; rightFraction: 1; bottomOffset: patternHeight).
  27456.     topView add: (LookPreferences edgeDecorator on: (SelectionInListView
  27457.                 on: aFileList
  27458.                 aspect: #fileNameList
  27459.                 change: #fileName:
  27460.                 list: #fileNameList
  27461.                 menu: #fileListMenu
  27462.                 initialSelection: #fileName))
  27463.         in: ((LayoutFrame new) leftOffset: 0; topOffset: patternHeight; rightFraction: 1; bottomFraction: 0.89).
  27464.     sButton := PushButton named: 'Save'.
  27465.     sButton model: ((PluggableAdaptor on: self)
  27466.             getBlock: [:model | false]
  27467.             putBlock: [:model :value | aFileList fileSave: aTTMList]
  27468.             updateBlock: [:model :value :parameter | false]).
  27469.     (topView add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27470.         insideColor: ColorValue white.
  27471.     left := left + 0.3.
  27472.     ldButton := PushButton named: 'Load'.
  27473.     ldButton model: ((PluggableAdaptor on: self)
  27474.             getBlock: [:model | false]
  27475.             putBlock: [:model :value | aFileList fileLoad: aTTMList]
  27476.             updateBlock: [:model :value :parameter | false]).
  27477.     (topView add: ldButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27478.         insideColor: ColorValue white.
  27479.     left := left + 0.3.
  27480.     qButton := PushButton named: 'Exit'.
  27481.     qButton model: ((PluggableAdaptor on: self)
  27482.             getBlock: [:model | false]
  27483.             putBlock: [:model :value | ScheduledControllers activeController close]
  27484.             updateBlock: [:model :value :parameter | false]).
  27485.     (topView add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27486.         insideColor: ColorValue white.
  27487.     topWindow icon: (Icon constantNamed: #file).
  27488.     topWindow openWithExtent: 300 @ 350! !
  27489.  
  27490. LabeledBooleanView subclass: #PushButton
  27491.     instanceVariableNames: ''
  27492.     classVariableNames: ''
  27493.     poolDictionaries: ''
  27494.     category: 'Build'!
  27495.  
  27496. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  27497.  
  27498. PushButton class
  27499.     instanceVariableNames: ''!
  27500.  
  27501. !PushButton class methodsFor: 'instance creation'!
  27502. named: buttonName 
  27503.     | button |
  27504.     button := LabeledBooleanView new.
  27505.     button beTrigger.
  27506.     button controller beTriggerOnUp.
  27507.     button beVisual: buttonName asComposedText.
  27508.     ^button! !
  27509.  
  27510. 'From VisualWorks(TM), Release 1.0 of 8 October 1992 on 14 December 1994 at 6:35:27 pm'!
  27511.  
  27512. !TTMList methodsFor: 'code generation'!
  27513. makeGuardsFor: prologType 
  27514.     "Create en() predicates for all of the 
  27515.     
  27516.     transitions in the ttm, selection."
  27517.  
  27518.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  27519.     table := OrderedCollection new.
  27520.     common := 'en(' , selection named , ', '.
  27521.     prologType = #quintus
  27522.         ifTrue: 
  27523.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  27524.             table add: preamble].
  27525.     trCount := 1.
  27526.     [trCount > editedtrlist size]
  27527.         whileFalse: 
  27528.             [currentTr := editedtrlist at: trCount.
  27529.             samplename := currentTr at: 1.
  27530.             sampleguard := currentTr at: 2.
  27531.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  27532.             sampleguard = 'nil'
  27533.                 ifTrue: [table add: preamble , '. ']
  27534.                 ifFalse: 
  27535.                     [prologType = #quintus
  27536.                         ifTrue: 
  27537.                             [preamble := preamble , ' :-'.
  27538.                             table add: preamble]
  27539.                         ifFalse: [preamble := preamble , '{'].
  27540.                     supplement := self makeGuard: sampleguard for: prologType.
  27541.                     count := 1.
  27542.                     [count > supplement size]
  27543.                         whileFalse: 
  27544.                             [temp1 := supplement at: count.
  27545.                             temp1 := TTMList
  27546.                                         inString: temp1
  27547.                                         replace: '%'
  27548.                                         with: ' mod '.
  27549.                             temp1 := TTMList
  27550.                                         inString: temp1
  27551.                                         replace: '/'
  27552.                                         with: ' div '.
  27553.                             prologType = #quintus
  27554.                                 ifTrue: [(self isArithmetic: temp1)
  27555.                                         = true & ((self containLtOrGt: temp1)
  27556.                                             = false)
  27557.                                         ifTrue: 
  27558.                                             [temp1 := TTMList
  27559.                                                         inString: temp1
  27560.                                                         replace: '='
  27561.                                                         with: ' =:= '.
  27562.                                             temp1 := TTMList
  27563.                                                         inString: temp1
  27564.                                                         replace: '#'
  27565.                                                         with: ' =\= '.
  27566.                                             table add: temp1]
  27567.                                         ifFalse: 
  27568.                                             [temp1 := TTMList
  27569.                                                         inString: temp1
  27570.                                                         replace: '#'
  27571.                                                         with: ' \== '.
  27572.                                             table add: temp1]]
  27573.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  27574.                             count := count + 1]].
  27575.             trCount := trCount + 1].
  27576.     ^table! !
  27577.  
  27578. 'From VisualWorks(TM), Release 1.0 of 8 October 1992 on 14 December 1994 at 6:34:36 pm'!
  27579.  
  27580. !TTMList methodsFor: 'dirty patch for quintus'!
  27581. containLtOrGt: s 
  27582.     s do: [:x | #($< $> ) do: [:y | x = y ifTrue: [^true]]].
  27583.     ^false! !
  27584.  
  27585. !TTMList methodsFor: 'dirty patch for quintus'!
  27586. isArithmetic: s 
  27587.     |  opStrings opChars |
  27588.     opStrings := #('mod' 'div' ).
  27589.     opChars := #($+ $-  $* ).
  27590.     opStrings do: [:x | (s findString: x startingAt: 1)
  27591.             ~= 0 ifTrue: [^true]].
  27592.     s do: [:x | opChars do: [:y | x = y ifTrue: [^true]]].
  27593.     ^false! !
  27594.  
  27595. TTMList open!
  27596.  
  27597. !TTMList methodsFor: 'code generation'!
  27598. makeGuardsFor: prologType 
  27599.     "Create en() predicates for all of the 
  27600.     
  27601.     transitions in the ttm, selection."
  27602.  
  27603.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  27604.     table := OrderedCollection new.
  27605.     common := 'en(' , selection named , ', '.
  27606.     prologType = #quintus
  27607.         ifTrue: 
  27608.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  27609.             table add: preamble].
  27610.     trCount := 1.
  27611.     [trCount > editedtrlist size]
  27612.         whileFalse: 
  27613.             [currentTr := editedtrlist at: trCount.
  27614.             samplename := currentTr at: 1.
  27615.             sampleguard := currentTr at: 2.
  27616.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  27617.             sampleguard = 'nil'
  27618.                 ifTrue: [table add: preamble , '. ']
  27619.                 ifFalse: 
  27620.                     [prologType = #quintus
  27621.                         ifTrue: 
  27622.                             [preamble := preamble , ' :-'.
  27623.                             table add: preamble]
  27624.                         ifFalse: [preamble := preamble , '{'].
  27625.                     supplement := self makeGuard: sampleguard for: prologType.
  27626.                     count := 1.
  27627.                     [count > supplement size]
  27628.                         whileFalse: 
  27629.                             [temp1 := supplement at: count.
  27630.                             temp1 := TTMList
  27631.                                         inString: temp1
  27632.                                         replace: '%'
  27633.                                         with: ' mod '.
  27634.                             temp1 := TTMList
  27635.                                         inString: temp1
  27636.                                         replace: '/'
  27637.                                         with: ' div '.
  27638.                             prologType = #quintus
  27639.                                 ifTrue: [(self isArithmetic: temp1)
  27640.                                         = true & ((self containLtOrGt: temp1)
  27641.                                             = false)
  27642.                                         ifTrue: 
  27643.                                             [temp1 := TTMList
  27644.                                                         inString: temp1
  27645.                                                         replace: '='
  27646.                                                         with: ' =:= '.
  27647.                                             temp1 := TTMList
  27648.                                                         inString: temp1
  27649.                                                         replace: '#'
  27650.                                                         with: ' =\= '.
  27651.                                             table add: temp1]
  27652.                                         ifFalse: 
  27653.                                             [temp1 := TTMList
  27654.                                                         inString: temp1
  27655.                                                         replace: '#'
  27656.                                                         with: ' \== '.
  27657.                                             table add: temp1]]
  27658.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  27659.                             count := count + 1]].
  27660.             trCount := trCount + 1].
  27661.     ^table! !
  27662.  
  27663. !TTMList methodsFor: 'code generation'!
  27664. makeGuardsFor: prologType 
  27665.     "Create en() predicates for all of the 
  27666.     
  27667.     transitions in the ttm, selection."
  27668.  
  27669.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  27670.     table := OrderedCollection new.
  27671.     common := 'en(' , selection named , ', '.
  27672.     prologType = #quintus
  27673.         ifTrue: 
  27674.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  27675.             table add: preamble].
  27676.     trCount := 1.
  27677.     [trCount > editedtrlist size]
  27678.         whileFalse: 
  27679.             [currentTr := editedtrlist at: trCount.
  27680.             samplename := currentTr at: 1.
  27681.             sampleguard := currentTr at: 2.
  27682.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  27683.             sampleguard = 'nil'
  27684.                 ifTrue: [table add: preamble , '. ']
  27685.                 ifFalse: 
  27686.                     [prologType = #quintus
  27687.                         ifTrue: 
  27688.                             [preamble := preamble , ' :-'.
  27689.                             table add: preamble]
  27690.                         ifFalse: [preamble := preamble , '{'].
  27691.                     supplement := self makeGuard: sampleguard for: prologType.
  27692.                     count := 1.
  27693.                     [count > supplement size]
  27694.                         whileFalse: 
  27695.                             [temp1 := supplement at: count.
  27696.                             temp1 := TTMList
  27697.                                         inString: temp1
  27698.                                         replace: '%'
  27699.                                         with: ' mod '.
  27700.                             temp1 := TTMList
  27701.                                         inString: temp1
  27702.                                         replace: '/'
  27703.                                         with: ' div '.
  27704.                             prologType = #quintus
  27705.                                 ifTrue: [(self isArithmetic: temp1)
  27706.                                         = true & ((self containLtOrGt: temp1)
  27707.                                             = false)
  27708.                                         ifTrue: 
  27709.                                             [temp1 := TTMList
  27710.                                                         inString: temp1
  27711.                                                         replace: '='
  27712.                                                         with: ' =:= '.
  27713.                                             temp1 := TTMList
  27714.                                                         inString: temp1
  27715.                                                         replace: '#'
  27716.                                                         with: ' =\= '.
  27717.                                             table add: temp1]
  27718.                                         ifFalse: 
  27719.                                             [temp1 := TTMList
  27720.                                                         inString: temp1
  27721.                                                         replace: '#'
  27722.                                                         with: ' \&= '.
  27723.                                             table add: temp1]]
  27724.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  27725.                             count := count + 1]].
  27726.             trCount := trCount + 1].
  27727.     ^table! !
  27728.  
  27729. !TTMList methodsFor: 'code generation'!
  27730. makeGuardsFor: prologType 
  27731.     "Create en() predicates for all of the 
  27732.     
  27733.     transitions in the ttm, selection."
  27734.  
  27735.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  27736.     table := OrderedCollection new.
  27737.     common := 'en(' , selection named , ', '.
  27738.     prologType = #quintus
  27739.         ifTrue: 
  27740.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  27741.             table add: preamble].
  27742.     trCount := 1.
  27743.     [trCount > editedtrlist size]
  27744.         whileFalse: 
  27745.             [currentTr := editedtrlist at: trCount.
  27746.             samplename := currentTr at: 1.
  27747.             sampleguard := currentTr at: 2.
  27748.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  27749.             sampleguard = 'nil'
  27750.                 ifTrue: [table add: preamble , '. ']
  27751.                 ifFalse: 
  27752.                     [prologType = #quintus
  27753.                         ifTrue: 
  27754.                             [preamble := preamble , ' :-'.
  27755.                             table add: preamble]
  27756.                         ifFalse: [preamble := preamble , '{'].
  27757.                     supplement := self makeGuard: sampleguard for: prologType.
  27758.                     count := 1.
  27759.                     [count > supplement size]
  27760.                         whileFalse: 
  27761.                             [temp1 := supplement at: count.
  27762.                             temp1 := TTMList
  27763.                                         inString: temp1
  27764.                                         replace: '%'
  27765.                                         with: ' mod '.
  27766.                             temp1 := TTMList
  27767.                                         inString: temp1
  27768.                                         replace: '/'
  27769.                                         with: ' div '.
  27770.                             prologType = #quintus
  27771.                                 ifTrue: [(self isArithmetic: temp1)
  27772.                                         = true & ((self containLtOrGt: temp1)
  27773.                                             = false)
  27774.                                         ifTrue: 
  27775.                                             [temp1 := TTMList
  27776.                                                         inString: temp1
  27777.                                                         replace: '='
  27778.                                                         with: ' =:= '.
  27779.                                             temp1 := TTMList
  27780.                                                         inString: temp1
  27781.                                                         replace: '\='
  27782.                                                         with: ' =\= '.
  27783.                                             table add: temp1]
  27784.                                         ifFalse: 
  27785.                                             [temp1 := TTMList
  27786.                                                         inString: temp1
  27787.                                                         replace: '#'
  27788.                                                         with: ' \&= '.
  27789.                                             table add: temp1]]
  27790.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  27791.                             count := count + 1]].
  27792.             trCount := trCount + 1].
  27793.     ^table! !
  27794.  
  27795. !TTMList methodsFor: 'code generation'!
  27796. separateLinesQuintus: aString 
  27797.     "Given a string, divide it into lines 
  27798.     
  27799.     separated at commas and semi-colons. 
  27800.     
  27801.     End it with a period."
  27802.  
  27803.     | lines aLine leftMargin newString left position c segment |
  27804.     (aString at: aString size)
  27805.         = $, | ((aString at: aString size)
  27806.             = $;)
  27807.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  27808.         ifFalse: [newString := aString].
  27809.     leftMargin := '        '.
  27810.     lines := OrderedCollection new.
  27811.     left := 1.
  27812.     position := 1.
  27813.     aLine := leftMargin , ''.
  27814.     [position > aString size]
  27815.         whileFalse: 
  27816.             [c := newString at: position.
  27817.             c = $, | (c = $;)
  27818.                 ifTrue: 
  27819.                     [segment := newString copyFrom: left to: position.
  27820.                     aLine := aLine , segment.
  27821.                     left := position + 1.
  27822.                     "lines add: (TTMList
  27823.                             inString: aLine
  27824.                             replace: '#'
  27825.                             with: ' \= ')."
  27826.                     lines add: aLine.
  27827.                     aLine := leftMargin , ''].
  27828.             c = $) ifTrue: [leftMargin := leftMargin copyFrom: 1 to: leftMargin size - 1].
  27829.             c = $( ifTrue: [leftMargin := leftMargin , ' '].
  27830.             position := position + 1].
  27831.     segment := newString copyFrom: left to: position - 1.
  27832.     aLine := aLine , segment , '.'.
  27833.     lines add: (TTMList
  27834.             inString: aLine
  27835.             replace: '#'
  27836.             with: ' \= ').
  27837.     ^lines! !
  27838.  
  27839. !TTMList methodsFor: 'code generation'!
  27840. makeGuardsFor: prologType 
  27841.     "Create en() predicates for all of the 
  27842.     
  27843.     transitions in the ttm, selection."
  27844.  
  27845.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  27846.     table := OrderedCollection new.
  27847.     common := 'en(' , selection named , ', '.
  27848.     prologType = #quintus
  27849.         ifTrue: 
  27850.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  27851.             table add: preamble].
  27852.     trCount := 1.
  27853.     [trCount > editedtrlist size]
  27854.         whileFalse: 
  27855.             [currentTr := editedtrlist at: trCount.
  27856.             samplename := currentTr at: 1.
  27857.             sampleguard := currentTr at: 2.
  27858.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  27859.             sampleguard = 'nil'
  27860.                 ifTrue: [table add: preamble , '. ']
  27861.                 ifFalse: 
  27862.                     [prologType = #quintus
  27863.                         ifTrue: 
  27864.                             [preamble := preamble , ' :-'.
  27865.                             table add: preamble]
  27866.                         ifFalse: [preamble := preamble , '{'].
  27867.                     supplement := self makeGuard: sampleguard for: prologType.
  27868.                     count := 1.
  27869.                     [count > supplement size]
  27870.                         whileFalse: 
  27871.                             [temp1 := supplement at: count.
  27872.                             temp1 := TTMList
  27873.                                         inString: temp1
  27874.                                         replace: '%'
  27875.                                         with: ' mod '.
  27876.                             temp1 := TTMList
  27877.                                         inString: temp1
  27878.                                         replace: '/'
  27879.                                         with: ' div '.
  27880.                             prologType = #quintus
  27881.                                 ifTrue: [(self isArithmetic: temp1)
  27882.                                         = true & ((self containLtOrGt: temp1)
  27883.                                             = false)
  27884.                                         ifTrue: 
  27885.                                             [temp1 := TTMList
  27886.                                                         inString: temp1
  27887.                                                         replace: '='
  27888.                                                         with: ' =:= '.
  27889.                                             temp1 := TTMList
  27890.                                                         inString: temp1
  27891.                                                         replace: '#'
  27892.                                                         with: ' =\= '.
  27893.                                             table add: temp1]
  27894.                                         ifFalse: 
  27895.                                             [temp1 := TTMList
  27896.                                                         inString: temp1
  27897.                                                         replace: '#'
  27898.                                                         with: ' \= '.
  27899.                                             table add: temp1]]
  27900.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  27901.                             count := count + 1]].
  27902.             trCount := trCount + 1].
  27903.     ^table! !
  27904.  
  27905. !TTMList class methodsFor: 'instance creation'!
  27906. open: aTTMListModel 
  27907.     "Assemble the components of the view and open it on 
  27908.     aTTMListModel."
  27909.  
  27910.     | window container iButton eButton dataView activityView rButton gButton oButton sButton tButton hButton ttmListView myWrapper backColor partColor left top hsize vsize hspace vspace originalTop cButton notePadView sfHeadView sfView gsButton qiButton qButton |
  27911.     aTTMListModel currentDirectory: Filename currentDirectory.
  27912.     backColor := ColorValue veryLightGray.
  27913.     partColor := ColorValue white.
  27914.     window := ScheduledWindow new.
  27915.     window insideColor: partColor.
  27916.     window label: 'Build V.0.985'.
  27917.     window minimumSize: 550 @ 500.
  27918.     window model: TTMListWindow new.
  27919.     container := CompositePart new.
  27920.     originalTop := 0.83.
  27921.     left := 0.06.
  27922.     top := originalTop.
  27923.     hsize := 0.195.
  27924.     vsize := 0.04.
  27925.     hspace := 0.22.
  27926.     vspace := 0.05.
  27927.     (container add: ' ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  27928.         insideColor: backColor.    "Button for adding a ttm to the list"
  27929.     iButton := PushButton named: 'Add TTM'.
  27930.     iButton model: ((PluggableAdaptor on: aTTMListModel)
  27931.             getBlock: [:model | false]
  27932.             putBlock: [:model :value | model doAdd]
  27933.             updateBlock: [:model :value :parameter | false]).
  27934.     (container add: iButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27935.         insideColor: ColorValue white.
  27936.     top := top + vspace.    "Button for removing a ttm from the list"
  27937.     eButton := PushButton named: 'Remove TTM'.
  27938.     eButton model: ((PluggableAdaptor on: aTTMListModel)
  27939.             getBlock: [:model | false]
  27940.             putBlock: [:model :value | model doRemove]
  27941.             updateBlock: [:model :value :parameter | false]).
  27942.     (container add: eButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27943.         insideColor: ColorValue white.
  27944.     top := top + vspace.    "Button for renaming the current ttm"
  27945.     rButton := PushButton named: 'Rename TTM'.
  27946.     rButton model: ((PluggableAdaptor on: aTTMListModel)
  27947.             getBlock: [:model | false]
  27948.             putBlock: [:model :value | model doRename]
  27949.             updateBlock: [:model :value :parameter | false]).
  27950.     (container add: rButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27951.         insideColor: ColorValue white.
  27952.     top := originalTop.
  27953.     left := left + hspace.    "Button for copying the selected ttm."
  27954.     cButton := PushButton named: 'Copy TTM'.
  27955.     cButton model: ((PluggableAdaptor on: aTTMListModel)
  27956.             getBlock: [:model | false]
  27957.             putBlock: [:model :value | model doCopy]
  27958.             updateBlock: [:model :value :parameter | false]).
  27959.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27960.         insideColor: ColorValue white.
  27961.     top := top + vspace.    "Button for opening the selected ttm."
  27962.     oButton := PushButton named: 'Edit TTM'.
  27963.     oButton model: ((PluggableAdaptor on: aTTMListModel)
  27964.             getBlock: [:model | false]
  27965.             putBlock: [:model :value | model doEdit]
  27966.             updateBlock: [:model :value :parameter | false]).
  27967.     (container add: oButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27968.         insideColor: ColorValue white.
  27969.     top := top + vspace.    "Button for specifying ICs selected ttm"
  27970.     qiButton := PushButton named: 'Specify IC'.
  27971.     qiButton model: ((PluggableAdaptor on: aTTMListModel)
  27972.             getBlock: [:model | false]
  27973.             putBlock: [:model :value | model doConditions]
  27974.             updateBlock: [:model :value :parameter | false]).
  27975.     (container add: qiButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27976.         insideColor: ColorValue white.
  27977.     top := originalTop.
  27978.     left := left + hspace.    "Button for getting querying the TTM"
  27979.     tButton := PushButton named: 'Query TTM'.
  27980.     tButton model: ((PluggableAdaptor on: aTTMListModel)
  27981.             getBlock: [:model | false]
  27982.             putBlock: [:model :value | model doQuery]
  27983.             updateBlock: [:model :value :parameter | false]).
  27984.     (container add: tButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27985.         insideColor: ColorValue white.
  27986.     top := top + vspace.    "Button for simulation of selected ttm"
  27987.     sButton := PushButton named: 'Simulate TTM'.
  27988.     sButton model: ((PluggableAdaptor on: aTTMListModel)
  27989.             getBlock: [:model | false]
  27990.             putBlock: [:model :value | model doSimulate]
  27991.             updateBlock: [:model :value :parameter | false]).
  27992.     (container add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  27993.         insideColor: ColorValue white.
  27994.     top := top + vspace.    "Button for generating code for the selected ttm"
  27995.     gButton := PushButton named: 'Generate Code'.
  27996.     gButton model: ((PluggableAdaptor on: aTTMListModel)
  27997.             getBlock: [:model | false]
  27998.             putBlock: [:model :value | model doGenerate]
  27999.             updateBlock: [:model :value :parameter | false]).
  28000.     (container add: gButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  28001.         insideColor: ColorValue white.
  28002.     top := originalTop.
  28003.     left := left + hspace.    "Button for filing access"
  28004.     gsButton := PushButton named: 'File Access'.
  28005.     gsButton model: ((PluggableAdaptor on: aTTMListModel)
  28006.             getBlock: [:model | false]
  28007.             putBlock: [:model :value | model doFileAccess]
  28008.             updateBlock: [:model :value :parameter | false]).
  28009.     (container add: gsButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  28010.         insideColor: ColorValue white.
  28011.     top := top + vspace.    "Button for getting help"
  28012.     hButton := PushButton named: 'Help' asText allBold.
  28013.     hButton model: ((PluggableAdaptor on: aTTMListModel)
  28014.             getBlock: [:model | false]
  28015.             putBlock: [:model :value | HelpScreens openHelp: 'introduction']
  28016.             updateBlock: [:model :value :parameter | false]).
  28017.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  28018.         insideColor: ColorValue white.
  28019.     top := top + vspace.    "Button for quitting"
  28020.     qButton := PushButton named: 'Exit Program'.
  28021.     qButton model: ((PluggableAdaptor on: aTTMListModel)
  28022.             getBlock: [:model | false]
  28023.             putBlock: [:model :value | TTMList closeWindowAndConfirm]
  28024.             updateBlock: [:model :value :parameter | false]).
  28025.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  28026.         insideColor: ColorValue white.    "TTM listing view"
  28027.     ttmListView := SelectionInListView
  28028.                 on: aTTMListModel
  28029.                 printItems: false
  28030.                 oneItem: false
  28031.                 aspect: #transaction
  28032.                 change: #selection:
  28033.                 list: #ttmList
  28034.                 menu: #ttmListMenu
  28035.                 initialSelection: nil
  28036.                 useIndex: true.
  28037.     myWrapper := self wrap: (LookPreferences edgeDecorator on: ttmListView).
  28038.     (container add: myWrapper borderedIn: (0.02 @ 0.06 extent: 0.5 @ 0.35))
  28039.         insideColor: partColor.
  28040.     self labelWrap: (container add: ' List Of Existing TTMs:' asText allBold asComposedText borderedIn: (0.02 @ 0.02 extent: 0.5 @ 0.04)).    "Note Pad View"
  28041.     notePadView := TextView
  28042.                 on: aTTMListModel
  28043.                 aspect: #noteList
  28044.                 change: #noteAccept:
  28045.                 menu: #noteMenu
  28046.                 initialSelection: nil.
  28047.     myWrapper := self wrap: (LookPreferences edgeDecorator on: notePadView).
  28048.     (container add: myWrapper borderedIn: (0.02 @ 0.46 extent: 0.5 @ 0.15))
  28049.         insideColor: partColor.
  28050.     self labelWrap: (container add: ' Note Pad:' asText allBold asComposedText borderedIn: (0.02 @ 0.42 extent: 0.5 @ 0.04)).    "Activity Variable view"
  28051.     activityView := SelectionInListView
  28052.                 on: aTTMListModel
  28053.                 printItems: false
  28054.                 oneItem: false
  28055.                 aspect: #avTransaction
  28056.                 change: #avSelection:
  28057.                 list: #avList
  28058.                 menu: #avMenu
  28059.                 initialSelection: nil
  28060.                 useIndex: true.
  28061.     myWrapper := self wrap: (LookPreferences edgeDecorator on: activityView).
  28062.     (container add: myWrapper borderedIn: (0.54 @ 0.06 extent: 0.44 @ 0.24))
  28063.         insideColor: partColor.
  28064.     self labelWrap: (container add: ' Activity Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.02 extent: 0.44 @ 0.04)).    "Data Variable view"
  28065.     dataView := SelectionInListView
  28066.                 on: aTTMListModel
  28067.                 printItems: false
  28068.                 oneItem: false
  28069.                 aspect: #dvTransaction
  28070.                 change: #dvSelection:
  28071.                 list: #dvList
  28072.                 menu: #dvMenu
  28073.                 initialSelection: nil
  28074.                 useIndex: true.
  28075.     myWrapper := self wrap: (LookPreferences edgeDecorator on: dataView).
  28076.     (container add: myWrapper borderedIn: (0.54 @ 0.36 extent: 0.44 @ 0.24))
  28077.         insideColor: partColor.
  28078.     self labelWrap: (container add: ' Data Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.32 extent: 0.44 @ 0.04)).    "channelView := SelectionInListView 
  28079.     on: aTTMListModel 
  28080.     printItems: false 
  28081.     oneItem: false 
  28082.     aspect: #chTransaction 
  28083.     change: #chSelection: 
  28084.     list: #chList 
  28085.     menu: #chMenu 
  28086.     initialSelection: nil 
  28087.     useIndex: true. 
  28088.     myWrapper := self wrap: (LookPreferences edgeDecorator on: 
  28089.     channelView). 
  28090.     (container add: myWrapper borderedIn: (0.54 @ 0.46 extent: 0.44 @ 
  28091.     0.15)) 
  28092.     insideColor: partColor. 
  28093.     self labelWrap: (container add: ' Communication Channels:' asText 
  28094.     allBold asComposedText borderedIn: (0.54 @ 0.42 extent: 0.44 @ 
  28095.     0.04))."
  28096.     sfHeadView := SelectionInListView
  28097.                 on: aTTMListModel
  28098.                 printItems: false
  28099.                 oneItem: false
  28100.                 aspect: #sfTransaction
  28101.                 change: #sfSelection:
  28102.                 list: #sfList
  28103.                 menu: #sfMenu
  28104.                 initialSelection: nil
  28105.                 useIndex: true.
  28106.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfHeadView).
  28107.     (container add: myWrapper borderedIn: (0.02 @ 0.66 extent: 0.28 @ 0.15))
  28108.         insideColor: partColor.
  28109.     self labelWrap: (container add: ' SFs:' asText allBold asComposedText borderedIn: (0.02 @ 0.62 extent: 0.28 @ 0.04)).
  28110.     sfView := TextView
  28111.                 on: aTTMListModel
  28112.                 aspect: #curSFList
  28113.                 change: #curSFAccept:
  28114.                 menu: #curSFMenu
  28115.                 initialSelection: nil.
  28116.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfView).
  28117.     (container add: myWrapper borderedIn: (0.32 @ 0.66 extent: 0.66 @ 0.15))
  28118.         insideColor: partColor.
  28119.     self labelWrap: (container add: ' Current SF:' asText allBold asComposedText borderedIn: (0.32 @ 0.62 extent: 0.66 @ 0.04)).
  28120.     window component: container.
  28121.     window open! !
  28122.  
  28123. TTMList open!
  28124.  
  28125. Object subclass: #GraphNode
  28126.     instanceVariableNames: ''
  28127.     classVariableNames: ''
  28128.     poolDictionaries: ''
  28129.     category: 'Collections-Graph Nodes'!
  28130. GraphNode comment:
  28131. '=================================================
  28132.     Copyright (c) 1992 by Justin O. Graver.
  28133.     All rights reserved (with exceptions).
  28134.     For complete information evaluate "Object tgenCopyright."
  28135. =================================================
  28136.  
  28137. I am an abstract class of graph nodes.'!
  28138.  
  28139. GraphNode comment:
  28140. '=================================================
  28141.     Copyright (c) 1992 by Justin O. Graver.
  28142.     All rights reserved (with exceptions).
  28143.     For complete information evaluate "Object tgenCopyright."
  28144. =================================================
  28145.  
  28146. I am an abstract class of graph nodes.'!
  28147.  
  28148. GraphNode subclass: #EdgeLabeledDigraphNode
  28149.     instanceVariableNames: 'edgeLabelMap '
  28150.     classVariableNames: ''
  28151.     poolDictionaries: ''
  28152.     category: 'Collections-Graph Nodes'!
  28153. EdgeLabeledDigraphNode comment:
  28154. '=================================================
  28155.     Copyright (c) 1992 by Justin O. Graver.
  28156.     All rights reserved (with exceptions).
  28157.     For complete information evaluate "Object tgenCopyright."
  28158. =================================================
  28159.  
  28160. I represent a node in an edge-labeled digraph.
  28161.  
  28162. Instance Variables:
  28163.  
  28164.     edgeLabelMap        <SetDictionary from: labels to: successors>'!
  28165.  
  28166. EdgeLabeledDigraphNode comment:
  28167. '=================================================
  28168.     Copyright (c) 1992 by Justin O. Graver.
  28169.     All rights reserved (with exceptions).
  28170.     For complete information evaluate "Object tgenCopyright."
  28171. =================================================
  28172.  
  28173. I represent a node in an edge-labeled digraph.
  28174.  
  28175. Instance Variables:
  28176.  
  28177.     edgeLabelMap        <SetDictionary from: labels to: successors>'!
  28178.  
  28179. !EdgeLabeledDigraphNode methodsFor: 'accessing'!
  28180. successors
  28181.  
  28182.     ^self edgeLabelMap elements! !
  28183.  
  28184. !EdgeLabeledDigraphNode methodsFor: 'state accessing'!
  28185. edgeLabelMap
  28186.  
  28187.     ^edgeLabelMap! !
  28188.  
  28189. !EdgeLabeledDigraphNode methodsFor: 'state accessing'!
  28190. edgeLabelMap: argument 
  28191.  
  28192.     edgeLabelMap := argument! !
  28193.  
  28194. !EdgeLabeledDigraphNode methodsFor: 'initialization'!
  28195. init
  28196.  
  28197.     self edgeLabelMap: SetDictionary new! !
  28198.  
  28199. !EdgeLabeledDigraphNode methodsFor: 'enumerating'!
  28200. successorsDo: aBlock 
  28201.  
  28202.     self successors do: aBlock! !
  28203.  
  28204. !EdgeLabeledDigraphNode methodsFor: 'enumerating'!
  28205. successorsExceptSelfDo: aBlock 
  28206.  
  28207.     (self successors reject: [:succ | succ = self])
  28208.         do: aBlock! !
  28209.  
  28210. !EdgeLabeledDigraphNode methodsFor: 'modifying'!
  28211. addSuccessor: node withEdgeLabeled: label 
  28212.  
  28213.     self edgeLabelMap at: label add: node! !
  28214.  
  28215. !EdgeLabeledDigraphNode methodsFor: 'printing'!
  28216. printOn: aStream 
  28217.  
  28218.     self hash printOn: aStream.
  28219.     aStream nextPutAll: ': '; crtab.
  28220.     self edgeLabelMap
  28221.         associationsDo: 
  28222.             [:assoc | 
  28223.             assoc key printOn: aStream.
  28224.             aStream nextPutAll: ' ==> '.
  28225.             assoc value hash printOn: aStream.
  28226.             aStream crtab]! !
  28227.  
  28228. !EdgeLabeledDigraphNode methodsFor: 'converting'!
  28229. spaceOptimizeMap
  28230.     "Assumes self edgeLabelMap isDeterministic. 
  28231.     Note: doing this will dissable the messages #successors, 
  28232.     #addSuccessor:withEdgeLabeled:, and any senders of them, 
  28233.     since they assume a SetDictionary."
  28234.  
  28235.     self edgeLabelMap: self edgeLabelMap asDictionary! !
  28236.  
  28237. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  28238.  
  28239. EdgeLabeledDigraphNode class
  28240.     instanceVariableNames: ''!
  28241.  
  28242. !EdgeLabeledDigraphNode class methodsFor: 'instance creation'!
  28243. new
  28244.  
  28245.     ^super new init! !
  28246.  
  28247. GraphNode subclass: #DirectedGraphNode
  28248.     instanceVariableNames: 'predecessors '
  28249.     classVariableNames: ''
  28250.     poolDictionaries: ''
  28251.     category: 'Collections-Graph Nodes'!
  28252. DirectedGraphNode comment:
  28253. '=================================================
  28254.     Copyright (c) 1992 by Justin O. Graver.
  28255.     All rights reserved (with exceptions).
  28256.     For complete information evaluate "Object tgenCopyright."
  28257. =================================================
  28258.  
  28259. I maintain a collection of my predecessor nodes.
  28260.  
  28261. Instance Variables:
  28262.     predecessors        <OrderedCollection of: DirectedGraphNode>'!
  28263.  
  28264. DirectedGraphNode comment:
  28265. '=================================================
  28266.     Copyright (c) 1992 by Justin O. Graver.
  28267.     All rights reserved (with exceptions).
  28268.     For complete information evaluate "Object tgenCopyright."
  28269. =================================================
  28270.  
  28271. I maintain a collection of my predecessor nodes.
  28272.  
  28273. Instance Variables:
  28274.     predecessors        <OrderedCollection of: DirectedGraphNode>'!
  28275.  
  28276. !DirectedGraphNode methodsFor: 'state accessing'!
  28277. predecessors
  28278.  
  28279.     ^predecessors! !
  28280.  
  28281. !DirectedGraphNode methodsFor: 'state accessing'!
  28282. predecessors: argument 
  28283.  
  28284.     predecessors := argument! !
  28285.  
  28286. !DirectedGraphNode methodsFor: 'initialization'!
  28287. init
  28288.  
  28289.     self predecessors: OrderedCollection new! !
  28290.  
  28291. !DirectedGraphNode methodsFor: 'modifying'!
  28292. addPredecessor: node 
  28293.  
  28294.     self predecessors add: node! !
  28295.  
  28296. !DirectedGraphNode methodsFor: 'modifying'!
  28297. removePredecessor: node 
  28298.  
  28299.     self predecessors remove: node ifAbsent: [self error: 'precedessor not found']! !
  28300.  
  28301. !DirectedGraphNode methodsFor: 'modifying'!
  28302. removePredecessor: node ifAbsent: aBlock 
  28303.  
  28304.     self predecessors remove: node ifAbsent: [^aBlock value]! !
  28305.  
  28306. !DirectedGraphNode methodsFor: 'enumerating'!
  28307. predecessorsDo: aBlock 
  28308.     "Evaluate aBlock with each of my predecessors."
  28309.  
  28310.     self predecessors do: aBlock! !
  28311.  
  28312. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  28313.  
  28314. DirectedGraphNode class
  28315.     instanceVariableNames: ''!
  28316.  
  28317. !DirectedGraphNode class methodsFor: 'instance creation'!
  28318. new
  28319.  
  28320.     ^super new init! !
  28321.  
  28322. DirectedGraphNode subclass: #NodeLabeledDigraphNode
  28323.     instanceVariableNames: 'label '
  28324.     classVariableNames: ''
  28325.     poolDictionaries: ''
  28326.     category: 'Collections-Graph Nodes'!
  28327. NodeLabeledDigraphNode comment:
  28328. '=================================================
  28329.     Copyright (c) 1992 by Justin O. Graver.
  28330.     All rights reserved (with exceptions).
  28331.     For complete information evaluate "Object tgenCopyright."
  28332. =================================================
  28333.  
  28334. I add labels to my nodes.  Node labels are assumed to be unique (see LabeledDigraph) although hashing and such is still done based on the node itself.
  28335.  
  28336. Instance Variables:
  28337.     label    <String>'!
  28338.  
  28339. NodeLabeledDigraphNode comment:
  28340. '=================================================
  28341.     Copyright (c) 1992 by Justin O. Graver.
  28342.     All rights reserved (with exceptions).
  28343.     For complete information evaluate "Object tgenCopyright."
  28344. =================================================
  28345.  
  28346. I add labels to my nodes.  Node labels are assumed to be unique (see LabeledDigraph) although hashing and such is still done based on the node itself.
  28347.  
  28348. Instance Variables:
  28349.     label    <String>'!
  28350.  
  28351. !NodeLabeledDigraphNode methodsFor: 'state accessing'!
  28352. label
  28353.  
  28354.     ^label! !
  28355.  
  28356. !NodeLabeledDigraphNode methodsFor: 'state accessing'!
  28357. label: argument 
  28358.  
  28359.     label := argument! !
  28360.  
  28361. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  28362.  
  28363. NodeLabeledDigraphNode class
  28364.     instanceVariableNames: ''!
  28365.  
  28366. !NodeLabeledDigraphNode class methodsFor: 'instance creation'!
  28367. label: arg1 
  28368.  
  28369.     | newMe |
  28370.     newMe := self new.
  28371.     newMe label: arg1.
  28372.     ^newMe! !
  28373.  
  28374. Object subclass: #TreeNode
  28375.     instanceVariableNames: ''
  28376.     classVariableNames: ''
  28377.     poolDictionaries: ''
  28378.     category: 'Collections-Graph Nodes'!
  28379. TreeNode comment:
  28380. '=================================================
  28381.     Copyright (c) 1992 by Justin O. Graver.
  28382.     All rights reserved (with exceptions).
  28383.     For complete information evaluate "Object tgenCopyright."
  28384. =================================================
  28385.  
  28386. This abstract class provides the framework for both destructive and non-destructive tree traversals in which references to locally global objects are available without being explicitly passed as arguments.
  28387.  
  28388. Concrete subclasses must implement methods for traversing
  28389.  
  28390.     childrenDo:
  28391.         "Evaluate the argument block with each of my children."
  28392.  
  28393.     updateChildrenUsing:
  28394.         "Replace my children with the result of evaluating the argument block with the corresponding child."'!
  28395.  
  28396. TreeNode comment:
  28397. '=================================================
  28398.     Copyright (c) 1992 by Justin O. Graver.
  28399.     All rights reserved (with exceptions).
  28400.     For complete information evaluate "Object tgenCopyright."
  28401. =================================================
  28402.  
  28403. This abstract class provides the framework for both destructive and non-destructive tree traversals in which references to locally global objects are available without being explicitly passed as arguments.
  28404.  
  28405. Concrete subclasses must implement methods for traversing
  28406.  
  28407.     childrenDo:
  28408.         "Evaluate the argument block with each of my children."
  28409.  
  28410.     updateChildrenUsing:
  28411.         "Replace my children with the result of evaluating the argument block with the corresponding child."'!
  28412.  
  28413. !TreeNode methodsFor: 'traversing'!
  28414. childrenDo: aBlock
  28415.     "Evaluate aBlock for each of my children.
  28416.     This message should be reimplemented by my subclasses."
  28417.  
  28418.     ^self        "default"! !
  28419.  
  28420. !TreeNode methodsFor: 'traversing'!
  28421. preorderDo: preBlock updateUsing: postBlock 
  28422.     "Perform a traversal on myself and my children.  The preBlock is
  28423.     evaluated when first entering a node.  My children are replaced
  28424.     with the results of the traversal.  Thus, this message can be used
  28425.     to generate objects or alter my structure, whereas postorderDo:
  28426.     can only be used to examine my structure.  This message may be
  28427.     used in the following manner. 
  28428.      
  28429.     a := aMethodNode
  28430.         preorderDo: [:node | node msg1]
  28431.         updateUsing: [:node | node msg2: globalRef]"
  28432.  
  28433.     preBlock value: self.
  28434.     self updateChildrenUsing: [:child | child preorderDo: preBlock updateUsing: postBlock].
  28435.     ^postBlock value: self! !
  28436.  
  28437. !TreeNode methodsFor: 'traversing'!
  28438. updateChildrenUsing: aBlock
  28439.     "Replace my children according to the value of aBlock.
  28440.     This message should be reimplemented by my subclasses."
  28441.  
  28442.     ^self        "default"! !
  28443.  
  28444. !TreeNode methodsFor: 'traversing'!
  28445. updateCopyUsing: aBlock 
  28446.     "Perform a postorder traversal on a copy of myself and
  28447.     my children, replacing my children with the results of the traversal. 
  28448.     Thus, this message can be used to generate objects or alter 
  28449.     my structure, whereas postorderDo: can only be used to examine 
  28450.     my structure.  This message may be used in the following manner. 
  28451.      
  28452.     a := aMethodNode updateCopyUsing: [:node | node msg: globalRef]"
  28453.  
  28454.     | newNode |
  28455.     newNode := self copy.
  28456.     newNode updateChildrenUsing: [:child | child updateCopyUsing: aBlock].
  28457.     ^aBlock value: newNode! !
  28458.  
  28459. !TreeNode methodsFor: 'traversing'!
  28460. updateUsing: aBlock 
  28461.     "Perform a postorder traversal on myself and my children, 
  28462.     replacing my children with the results of the traversal. 
  28463.     Thus, this message can be used to generate objects or alter 
  28464.     my structure, whereas postorderDo: can only be used to examine 
  28465.     my structure.  This message may be used in the following manner. 
  28466.      
  28467.     a := aMethodNode updateUsing: [:node | node msg: globalRef]"
  28468.  
  28469.     self updateChildrenUsing: [:child | child updateUsing: aBlock].
  28470.     ^aBlock value: self! !
  28471.  
  28472. !TreeNode methodsFor: 'copying'!
  28473. copyTree
  28474.     "Answer a copy of this tree."
  28475.  
  28476.     ^self copy updateChildrenUsing: [:child | child copyTree]! !
  28477.  
  28478. !TreeNode methodsFor: 'enumerating'!
  28479. postorderDo: aBlock
  28480.     "Perform a postorder traversal on myself and my children.
  28481.     This message may be used for examining the nodes of a tree
  28482.     for the purpose of gathering data or altering data fields.
  28483.     To alter the structure of the tree see traverseDo:.  One of
  28484.     the main advantages of this message is that it allows all nodes
  28485.     of the tree 'global' access to objects referenced in aBlock.
  28486.     Before, such arguments had to be passed explitely as arguments.
  28487.     This message may be used as follows.
  28488.  
  28489.     aMethodNode postorderDo: [:node | node enc: encoder root: self]"
  28490.  
  28491.     self childrenDo: [:child | child postorderDo: aBlock].
  28492.     aBlock value: self! !
  28493.  
  28494. !TreeNode methodsFor: 'enumerating'!
  28495. preorderDo: preBlock postorderDo: postBlock 
  28496.     "Perform a traversal on myself and my children.  The preBlock is 
  28497.     evaluated when entering a node and postBlock is evaluated just before 
  28498.     leaving.  See comment in postorderDo:."
  28499.  
  28500.     preBlock value: self.
  28501.     self childrenDo: [:child | child preorderDo: preBlock postorderDo: postBlock].
  28502.     postBlock value: self! !
  28503.  
  28504. EdgeLabeledDigraphNode subclass: #FSAState
  28505.     instanceVariableNames: ''
  28506.     classVariableNames: ''
  28507.     poolDictionaries: ''
  28508.     category: 'T-gen-Scanning/Parsing'!
  28509.  
  28510. FSAState subclass: #BidirectionalEdgeLabeledDigraphNode
  28511.     instanceVariableNames: 'predecessorLabelMap '
  28512.     classVariableNames: ''
  28513.     poolDictionaries: ''
  28514.     category: 'Collections-Graph Nodes'!
  28515. BidirectionalEdgeLabeledDigraphNode comment:
  28516. '=================================================
  28517.     Copyright (c) 1992 by Justin O. Graver.
  28518.     All rights reserved (with exceptions).
  28519.     For complete information evaluate "Object tgenCopyright."
  28520. =================================================
  28521.  
  28522. I represent a node in an edge-labeled digraph.  I maintain edges in both directions, i.e. I can follow edges forwards or backwards.
  28523.  
  28524. Instance Variables:
  28525.  
  28526.     predecessorLabelMap        <SetDictionary from: labels to: predecessors>'!
  28527.  
  28528. BidirectionalEdgeLabeledDigraphNode comment:
  28529. '=================================================
  28530.     Copyright (c) 1992 by Justin O. Graver.
  28531.     All rights reserved (with exceptions).
  28532.     For complete information evaluate "Object tgenCopyright."
  28533. =================================================
  28534.  
  28535. I represent a node in an edge-labeled digraph.  I maintain edges in both directions, i.e. I can follow edges forwards or backwards.
  28536.  
  28537. Instance Variables:
  28538.  
  28539.     predecessorLabelMap        <SetDictionary from: labels to: predecessors>'!
  28540.  
  28541. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'state accessing'!
  28542. predecessorLabelMap
  28543.  
  28544.     ^predecessorLabelMap! !
  28545.  
  28546. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'state accessing'!
  28547. predecessorLabelMap: argument 
  28548.  
  28549.     predecessorLabelMap := argument! !
  28550.  
  28551. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'initialization'!
  28552. init
  28553.  
  28554.     super init.
  28555.     self predecessorLabelMap: SetDictionary new! !
  28556.  
  28557. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'modifying'!
  28558. addPredecessor: node withEdgeLabeled: label 
  28559.  
  28560.     self predecessorLabelMap at: label add: node! !
  28561.  
  28562. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'accessing'!
  28563. predecessors
  28564.  
  28565.     ^self predecessorLabelMap elements! !
  28566.  
  28567. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'enumerating'!
  28568. predecessorsDo: aBlock 
  28569.  
  28570.     self predecessors do: aBlock! !
  28571.  
  28572. !BidirectionalEdgeLabeledDigraphNode methodsFor: 'enumerating'!
  28573. predecessorsExceptSelfDo: aBlock 
  28574.  
  28575.     (self predecessors reject: [:pred | pred = self])
  28576.         do: aBlock! !
  28577.  
  28578. Object subclass: #AbstractParser
  28579.     instanceVariableNames: 'scanner prevToken requestor failBlock '
  28580.     classVariableNames: ''
  28581.     poolDictionaries: ''
  28582.     category: 'Compilers-Parsers'!
  28583. AbstractParser comment:
  28584. '=================================================
  28585.     Copyright (c) 1992 by Justin O. Graver.
  28586.     All rights reserved (with exceptions).
  28587.     For complete information evaluate "Object tgenCopyright."
  28588. =================================================
  28589.  
  28590. This class represents abstract parsing behavior.
  28591.  
  28592. Instance Variables:
  28593.  
  28594.     scanner <a scanner class>    - this parser''s scanner
  28595.     prevToken <String + Symbol>    - the last token scanned
  28596.     requestor <Controller + Object>    - the object invoking the parser, errors are reported to this object
  28597.     failBlock <Block>        - this block is evaluated before the parse is aborted'!
  28598.  
  28599. AbstractParser comment:
  28600. '=================================================
  28601.     Copyright (c) 1992 by Justin O. Graver.
  28602.     All rights reserved (with exceptions).
  28603.     For complete information evaluate "Object tgenCopyright."
  28604. =================================================
  28605.  
  28606. This class represents abstract parsing behavior.
  28607.  
  28608. Instance Variables:
  28609.  
  28610.     scanner <a scanner class>    - this parser''s scanner
  28611.     prevToken <String + Symbol>    - the last token scanned
  28612.     requestor <Controller + Object>    - the object invoking the parser, errors are reported to this object
  28613.     failBlock <Block>        - this block is evaluated before the parse is aborted'!
  28614.  
  28615. !AbstractParser methodsFor: 'state accessing'!
  28616. failBlock
  28617.  
  28618.     ^failBlock! !
  28619.  
  28620. !AbstractParser methodsFor: 'state accessing'!
  28621. failBlock: argument 
  28622.  
  28623.     failBlock := argument! !
  28624.  
  28625. !AbstractParser methodsFor: 'state accessing'!
  28626. prevToken
  28627.  
  28628.     ^prevToken! !
  28629.  
  28630. !AbstractParser methodsFor: 'state accessing'!
  28631. prevToken: argument 
  28632.  
  28633.     prevToken := argument! !
  28634.  
  28635. !AbstractParser methodsFor: 'state accessing'!
  28636. requestor
  28637.  
  28638.     ^requestor! !
  28639.  
  28640. !AbstractParser methodsFor: 'state accessing'!
  28641. requestor: argument 
  28642.  
  28643.     requestor := argument! !
  28644.  
  28645. !AbstractParser methodsFor: 'state accessing'!
  28646. scanner
  28647.  
  28648.     ^scanner! !
  28649.  
  28650. !AbstractParser methodsFor: 'state accessing'!
  28651. scanner: argument 
  28652.  
  28653.     scanner := argument! !
  28654.  
  28655. !AbstractParser methodsFor: 'scanning'!
  28656. endOfInput
  28657.     "Some parsers may use the eof token while others may use the eof token type."
  28658.  
  28659.     self subclassResponsibility! !
  28660.  
  28661. !AbstractParser methodsFor: 'scanning'!
  28662. endOfInputToken
  28663.     "Answer the token used by my scanner to represent the end of the input."
  28664.  
  28665.     ^self scanner endOfInputToken! !
  28666.  
  28667. !AbstractParser methodsFor: 'scanning'!
  28668. endOfInputTokenType
  28669.     "Answer the token type used by my scanner to represent the end of the input."
  28670.  
  28671.     ^self scanner endOfInputTokenType! !
  28672.  
  28673. !AbstractParser methodsFor: 'scanning'!
  28674. initScannerSource: aString 
  28675.     "The scanner is responsible for scanning the first token (i.e. for priming the token 
  28676.     buffers)."
  28677.  
  28678.     self scanner scanSource: aString! !
  28679.  
  28680. !AbstractParser methodsFor: 'scanning'!
  28681. nextToken
  28682.  
  28683.     ^self scanner tokenType! !
  28684.  
  28685. !AbstractParser methodsFor: 'scanning'!
  28686. nextTokenValue
  28687.  
  28688.     ^self scanner token! !
  28689.  
  28690. !AbstractParser methodsFor: 'scanning'!
  28691. scanToken
  28692.     "Subclasses may not always want the previous token value and may override this 
  28693.     method for efficiency."
  28694.  
  28695.     self prevToken: self nextTokenValue.
  28696.     self scanner scanToken! !
  28697.  
  28698. !AbstractParser methodsFor: 'private'!
  28699. scannerClass
  28700.     "Answer the preferred class of scanners for this kind of parser."
  28701.  
  28702.     self subclassResponsibility! !
  28703.  
  28704. !AbstractParser methodsFor: 'initialization'!
  28705. init
  28706.  
  28707.     self scanner: self scannerClass new! !
  28708.  
  28709. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  28710.  
  28711. AbstractParser class
  28712.     instanceVariableNames: ''!
  28713.  
  28714. !AbstractParser class methodsFor: 'instance creation'!
  28715. new
  28716.  
  28717.     ^super new init! !
  28718.  
  28719. AbstractParser subclass: #RecursiveDescentParser
  28720.     instanceVariableNames: 'here hereType hereMark prevMark class encoder parseNode lastTempMark correctionDelta '
  28721.     classVariableNames: ''
  28722.     poolDictionaries: ''
  28723.     category: 'Compilers-Parsers'!
  28724. RecursiveDescentParser comment:
  28725. '=================================================
  28726.     Copyright (c) 1992 by Justin O. Graver.
  28727.     All rights reserved (with exceptions).
  28728.     For complete information evaluate "Object tgenCopyright."
  28729. =================================================
  28730.  
  28731. I am an abstract class that provides the framework for creating objects from textual representations using a recursive descent parse.
  28732. This class is what used to be called ''NewCompiler'' in old TS implementations.  It has not been rewritten to reflect its new place in the compiler framework in order to maintain compatibility with the old TS subclasses.  When they are rewritten (when the Tektronix implementation is abandoned) this class should be also.
  28733.  
  28734. Instance Variables:
  28735.     here            <Object> the current token
  28736.     hereType        <Symbol> the "type" of the current token 
  28737.     hereMark        <Integer> position in source stream (mark) where this token began
  28738.     prevToken*    <Integer> size in chars of the previous token parsed
  28739.     prevMark        <Integer> mark of previous token
  28740.     class            <Class> provides a context for the text being parsed
  28741.     encoder        <Encoder> which uses tables to decode tokens
  28742.     parseNode    <ParseNode> intermediate result of current parse (for use by subclasses)
  28743.     lastTempMark <Integer> mark of last temp;
  28744.                         points to vert bar, or last char of pattern if no temps declared
  28745.     correctionDelta    <Integer> offset of corrected code relative to source stream
  28746.                         owing to interactive corrections so far.
  28747.  
  28748. * inherited from AbstractParser, but with new semantics.'!
  28749.  
  28750. RecursiveDescentParser comment:
  28751. '=================================================
  28752.     Copyright (c) 1992 by Justin O. Graver.
  28753.     All rights reserved (with exceptions).
  28754.     For complete information evaluate "Object tgenCopyright."
  28755. =================================================
  28756.  
  28757. I am an abstract class that provides the framework for creating objects from textual representations using a recursive descent parse.
  28758. This class is what used to be called ''NewCompiler'' in old TS implementations.  It has not been rewritten to reflect its new place in the compiler framework in order to maintain compatibility with the old TS subclasses.  When they are rewritten (when the Tektronix implementation is abandoned) this class should be also.
  28759.  
  28760. Instance Variables:
  28761.     here            <Object> the current token
  28762.     hereType        <Symbol> the "type" of the current token 
  28763.     hereMark        <Integer> position in source stream (mark) where this token began
  28764.     prevToken*    <Integer> size in chars of the previous token parsed
  28765.     prevMark        <Integer> mark of previous token
  28766.     class            <Class> provides a context for the text being parsed
  28767.     encoder        <Encoder> which uses tables to decode tokens
  28768.     parseNode    <ParseNode> intermediate result of current parse (for use by subclasses)
  28769.     lastTempMark <Integer> mark of last temp;
  28770.                         points to vert bar, or last char of pattern if no temps declared
  28771.     correctionDelta    <Integer> offset of corrected code relative to source stream
  28772.                         owing to interactive corrections so far.
  28773.  
  28774. * inherited from AbstractParser, but with new semantics.'!
  28775.  
  28776. !RecursiveDescentParser methodsFor: 'public access'!
  28777. compile: textOrStream encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
  28778.     "Answer with the result of the compilation. NOTE: information may be added 
  28779.     to the argument anEncoder during the course of this compilation."
  28780.  
  28781.     | result |
  28782.     self
  28783.         init: textOrStream
  28784.         notifying: aRequestor
  28785.         failBlock: aBlock.
  28786.     class isNil ifTrue: [class := Object].        "some methods rely on class being non-nil"
  28787.     self initEncoder: anEncoder.
  28788.     result := self parse.
  28789.     encoder := failBlock := requestor := parseNode := nil.        "break cycles & mitigate refct overflow"
  28790.     ^result! !
  28791.  
  28792. !RecursiveDescentParser methodsFor: 'public access'!
  28793. compile: textOrStream in: aClass encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
  28794.     "Answer the result of compiling the text in the context of aClass. NOTE: 
  28795.     information 
  28796.     may be added to the argument anEncoder during the course of this compilation."
  28797.  
  28798.     class := aClass.
  28799.     ^self
  28800.         compile: textOrStream
  28801.         encodeIn: anEncoder
  28802.         notifying: aRequestor
  28803.         ifFail: aBlock! !
  28804.  
  28805. !RecursiveDescentParser methodsFor: 'public access'!
  28806. compile: textOrStream in: aClass notifying: aRequestor ifFail: aBlock 
  28807.     "Answer the result of compiling the text in the context of aClass."
  28808.  
  28809.     class := aClass.
  28810.     ^self
  28811.         compile: textOrStream
  28812.         notifying: aRequestor
  28813.         ifFail: aBlock! !
  28814.  
  28815. !RecursiveDescentParser methodsFor: 'public access'!
  28816. compile: textOrStream notifying: aRequestor ifFail: aBlock 
  28817.     "Answer with the result of the compilation."
  28818.  
  28819.     | result |
  28820.     self
  28821.         init: textOrStream
  28822.         notifying: aRequestor
  28823.         failBlock: aBlock.
  28824.     class isNil ifTrue: [class := Object].        "some methods rely on class being non-nil"
  28825.     self initEncoder.
  28826.     result := self parse.
  28827.     encoder := failBlock := requestor := parseNode := nil.        "break cycles & mitigate refct overflow"
  28828.     ^result! !
  28829.  
  28830. !RecursiveDescentParser methodsFor: 'parsing'!
  28831. parse
  28832.     "This is the top level method that controls the (recursive descent) parse."
  28833.  
  28834.     self subclassResponsibility! !
  28835.  
  28836. !RecursiveDescentParser methodsFor: 'comparing'!
  28837. match: type 
  28838.     "Answer with true if next tokens type matches"
  28839.  
  28840.     hereType == type
  28841.         ifTrue: 
  28842.             [self advance.
  28843.             ^true].
  28844.     ^false! !
  28845.  
  28846. !RecursiveDescentParser methodsFor: 'comparing'!
  28847. matchToken: thing 
  28848.     "matches the token, not its type"
  28849.  
  28850.     here = thing
  28851.         ifTrue: 
  28852.             [self advance.
  28853.             ^true].
  28854.     ^false! !
  28855.  
  28856. !RecursiveDescentParser methodsFor: 'scanning'!
  28857. advance
  28858.  
  28859.     | this |
  28860.     prevMark := hereMark.        "Now means prev size"
  28861.     prevToken := hereType == #number | (hereType == #string)
  28862.                 ifTrue: [scanner mark - prevMark]
  28863.                 ifFalse: [here size].
  28864.     this := here.
  28865.     here := scanner nextToken.
  28866.     hereType := scanner nextTokenType.
  28867.     hereMark := scanner mark.
  28868.     scanner scanToken.
  28869.     ^this! !
  28870.  
  28871. !RecursiveDescentParser methodsFor: 'scanning'!
  28872. bareEndOfLastToken
  28873.  
  28874.     ^prevMark + prevToken - 1 + correctionDelta max: 0! !
  28875.  
  28876. !RecursiveDescentParser methodsFor: 'scanning'!
  28877. endOfInput
  28878.     "Use the eof token."
  28879.  
  28880.     ^self endOfInputToken! !
  28881.  
  28882. !RecursiveDescentParser methodsFor: 'scanning'!
  28883. endOfLastToken
  28884.  
  28885.     hereType == #doIt ifTrue: [^prevMark + prevToken + 1 + correctionDelta].
  28886.     scanner atEnd ifTrue: [^prevMark + prevToken + correctionDelta].
  28887.     ^prevMark + prevToken - 1 + correctionDelta! !
  28888.  
  28889. !RecursiveDescentParser methodsFor: 'scanning'!
  28890. reset
  28891.     "Reinitialize the scanner and the parse."
  28892.  
  28893.     scanner reset.
  28894.     prevMark := hereMark := scanner mark.
  28895.     self advance! !
  28896.  
  28897. !RecursiveDescentParser methodsFor: 'scanning'!
  28898. startOfNextToken
  28899.     "return starting position in source of next token"
  28900.  
  28901.     hereType == #doIt ifTrue: [^scanner position + 1 + correctionDelta].
  28902.     ^hereMark + correctionDelta! !
  28903.  
  28904. !RecursiveDescentParser methodsFor: 'error handling'!
  28905. abort
  28906.  
  28907.     | exitBlock |
  28908.     encoder == nil
  28909.         ifFalse: 
  28910.             [encoder release.
  28911.             encoder := nil].        "break cycle"
  28912.     exitBlock := failBlock.
  28913.     failBlock := nil.
  28914.     ^exitBlock value! !
  28915.  
  28916. !RecursiveDescentParser methodsFor: 'error handling'!
  28917. editor
  28918.  
  28919.     ^requestor! !
  28920.  
  28921. !RecursiveDescentParser methodsFor: 'error handling'!
  28922. expected: aString 
  28923.     "Notify a problem at token 'here'"
  28924.  
  28925.     scanner atEnd ifTrue: [hereMark := hereMark + 1].
  28926.     hereType == #doIt ifTrue: [hereMark := hereMark + 1].
  28927.     ^self notify: aString , ' expected ->' at: hereMark + correctionDelta! !
  28928.  
  28929. !RecursiveDescentParser methodsFor: 'error handling'!
  28930. notify: aString 
  28931.     "Notify problem at token before 'here'"
  28932.  
  28933.     ^self notify: aString , ' ->' at: prevMark + correctionDelta! !
  28934.  
  28935. !RecursiveDescentParser methodsFor: 'error handling'!
  28936. notify: aString at: position 
  28937.     "If the editor is nil, pop up a SyntaxError, otherwise have the editor insert 
  28938.     aString."
  28939.  
  28940.     | editor |
  28941.     editor := self editor.
  28942.     Cursor normal show.
  28943.     editor == nil
  28944.         ifTrue: [SyntaxError
  28945.                 errorInClass: class
  28946.                 withCode: (scanner contents
  28947.                         copyReplaceFrom: position
  28948.                         to: position - 1
  28949.                         with: aString)
  28950.                 errorString: aString]
  28951.         ifFalse: [editor insertAndSelect: aString at: (position max: 1)].
  28952.     self abort! !
  28953.  
  28954. !RecursiveDescentParser methodsFor: 'error handling'!
  28955. offEnd: aString 
  28956.     "notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!"
  28957.  
  28958.     ^self notify: aString at: scanner mark + correctionDelta! !
  28959.  
  28960. !RecursiveDescentParser methodsFor: 'private'!
  28961. init: sourceString notifying: req failBlock: aBlock 
  28962.  
  28963.     requestor := req.
  28964.     failBlock := aBlock.
  28965.     correctionDelta := 0.
  28966.     scanner := self preferredScannerClass new.
  28967.     scanner scan: sourceString notifying: self.
  28968.     prevMark := hereMark := scanner mark.
  28969.     self advance! !
  28970.  
  28971. !RecursiveDescentParser methodsFor: 'private'!
  28972. initEncoder
  28973.  
  28974.     self subclassResponsibility! !
  28975.  
  28976. !RecursiveDescentParser methodsFor: 'private'!
  28977. initEncoder: anEncoder 
  28978.  
  28979.     encoder := anEncoder! !
  28980.  
  28981. !RecursiveDescentParser methodsFor: 'private'!
  28982. preferredScannerClass
  28983.  
  28984.     ^self class preferredScannerClass! !
  28985.  
  28986. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  28987.  
  28988. RecursiveDescentParser class
  28989.     instanceVariableNames: ''!
  28990.  
  28991. !RecursiveDescentParser class methodsFor: 'accessing'!
  28992. preferredScannerClass
  28993.     "Answer with a scanner class which is appropiate for scanning tokens used 
  28994.     by this compiler class. Should be overwritten by subclasses."
  28995.  
  28996.     self subclassResponsibility! !
  28997.  
  28998. AbstractParser subclass: #TableDrivenParser
  28999.     instanceVariableNames: 'parseTable transcript treeBuilder '
  29000.     classVariableNames: ''
  29001.     poolDictionaries: ''
  29002.     category: 'Compilers-Parsers'!
  29003. TableDrivenParser comment:
  29004. '=================================================
  29005.     Copyright (c) 1992 by Justin O. Graver.
  29006.     All rights reserved (with exceptions).
  29007.     For complete information evaluate "Object tgenCopyright."
  29008. =================================================
  29009.  
  29010. I am an abstract class representing table (FSA) driven parsers.
  29011.  
  29012.  
  29013. Instance Variables:
  29014.     parseTable    <LL1ParserTable | LRParserState> - basic parsing mechanism.
  29015.     transcript        <TranslatorGenerator | UndefinedObject> - status messages get sent here.
  29016.     treeBuilder    <ParseTreeBuilder> - used in the construction of abstract syntax trees.'!
  29017.  
  29018. TableDrivenParser comment:
  29019. '=================================================
  29020.     Copyright (c) 1992 by Justin O. Graver.
  29021.     All rights reserved (with exceptions).
  29022.     For complete information evaluate "Object tgenCopyright."
  29023. =================================================
  29024.  
  29025. I am an abstract class representing table (FSA) driven parsers.
  29026.  
  29027.  
  29028. Instance Variables:
  29029.     parseTable    <LL1ParserTable | LRParserState> - basic parsing mechanism.
  29030.     transcript        <TranslatorGenerator | UndefinedObject> - status messages get sent here.
  29031.     treeBuilder    <ParseTreeBuilder> - used in the construction of abstract syntax trees.'!
  29032.  
  29033. !TableDrivenParser methodsFor: 'scanning'!
  29034. endOfInput
  29035.     "Use the eof token type."
  29036.  
  29037.     ^self endOfInputTokenType! !
  29038.  
  29039. !TableDrivenParser methodsFor: 'scanning'!
  29040. endOfInputTokenType
  29041.     "Answer the token type used by my scanner to represent the end of the input."
  29042.  
  29043.     ^self scanner endOfInputTokenType! !
  29044.  
  29045. !TableDrivenParser methodsFor: 'state accessing'!
  29046. parseTable
  29047.  
  29048.     ^parseTable! !
  29049.  
  29050. !TableDrivenParser methodsFor: 'state accessing'!
  29051. parseTable: argument 
  29052.  
  29053.     parseTable := argument! !
  29054.  
  29055. !TableDrivenParser methodsFor: 'state accessing'!
  29056. requestor
  29057.  
  29058.     ^requestor! !
  29059.  
  29060. !TableDrivenParser methodsFor: 'state accessing'!
  29061. requestor: argument 
  29062.  
  29063.     requestor := argument! !
  29064.  
  29065. !TableDrivenParser methodsFor: 'state accessing'!
  29066. transcript
  29067.  
  29068.     ^transcript! !
  29069.  
  29070. !TableDrivenParser methodsFor: 'state accessing'!
  29071. transcript: argument 
  29072.  
  29073.     transcript := argument! !
  29074.  
  29075. !TableDrivenParser methodsFor: 'state accessing'!
  29076. treeBuilder
  29077.  
  29078.     ^treeBuilder! !
  29079.  
  29080. !TableDrivenParser methodsFor: 'state accessing'!
  29081. treeBuilder: argument 
  29082.  
  29083.     treeBuilder := argument! !
  29084.  
  29085. !TableDrivenParser methodsFor: 'testing'!
  29086. performsLeftmostDerivation
  29087.     "This is the default, let subclasses override."
  29088.  
  29089.     ^false! !
  29090.  
  29091. !TableDrivenParser methodsFor: 'testing'!
  29092. performsRightmostDerivation
  29093.     "This is the default, let subclasses override."
  29094.  
  29095.     ^false! !
  29096.  
  29097. !TableDrivenParser methodsFor: 'public access'!
  29098. parse: aString ifFail: aBlock 
  29099.  
  29100.     self failBlock: aBlock.
  29101.     self exceptionHandlers
  29102.         handleDo: 
  29103.             [self initScannerSource: aString.
  29104.             ^self parse]! !
  29105.  
  29106. !TableDrivenParser methodsFor: 'public access'!
  29107. parseAndTrace: aString ifFail: aBlock 
  29108.  
  29109.     self failBlock: aBlock.
  29110.     "Make sure we don't accidently write to someone else's window."
  29111.     self transcript: nil.
  29112.     self exceptionHandlers
  29113.         handleDo: 
  29114.             [self initScannerSource: aString.
  29115.             ^self traceParse]! !
  29116.  
  29117. !TableDrivenParser methodsFor: 'public access'!
  29118. parseAndTrace: aString on: aTranscript ifFail: aBlock 
  29119.  
  29120.     self failBlock: aBlock.
  29121.     self transcript: aTranscript.
  29122.     self exceptionHandlers
  29123.         handleDo: 
  29124.             [self initScannerSource: aString.
  29125.             ^self traceParse]! !
  29126.  
  29127. !TableDrivenParser methodsFor: 'public access'!
  29128. parseForAST: aString ifFail: aBlock 
  29129.  
  29130.     self failBlock: aBlock.
  29131.     self exceptionHandlers
  29132.         handleDo: 
  29133.             [self initScannerSource: aString.
  29134.             ^self parseForAST]! !
  29135.  
  29136. !TableDrivenParser methodsFor: 'public access'!
  29137. parseForDerivationTree: aString ifFail: aBlock 
  29138.  
  29139.     self failBlock: aBlock.
  29140.     self exceptionHandlers
  29141.         handleDo: 
  29142.             [self initScannerSource: aString.
  29143.             ^self parseForDerivationTree]! !
  29144.  
  29145. !TableDrivenParser methodsFor: 'public access'!
  29146. parseForShamAST: aString ifFail: aBlock 
  29147.  
  29148.     self failBlock: aBlock.
  29149.     self exceptionHandlers
  29150.         handleDo: 
  29151.             [self initScannerSource: aString.
  29152.             ^self parseForShamAST]! !
  29153.  
  29154. !TableDrivenParser methodsFor: 'parsing'!
  29155. parse
  29156.  
  29157.     self subclassResponsibility! !
  29158.  
  29159. !TableDrivenParser methodsFor: 'parsing'!
  29160. parseForAST
  29161.  
  29162.     | builder |
  29163.     builder := self treeBuilder reset.
  29164.     ^self parseWithTreeBuilder: builder! !
  29165.  
  29166. !TableDrivenParser methodsFor: 'parsing'!
  29167. parseForDerivationTree
  29168.  
  29169.     ^self parseWithTreeBuilder: self derivationTreeBuilderClass new! !
  29170.  
  29171. !TableDrivenParser methodsFor: 'parsing'!
  29172. parseForShamAST
  29173.  
  29174.     | builder |
  29175.     builder := self treeBuilder reset.
  29176.     builder setShamMode.
  29177.     ^self parseWithTreeBuilder: builder! !
  29178.  
  29179. !TableDrivenParser methodsFor: 'parsing'!
  29180. traceParse
  29181.  
  29182.     self subclassResponsibility! !
  29183.  
  29184. !TableDrivenParser methodsFor: 'private'!
  29185. derivationTreeBuilderClass
  29186.  
  29187.     ^DerivationTreeBuilder! !
  29188.  
  29189. !TableDrivenParser methodsFor: 'private'!
  29190. myParseTable
  29191.  
  29192.     ^self class parseTable! !
  29193.  
  29194. !TableDrivenParser methodsFor: 'private'!
  29195. scannerClass
  29196.     "Translator generator tools may initially create an 'abstract' parser and 'plug-in' 
  29197.     a scanner. This allows instances of these abstract parsers to be used in this 
  29198.     fashion. Ultimately, the tools will create concrete scanner and parser classes 
  29199.     with the proper links established."
  29200.  
  29201.     ^Object! !
  29202.  
  29203. !TableDrivenParser methodsFor: 'private'!
  29204. treeBuilderClass
  29205.     "Different tree builders can either be plugged in or subclasses can override this 
  29206.     method."
  29207.  
  29208.     ^AbstractSyntaxTreeBuilder! !
  29209.  
  29210. !TableDrivenParser methodsFor: 'tracing'!
  29211. cr
  29212.  
  29213.     self show: '
  29214. '! !
  29215.  
  29216. !TableDrivenParser methodsFor: 'tracing'!
  29217. defaultTranscript
  29218.  
  29219.     ^Transcript! !
  29220.  
  29221. !TableDrivenParser methodsFor: 'tracing'!
  29222. show: aString 
  29223.  
  29224.     (self transcript isNil
  29225.         ifTrue: [self defaultTranscript]
  29226.         ifFalse: [self transcript])
  29227.         show: aString! !
  29228.  
  29229. !TableDrivenParser methodsFor: 'tracing'!
  29230. showCR: aString 
  29231.  
  29232.     self show: aString , '
  29233. '! !
  29234.  
  29235. !TableDrivenParser methodsFor: 'exception handling'!
  29236. abort
  29237.  
  29238.     | block |
  29239.     block := self failBlock.
  29240.     self failBlock: nil.
  29241.     ^block value! !
  29242.  
  29243. !TableDrivenParser methodsFor: 'exception handling'!
  29244. exceptionHandlers
  29245.     "Answer a HandlerCollection that will catch and handle scanner and parser errors."
  29246.  
  29247.     | handlers |
  29248.     handlers := HandlerCollection new.
  29249.     handlers on: self scannerErrorSignal
  29250.         handle: 
  29251.             [:ex | 
  29252.             self requestor notNil
  29253.                 ifTrue: [self requestor insertAndSelect: 'SCANNER ERROR: ' , ex errorString , ' ->' at: self scanner errorPosition].
  29254.             self abort].
  29255.     handlers on: self parserErrorSignal
  29256.         handle: 
  29257.             [:ex | 
  29258.             self requestor notNil
  29259.                 ifTrue: [self requestor insertAndSelect: '<- PARSER ERROR: ' , ex errorString at: self scanner errorPosition].
  29260.             self abort].
  29261.     ^handlers! !
  29262.  
  29263. !TableDrivenParser methodsFor: 'exception handling'!
  29264. parserErrorSignal
  29265.  
  29266.     self subclassResponsibility! !
  29267.  
  29268. !TableDrivenParser methodsFor: 'exception handling'!
  29269. scannerErrorSignal
  29270.  
  29271.     ^FSAState noTransitionSignal! !
  29272.  
  29273. !TableDrivenParser methodsFor: 'converting'!
  29274. spaceOptimize
  29275.  
  29276.     self parseTable spaceOptimize! !
  29277.  
  29278. !TableDrivenParser methodsFor: 'initialization'!
  29279. init
  29280.  
  29281.     super init.
  29282.     self parseTable: self myParseTable.
  29283.     self treeBuilder: self treeBuilderClass new! !
  29284.  
  29285. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29286. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  29287.  
  29288.     ^self subclassResponsibility! !
  29289.  
  29290. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29291. createParserClassNamed: name category: category spec: grammarSpec 
  29292.  
  29293.     | parserClass |
  29294.     parserClass := self defaultParserClass
  29295.                 subclass: name asSymbol
  29296.                 instanceVariableNames: ''
  29297.                 classVariableNames: ''
  29298.                 poolDictionaries: ''
  29299.                 category: category.
  29300.     parserClass comment: self generatedParserClassComment.
  29301.     parserClass class compile: (self classInitializationMethodTextForClassNamed: name spec: grammarSpec)
  29302.         classified: 'class initialization'.
  29303.     parserClass initialize.
  29304.     ^parserClass! !
  29305.  
  29306. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29307. generatedParserClassComment
  29308.  
  29309.     ^'This parser class was automatically generated by ', TranslatorGenerator versionName , '.'! !
  29310.  
  29311. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29312. createScannerClassNamed: name category: category spec: tokenSpec 
  29313.  
  29314.     ^self scanner
  29315.         createScannerClassNamed: name
  29316.         category: category
  29317.         spec: tokenSpec! !
  29318.  
  29319. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29320. createScannerParserClassesNamed: namePrefix category: category tokenSpec: tokenSpec grammarSpec: grammarSpec 
  29321.     | parserClass |
  29322.     self
  29323.         createScannerClassNamed: namePrefix , 'Scanner'
  29324.         category: category
  29325.         spec: tokenSpec.
  29326.     parserClass := self
  29327.                 createParserClassNamed: namePrefix , 'Parser'
  29328.                 category: category
  29329.                 spec: grammarSpec.
  29330.     parserClass compile: 'scannerClass
  29331.     ^' , namePrefix , 'Scanner' classified: 'private'.
  29332.     parserClass compile: 'treeBuilderClass
  29333.     ^' , self treeBuilder class printString classified: 'private'! !
  29334.  
  29335. !TableDrivenParser methodsFor: 'scanner/parser generation'!
  29336. defaultParserClass
  29337.  
  29338.     ^self class! !
  29339.  
  29340. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  29341.  
  29342. TableDrivenParser class
  29343.     instanceVariableNames: 'parseTable '!
  29344.  
  29345. !TableDrivenParser class methodsFor: 'class initialization'!
  29346. initialize
  29347.     "Concrete subclasses must somehow provide a parse table. Subclasses created 
  29348.     by automatic means may simply 'plug-in' a dynamically computed parse table. 
  29349.     However, if a class that can be filed-out is desired then it is worthwhile to 
  29350.     override this initialization method with one that can build the appropriate parse 
  29351.     table directly."
  29352.     "TableDrivenParser initialize"
  29353.  
  29354.     self parseTable: nil! !
  29355.  
  29356. !TableDrivenParser class methodsFor: 'state accessing'!
  29357. parseTable
  29358.  
  29359.     ^parseTable! !
  29360.  
  29361. !TableDrivenParser class methodsFor: 'state accessing'!
  29362. parseTable: argument 
  29363.  
  29364.     parseTable := argument! !
  29365.  
  29366. !TableDrivenParser class methodsFor: 'instance creation'!
  29367. new
  29368.  
  29369.     ^super new init! !
  29370.  
  29371. TableDrivenParser subclass: #LL1Parser
  29372.     instanceVariableNames: 'startSymbol '
  29373.     classVariableNames: ''
  29374.     poolDictionaries: ''
  29375.     category: 'Compilers-Parsers'!
  29376. LL1Parser comment:
  29377. '=================================================
  29378.     Copyright (c) 1992 by Justin O. Graver.
  29379.     All rights reserved (with exceptions).
  29380.     For complete information evaluate "Object tgenCopyright."
  29381. =================================================
  29382.  
  29383. I am an LL(1) parser.
  29384.  
  29385. Instance Variables:
  29386.     parseTable*    <LL1ParserTable> - basic parsing mechanism.
  29387.     startSymbol  <Symbol> - my grammars start symbol.
  29388.  
  29389. * inherited from AbstractParser'!
  29390.  
  29391. LL1Parser comment:
  29392. '=================================================
  29393.     Copyright (c) 1992 by Justin O. Graver.
  29394.     All rights reserved (with exceptions).
  29395.     For complete information evaluate "Object tgenCopyright."
  29396. =================================================
  29397.  
  29398. I am an LL(1) parser.
  29399.  
  29400. Instance Variables:
  29401.     parseTable*    <LL1ParserTable> - basic parsing mechanism.
  29402.     startSymbol  <Symbol> - my grammars start symbol.
  29403.  
  29404. * inherited from AbstractParser'!
  29405.  
  29406. !LL1Parser methodsFor: 'state accessing'!
  29407. startSymbol
  29408.  
  29409.     ^startSymbol! !
  29410.  
  29411. !LL1Parser methodsFor: 'state accessing'!
  29412. startSymbol: argument 
  29413.  
  29414.     startSymbol := argument! !
  29415.  
  29416. !LL1Parser methodsFor: 'private'!
  29417. epsilon
  29418.     "Answer an object used to represent the empty string (epsilon)."
  29419.  
  29420.     ^'<epsilon>'! !
  29421.  
  29422. !LL1Parser methodsFor: 'private'!
  29423. myStartSymbol
  29424.  
  29425.     ^self class startSymbol! !
  29426.  
  29427. !LL1Parser methodsFor: 'private'!
  29428. parserErrorSignal
  29429.  
  29430.     ^LLParserTable noTransitionSignal! !
  29431.  
  29432. !LL1Parser methodsFor: 'exception handling'!
  29433. raiseExceptionExpectedToken: aString 
  29434.  
  29435.     self raiseNoTransitionExceptionErrorString: 'expecting ' , aString! !
  29436.  
  29437. !LL1Parser methodsFor: 'exception handling'!
  29438. raiseExceptionUnparsedTokens
  29439.  
  29440.     self raiseNoTransitionExceptionErrorString: 'unparsed tokens remaining in input'! !
  29441.  
  29442. !LL1Parser methodsFor: 'exception handling'!
  29443. raiseNoTransitionExceptionErrorString: aString 
  29444.  
  29445.     self parserErrorSignal raiseErrorString: aString! !
  29446.  
  29447. !LL1Parser methodsFor: 'parsing'!
  29448. parse
  29449.  
  29450.     | stack prod |
  29451.     stack := Stack new.
  29452.     stack push: self startSymbol.
  29453.     [stack isEmpty]
  29454.         whileFalse: [stack top isTerminal
  29455.                 ifTrue: [stack top = self nextToken
  29456.                         ifTrue: 
  29457.                             [stack pop.
  29458.                             self scanToken]
  29459.                         ifFalse: [self raiseExceptionExpectedToken: stack top symbol]]
  29460.                 ifFalse: 
  29461.                     [prod := self productionAtNonterminal: stack pop andTerminal: self nextToken.
  29462.                     prod rightHandSide reverseDo: [:sym | stack push: sym]]].
  29463.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! !
  29464.  
  29465. !LL1Parser methodsFor: 'parsing'!
  29466. parseForDerivationTreeAlternative
  29467.     "Derivation trees can be build efficiently during a top-down parse. 
  29468.     This method implements this option (see parseForDerivationTree)."
  29469.  
  29470.     | stack prod root parent node |
  29471.     stack := Stack new.
  29472.     root := DerivationTreeNode symbol: self startSymbol.
  29473.     stack push: root.
  29474.     [stack isEmpty]
  29475.         whileFalse: [stack top isTerminal
  29476.                 ifTrue: [stack top symbol = self nextToken
  29477.                         ifTrue: 
  29478.                             [stack pop.
  29479.                             self scanToken]
  29480.                         ifFalse: [self raiseExceptionExpectedToken: stack top symbol]]
  29481.                 ifFalse: 
  29482.                     [prod := self productionAtNonterminal: stack top symbol andTerminal: self nextToken.
  29483.                     parent := stack pop.
  29484.                     prod rightHandSide isEmpty
  29485.                         ifTrue: 
  29486.                             [node := DerivationTreeNode symbol: self epsilon.
  29487.                             parent addChild: node]
  29488.                         ifFalse: [prod rightHandSide
  29489.                                 reverseDo: 
  29490.                                     [:sym | 
  29491.                                     node := DerivationTreeNode symbol: sym.
  29492.                                     parent addFirstChild: node.
  29493.                                     stack push: node]]]].
  29494.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens].
  29495.     ^root! !
  29496.  
  29497. !LL1Parser methodsFor: 'parsing'!
  29498. parseWithTreeBuilder: parseTreeBuilder 
  29499.     "Rather than building the tree top-down during the parse, it's easier to save 
  29500.     the productions on a stack and build the tree bottom-up after parsing."
  29501.  
  29502.     | stack productionStack |
  29503.     productionStack := Stack new.
  29504.     stack := Stack new.
  29505.     stack push: self startSymbol.
  29506.     [stack isEmpty]
  29507.         whileFalse: [stack top isTerminal
  29508.                 ifTrue: 
  29509.                     ["cancel matching tokens"
  29510.                     stack top = self nextToken
  29511.                         ifTrue: 
  29512.                             [stack pop.
  29513.                             self scanToken]
  29514.                         ifFalse: [self raiseExceptionExpectedToken: stack top]]
  29515.                 ifFalse: 
  29516.                     ["expand nonterminal"
  29517.                     productionStack push: (self productionAtNonterminal: stack pop andTerminal: self nextToken)
  29518.                             @ self nextTokenValue.
  29519.                     productionStack top x rightHandSide reverseDo: [:sym | stack push: sym]]].
  29520.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens].
  29521.     productionStack do: 
  29522.         [:prod | 
  29523.         self prevToken: prod y.
  29524.         parseTreeBuilder processProduction: prod x forParser: self].
  29525.     ^parseTreeBuilder result! !
  29526.  
  29527. !LL1Parser methodsFor: 'parsing'!
  29528. productionAtNonterminal: nont andTerminal: term
  29529.     ^self parseTable productionAtNonterminal: nont andTerminal: term! !
  29530.  
  29531. !LL1Parser methodsFor: 'parsing'!
  29532. traceParse
  29533.  
  29534.     | stack prod |
  29535.     self
  29536.          cr;
  29537.          cr;
  29538.          showCR: 'LL Parser trace of:  ' , self scanner contents;
  29539.          cr.
  29540.     stack := OrderedCollection new.
  29541.     stack addFirst: self startSymbol.
  29542.     [stack isEmpty]
  29543.         whileFalse: [stack first isTerminal
  29544.                 ifTrue: [stack first = self nextToken
  29545.                         ifTrue: 
  29546.                             [self showCR: 'cancel ''' , stack first asString, ''' from input'.
  29547.                             stack removeFirst.
  29548.                             self scanToken]
  29549.                         ifFalse: [self error: 'raise exception:  top of stack = ''' , stack first asString , ''' next token = ''' , self nextToken asString, '''']]
  29550.                 ifFalse: 
  29551.                     [prod := self productionAtNonterminal: stack first andTerminal: self nextToken.
  29552.                     self showCR: 'apply production ' , prod printString.
  29553.                     stack removeFirst.
  29554.                     prod rightHandSide reverseDo: [:sym | stack addFirst: sym]]].
  29555.     self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! !
  29556.  
  29557. !LL1Parser methodsFor: 'testing'!
  29558. performsLeftmostDerivation
  29559.  
  29560.     ^true! !
  29561.  
  29562. !LL1Parser methodsFor: 'initialization'!
  29563. init
  29564.  
  29565.     super init.
  29566.     self startSymbol: self myStartSymbol! !
  29567.  
  29568. !LL1Parser methodsFor: 'scanner/parser generation'!
  29569. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  29570.  
  29571.     | ws |
  29572.     ws := WriteStream on: (String new: 256).
  29573.     ws nextPutAll: 'initialize "' , name , ' initialize  " '.
  29574.     ws cr.
  29575.     ws nextPutAll: ' "  ' , grammarSpec , ' " '.
  29576.     ws nextPut: $".
  29577.     grammarSpec do: 
  29578.         [:ch | 
  29579.         "double embedded double-quote characters"
  29580.         ws nextPut: ch.
  29581.         ch = $" ifTrue: [ws nextPut: $"]].
  29582.     ws nextPut: $".
  29583.     ws nextPutAll: ' |  llParserTable table gp | '.
  29584.     ws nextPutAll: self parseTable buildParseTable.
  29585.     ws nextPutAll: ' self parseTable:  llParserTable  . '.
  29586.     ws nextPutAll: ' self startSymbol:   '.
  29587.     self startSymbol printOn: ws.
  29588.     ^ws contents! !
  29589.  
  29590. !LL1Parser methodsFor: 'converting'!
  29591. fastParser
  29592.  
  29593.     ^OptimizedLL1Parser buildFrom: self! !
  29594.  
  29595. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  29596.  
  29597. LL1Parser class
  29598.     instanceVariableNames: 'startSymbol '!
  29599.  
  29600. !LL1Parser class methodsFor: 'instance creation'!
  29601. parseTable: table startSymbol: sym 
  29602.  
  29603.     | newParser |
  29604.     newParser := self new.
  29605.     newParser parseTable: table.
  29606.     newParser startSymbol: sym.
  29607.     ^newParser! !
  29608.  
  29609. !LL1Parser class methodsFor: 'state accessing'!
  29610. startSymbol
  29611.  
  29612.     ^startSymbol! !
  29613.  
  29614. !LL1Parser class methodsFor: 'state accessing'!
  29615. startSymbol: argument 
  29616.  
  29617.     startSymbol := argument! !
  29618.  
  29619. LL1Parser subclass: #OptimizedLL1Parser
  29620.     instanceVariableNames: 'nonterminals terminals '
  29621.     classVariableNames: 'NoTransitionSignal '
  29622.     poolDictionaries: ''
  29623.     category: 'Compilers-Parsers'!
  29624. OptimizedLL1Parser comment:
  29625. '=================================================
  29626.     Copyright (c) 1992 by Justin O. Graver.
  29627.     All rights reserved (with exceptions).
  29628.     For complete information evaluate "Object tgenCopyright."
  29629. =================================================
  29630.  
  29631. I am an LL(1) parser represented efficiently in Array table format.
  29632.  
  29633. Instance variables:
  29634.     tokenTypeTable <Array of: String>    - the integer mapping for terminals and nonterminals'!
  29635.  
  29636. OptimizedLL1Parser comment:
  29637. '=================================================
  29638.     Copyright (c) 1992 by Justin O. Graver.
  29639.     All rights reserved (with exceptions).
  29640.     For complete information evaluate "Object tgenCopyright."
  29641. =================================================
  29642.  
  29643. I am an LL(1) parser represented efficiently in Array table format.
  29644.  
  29645. Instance variables:
  29646.     tokenTypeTable <Array of: String>    - the integer mapping for terminals and nonterminals'!
  29647.  
  29648. !OptimizedLL1Parser methodsFor: 'exception handling'!
  29649. endOfInputErrorString
  29650.  
  29651.     ^'end of input encountered'! !
  29652.  
  29653. !OptimizedLL1Parser methodsFor: 'exception handling'!
  29654. parserErrorSignal
  29655.  
  29656.     ^self class noTransitionSignal! !
  29657.  
  29658. !OptimizedLL1Parser methodsFor: 'exception handling'!
  29659. raiseNoTransitionExceptionErrorString: aString 
  29660.  
  29661.     self parserErrorSignal raiseErrorString: aString! !
  29662.  
  29663. !OptimizedLL1Parser methodsFor: 'exception handling'!
  29664. scannerErrorSignal
  29665.  
  29666.     ^OptimizedScanner noTransitionSignal! !
  29667.  
  29668. !OptimizedLL1Parser methodsFor: 'exception handling'!
  29669. standardErrorString
  29670.  
  29671.     ^'unexpected token encountered:  '! !
  29672.  
  29673. !OptimizedLL1Parser methodsFor: 'private'!
  29674. parseError
  29675.  
  29676.     self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken
  29677.             ifTrue: [self endOfInputErrorString]
  29678.             ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! !
  29679.  
  29680. !OptimizedLL1Parser methodsFor: 'accessing'!
  29681. myNonterminals
  29682.  
  29683.     ^self class nonterminals! !
  29684.  
  29685. !OptimizedLL1Parser methodsFor: 'accessing'!
  29686. myTerminals
  29687.  
  29688.     ^self class terminals! !
  29689.  
  29690. !OptimizedLL1Parser methodsFor: 'accessing'!
  29691. myTokenTypeTable
  29692.  
  29693.     ^self class tokenTypeTable! !
  29694.  
  29695. !OptimizedLL1Parser methodsFor: 'initialization'!
  29696. init
  29697.  
  29698.     super init.
  29699.     self nonterminals: self myNonterminals.
  29700.     self terminals: self myTerminals! !
  29701.  
  29702. !OptimizedLL1Parser methodsFor: 'parsing'!
  29703. productionAtNonterminal: nont andTerminal: term 
  29704.     | nontIndex termIndex prod |
  29705.     nontIndex := self nonterminals indexOf: nont.
  29706.     termIndex := self terminals indexOf: term.
  29707.     ^(prod := (self parseTable at: nontIndex)
  29708.                 at: termIndex) isNil
  29709.         ifTrue: [self raiseNoTransitionExceptionErrorString: (term = self endOfInputToken
  29710.                     ifTrue: [self endOfInputErrorString]
  29711.                     ifFalse: [self standardErrorString , '''' , term printString , ''''])]
  29712.         ifFalse: [prod]! !
  29713.  
  29714. !OptimizedLL1Parser methodsFor: 'reconstructing'!
  29715. mapProductionToInteger
  29716.     "Answer an Array of all grammar symbols - nonterminals, terminals, 
  29717.     and translation symbols."
  29718.  
  29719.     | transSyms |
  29720.     transSyms := Set new.
  29721.     parseTable do: [:row | row do: [:ea | ea isGrammarProduction ifTrue: [ea hasTranslation ifTrue: [transSyms add: ea translationSymbol]]]].
  29722.     ^self nonterminals , self terminals , transSyms asOrderedCollection asArray! !
  29723.  
  29724. !OptimizedLL1Parser methodsFor: 'reconstructing'!
  29725. reconstructOn: aStream 
  29726.  
  29727.     | prodTable n |
  29728.     prodTable := self mapProductionToInteger.
  29729.     aStream nextPutAll: 'prodTable := '.
  29730.     prodTable reconstructOn: aStream.
  29731.     aStream
  29732.         period;
  29733.         crtab;
  29734.         nextPutAll: 'self nonterminals:  (prodTable copyFrom: 1 to:  ';
  29735.         nextPutAll: (n := self nonterminals size) printString;
  29736.         nextPutAll: ').';
  29737.         crtab;
  29738.         nextPutAll: 'self terminals:  (prodTable copyFrom: ';
  29739.         nextPutAll: (n + 1) printString;
  29740.         nextPutAll: ' to: ';
  29741.         nextPutAll: (self terminals size + n) printString;
  29742.         nextPutAll: ').';
  29743.         crtab;
  29744.         nextPutAll: 'table := '.
  29745.     self parseTable reconstructOn: aStream using: prodTable.
  29746.     aStream
  29747.         period;
  29748.         crtab;
  29749.         nextPutAll: 'self constructParseTable: table  with: prodTable.';
  29750.         crtab;
  29751.         nextPutAll: 'self startSymbol: '.
  29752.     self startSymbol printOn: aStream! !
  29753.  
  29754. !OptimizedLL1Parser methodsFor: 'scanner/parser generation'!
  29755. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  29756.     | ws |
  29757.     ws := WriteStream on: (String new: 2048).
  29758.     ws
  29759.         nextPutAll: 'initialize';
  29760.         crtab;
  29761.         nextPut: $";
  29762.         nextPutAll: name;
  29763.         nextPutAll: ' initialize"';
  29764.         crtab;
  29765.         nextPut: $".
  29766.     grammarSpec do: 
  29767.         [:ch | 
  29768.         "double embedded double-quote characters"
  29769.         ws nextPut: ch.
  29770.         ch = $" ifTrue: [ws nextPut: $"]].
  29771.     ws
  29772.         nextPut: $";
  29773.         cr;
  29774.         crtab;
  29775.         nextPutAll: '| table prodTable |';
  29776.         crtab.
  29777.     self reconstructOn: ws.
  29778.     ^ws contents! !
  29779.  
  29780. !OptimizedLL1Parser methodsFor: 'converting'!
  29781. changeToObjectTable: llParseTable 
  29782.  
  29783.     | terms objectTable |
  29784.     self nonterminals: llParseTable keys asOrderedCollection asArray.
  29785.     terms := Set new.
  29786.     llParseTable do: [:row | row
  29787.             associationsDo: 
  29788.                 [:assoc | 
  29789.                 terms add: assoc key.
  29790.                 assoc value rightHandSide do: [:sym | sym isTerminal ifTrue: [terms add: sym]]]].
  29791.     self terminals: terms asOrderedCollection asArray.
  29792.     objectTable := Array new: self nonterminals size.
  29793.     ^self convert: llParseTable to: objectTable! !
  29794.  
  29795. !OptimizedLL1Parser methodsFor: 'converting'!
  29796. convert: llParseTable to: objectTable 
  29797.     | nonterms terms row |
  29798.     nonterms := self nonterminals.
  29799.     terms := self terminals.
  29800.     llParseTable
  29801.         associationsDo: 
  29802.             [:assoc1 | 
  29803.             row := Array new: terms size.
  29804.             objectTable at: (nonterms indexOf: assoc1 key)
  29805.                 put: row.
  29806.             assoc1 value associationsDo: [:assoc2 | row at: (terms indexOf: assoc2 key)
  29807.                     put: assoc2 value]].
  29808.     ^objectTable! !
  29809.  
  29810. !OptimizedLL1Parser methodsFor: 'converting'!
  29811. convertToTable: ll1Parser 
  29812.  
  29813.     self scanner: ll1Parser scanner fastScanner.
  29814.     self parseTable: (self changeToObjectTable: ll1Parser parseTable).
  29815.     self treeBuilder:  ll1Parser treeBuilder.
  29816.     self startSymbol: ll1Parser startSymbol! !
  29817.  
  29818. !OptimizedLL1Parser methodsFor: 'state accessing'!
  29819. nonterminals
  29820.     ^nonterminals! !
  29821.  
  29822. !OptimizedLL1Parser methodsFor: 'state accessing'!
  29823. nonterminals: arg
  29824.     nonterminals := arg! !
  29825.  
  29826. !OptimizedLL1Parser methodsFor: 'state accessing'!
  29827. terminals
  29828.     ^terminals! !
  29829.  
  29830. !OptimizedLL1Parser methodsFor: 'state accessing'!
  29831. terminals: arg
  29832.     terminals := arg! !
  29833.  
  29834. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  29835.  
  29836. OptimizedLL1Parser class
  29837.     instanceVariableNames: 'nonterminals terminals '!
  29838.  
  29839. !OptimizedLL1Parser class methodsFor: 'class initialization'!
  29840. initialize
  29841.     "OptimizedLL1Parser initialize"
  29842.  
  29843.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  29844.  
  29845. !OptimizedLL1Parser class methodsFor: 'instance creation'!
  29846. buildFrom: ll1Parser
  29847.  
  29848.     ^self new convertToTable: ll1Parser! !
  29849.  
  29850. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29851. nonterminals 
  29852.     ^nonterminals! !
  29853.  
  29854. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29855. nonterminals: arg
  29856.     nonterminals := arg! !
  29857.  
  29858. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29859. noTransitionSignal
  29860.  
  29861.     ^NoTransitionSignal! !
  29862.  
  29863. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29864. noTransitionSignal: arg
  29865.  
  29866.     NoTransitionSignal := arg! !
  29867.  
  29868. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29869. terminals
  29870.     ^terminals! !
  29871.  
  29872. !OptimizedLL1Parser class methodsFor: 'state accessing'!
  29873. terminals: arg
  29874.     terminals := arg! !
  29875.  
  29876. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  29877. constructGrammarProduction: arg with: prodTable 
  29878.  
  29879.     | rhs |
  29880.     (arg at: 2) isEmpty
  29881.         ifTrue: [rhs := OrderedCollection new]
  29882.         ifFalse: 
  29883.             [rhs := OrderedCollection new.
  29884.             (arg at: 2)
  29885.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  29886.     ^GrammarProduction
  29887.         leftHandSide: (prodTable at: (arg at: 1))
  29888.         rightHandSide: rhs! !
  29889.  
  29890. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  29891. constructParseTable: table with: prodTable 
  29892.  
  29893.     | ea row |
  29894.     parseTable := Array new: table size.
  29895.     1 to: table size do: 
  29896.         [:index | 
  29897.         row := Array new: (table at: index) size.
  29898.         parseTable at: index put: row.
  29899.         1 to: (table at: index) size do: 
  29900.             [:i | 
  29901.             ea := (table at: index)
  29902.                         at: i.
  29903.             ea isNil ifFalse: [ea isInteger
  29904.                     ifTrue: [row at: i put: ea]
  29905.                     ifFalse: [ea size == 2
  29906.                             ifTrue: [row at: i put: (self constructGrammarProduction: ea with: prodTable)]
  29907.                             ifFalse: [row at: i put: (self constructTransductionGrammarProduction: ea with: prodTable)]]]]]! !
  29908.  
  29909. !OptimizedLL1Parser class methodsFor: 'reconstructing'!
  29910. constructTransductionGrammarProduction: arg with: prodTable 
  29911.  
  29912.     | rhs |
  29913.     (arg at: 2) isEmpty
  29914.         ifTrue: [rhs := OrderedCollection new]
  29915.         ifFalse: 
  29916.             [rhs := OrderedCollection new.
  29917.             (arg at: 2)
  29918.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  29919.     ^TransductionGrammarProduction
  29920.         leftHandSide: (prodTable at: (arg at: 1))
  29921.         rightHandSide: rhs
  29922.         translationSymbol: (prodTable at: (arg at: 3))! !
  29923.  
  29924. TableDrivenParser subclass: #LR1Parser
  29925.     instanceVariableNames: 'finalState '
  29926.     classVariableNames: ''
  29927.     poolDictionaries: ''
  29928.     category: 'Compilers-Parsers'!
  29929. LR1Parser comment:
  29930. '=================================================
  29931.     Copyright (c) 1992 by Justin O. Graver.
  29932.     All rights reserved (with exceptions).
  29933.     For complete information evaluate "Object tgenCopyright."
  29934. =================================================
  29935.  
  29936. I am an LR parser.
  29937.  
  29938. Instance Variables:
  29939.     parseTable*    <LRParserState> - basic parsing mechanism, a CFSM.
  29940.     finalState        <LRParserState> - final state of my CFSM.
  29941.  
  29942. * inherited from AbstractParser'!
  29943.  
  29944. LR1Parser comment:
  29945. '=================================================
  29946.     Copyright (c) 1992 by Justin O. Graver.
  29947.     All rights reserved (with exceptions).
  29948.     For complete information evaluate "Object tgenCopyright."
  29949. =================================================
  29950.  
  29951. I am an LR parser.
  29952.  
  29953. Instance Variables:
  29954.     parseTable*    <LRParserState> - basic parsing mechanism, a CFSM.
  29955.     finalState        <LRParserState> - final state of my CFSM.
  29956.  
  29957. * inherited from AbstractParser'!
  29958.  
  29959. !LR1Parser methodsFor: 'state accessing'!
  29960. finalState
  29961.  
  29962.     ^finalState! !
  29963.  
  29964. !LR1Parser methodsFor: 'state accessing'!
  29965. finalState: argument 
  29966.  
  29967.     finalState := argument! !
  29968.  
  29969. !LR1Parser methodsFor: 'parsing'!
  29970. acceptSymbol
  29971.  
  29972.     ^self lrParserStateClass acceptSymbol! !
  29973.  
  29974. !LR1Parser methodsFor: 'parsing'!
  29975. actionAt: currState 
  29976.  
  29977.     ^currState actionFor: self nextToken! !
  29978.  
  29979. !LR1Parser methodsFor: 'parsing'!
  29980. at: state transitionFor: symbol 
  29981.  
  29982.     ^state transitionFor: symbol! !
  29983.  
  29984. !LR1Parser methodsFor: 'parsing'!
  29985. lrParserStateClass
  29986.  
  29987.     ^LRParserState! !
  29988.  
  29989. !LR1Parser methodsFor: 'parsing'!
  29990. parse
  29991.  
  29992.     | stack action currState |
  29993.     stack := Stack new.
  29994.     currState := self startState.
  29995.     stack push: currState.
  29996.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  29997.         whileFalse: 
  29998.             [currState := action isGrammarProduction
  29999.                         ifTrue: 
  30000.                             ["reduce"
  30001.                             stack pop: action rightHandSide size.
  30002.                             self at: stack top transitionFor: action leftHandSide]
  30003.                         ifFalse: 
  30004.                             ["shift"
  30005.                             self scanToken.
  30006.                             action].
  30007.             stack push: currState]! !
  30008.  
  30009. !LR1Parser methodsFor: 'parsing'!
  30010. parseWithTreeBuilder: parseTreeBuilder 
  30011.  
  30012.     | stack currState action |
  30013.     stack := Stack new.
  30014.     currState := self startState.
  30015.     stack push: currState.
  30016.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  30017.         whileFalse: 
  30018.             [currState := action isGrammarProduction
  30019.                         ifTrue: 
  30020.                             ["reduce"
  30021.                             stack pop: action rightHandSide size.
  30022.                             parseTreeBuilder processProduction: action forParser: self.
  30023.                             self at: stack top transitionFor: action leftHandSide]
  30024.                         ifFalse: 
  30025.                             ["shift"
  30026.                             self scanToken.
  30027.                             action].
  30028.             stack push: currState].
  30029.     ^parseTreeBuilder result! !
  30030.  
  30031. !LR1Parser methodsFor: 'parsing'!
  30032. startState
  30033.  
  30034.     ^self parseTable! !
  30035.  
  30036. !LR1Parser methodsFor: 'parsing'!
  30037. traceParse
  30038.  
  30039.     | stack action currState nextState |
  30040.     self
  30041.          cr;
  30042.          cr;
  30043.          showCR: 'LR Parser trace of:  ' , self scanner contents;
  30044.          cr.
  30045.     stack := Stack new.
  30046.     currState := self startState.
  30047.     stack push: currState.
  30048.     [currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
  30049.         whileFalse: 
  30050.             [currState := action isGrammarProduction
  30051.                         ifTrue: 
  30052.                             ["reduce"
  30053.                             stack pop: action rightHandSide size.
  30054.                             nextState := self at: stack top transitionFor: action leftHandSide.
  30055.                             self showCR: 'reduce by ' , action printString , ' then goto state ' , nextState hash printString.
  30056.                             nextState]
  30057.                         ifFalse: 
  30058.                             ["shift"
  30059.                             self showCR: 'shift on ''' , self nextToken asString, ''' to state ' , action hash printString.
  30060.                             self scanToken.
  30061.                             action].
  30062.             stack push: currState]! !
  30063.  
  30064. !LR1Parser methodsFor: 'lalr analysis'!
  30065. lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar 
  30066.  
  30067.     ^self parseTable lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar! !
  30068.  
  30069. !LR1Parser methodsFor: 'private'!
  30070. myFinalState
  30071.  
  30072.     ^self class finalState! !
  30073.  
  30074. !LR1Parser methodsFor: 'private'!
  30075. parserErrorSignal
  30076.  
  30077.     ^LRParserState noTransitionSignal! !
  30078.  
  30079. !LR1Parser methodsFor: 'testing'!
  30080. performsRightmostDerivation
  30081.  
  30082.     ^true! !
  30083.  
  30084. !LR1Parser methodsFor: 'initialization'!
  30085. init
  30086.  
  30087.     super init.
  30088.     self finalState: self myFinalState! !
  30089.  
  30090. !LR1Parser methodsFor: 'converting'!
  30091. fastParser
  30092.  
  30093.     ^OptimizedLR1Parser buildFrom: self! !
  30094.  
  30095. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  30096.  
  30097. LR1Parser class
  30098.     instanceVariableNames: 'finalState '!
  30099.  
  30100. !LR1Parser class methodsFor: 'instance creation'!
  30101. parseTable: table finalState: state 
  30102.  
  30103.     | newParser |
  30104.     newParser := self new.
  30105.     newParser parseTable: table.
  30106.     newParser finalState: state.
  30107.     ^newParser! !
  30108.  
  30109. !LR1Parser class methodsFor: 'state accessing'!
  30110. finalState
  30111.  
  30112.     ^finalState! !
  30113.  
  30114. !LR1Parser class methodsFor: 'state accessing'!
  30115. finalState: argument 
  30116.  
  30117.     finalState := argument! !
  30118.  
  30119. LR1Parser subclass: #OptimizedLR1Parser
  30120.     instanceVariableNames: 'tokenTypeTable '
  30121.     classVariableNames: 'NoTransitionSignal '
  30122.     poolDictionaries: ''
  30123.     category: 'Compilers-Parsers'!
  30124. OptimizedLR1Parser comment:
  30125. '=================================================
  30126.     Copyright (c) 1992 by Justin O. Graver.
  30127.     All rights reserved (with exceptions).
  30128.     For complete information evaluate "Object tgenCopyright."
  30129. =================================================
  30130.  
  30131. I am an LR parser represented efficietly in Array table form.
  30132.  
  30133. Instance variables:
  30134.     tokenTypeTable <Array of: String>    - the integer mapping of terminals and nonterminals'!
  30135.  
  30136. OptimizedLR1Parser comment:
  30137. '=================================================
  30138.     Copyright (c) 1992 by Justin O. Graver.
  30139.     All rights reserved (with exceptions).
  30140.     For complete information evaluate "Object tgenCopyright."
  30141. =================================================
  30142.  
  30143. I am an LR parser represented efficietly in Array table form.
  30144.  
  30145. Instance variables:
  30146.     tokenTypeTable <Array of: String>    - the integer mapping of terminals and nonterminals'!
  30147.  
  30148. !OptimizedLR1Parser methodsFor: 'state accessing'!
  30149. tokenTypeTable
  30150.  
  30151.     ^tokenTypeTable! !
  30152.  
  30153. !OptimizedLR1Parser methodsFor: 'state accessing'!
  30154. tokenTypeTable: arg 
  30155.  
  30156.     tokenTypeTable := arg! !
  30157.  
  30158. !OptimizedLR1Parser methodsFor: 'reconstructing'!
  30159. mapProductionToInteger
  30160.     "Answer an Array of all grammar symbols - nonterminals, terminals, 
  30161.     and translation symbols."
  30162.  
  30163.     | transSyms |
  30164.     transSyms := Set new.
  30165.     parseTable do: [:row | row do: [:ea | ea isGrammarProduction ifTrue: [ea hasTranslation ifTrue: [transSyms add: ea translationSymbol]]]].
  30166.     ^self tokenTypeTable , transSyms asOrderedCollection asArray! !
  30167.  
  30168. !OptimizedLR1Parser methodsFor: 'reconstructing'!
  30169. reconstructOn: aStream 
  30170.     "Recreate a parse table and a token type table"
  30171.  
  30172.     | prodTable |
  30173.     prodTable := self mapProductionToInteger.
  30174.     aStream nextPutAll: 'prodTable := '.
  30175.     prodTable reconstructOn: aStream.
  30176.     aStream
  30177.         period;
  30178.         crtab;
  30179.         nextPutAll: 'self tokenTypeTable:  (prodTable copyFrom: 1 to:  ';
  30180.         nextPutAll: tokenTypeTable size printString;
  30181.         nextPutAll: ').';
  30182.         crtab;
  30183.         nextPutAll: 'table := '.
  30184.     self parseTable reconstructOn: aStream using: prodTable.
  30185.     aStream
  30186.         period;
  30187.         crtab;
  30188.         nextPutAll: 'self constructParseTable: table  with: prodTable.';
  30189.         crtab;
  30190.         nextPutAll: 'self finalState: '.
  30191.     self finalState printOn: aStream! !
  30192.  
  30193. !OptimizedLR1Parser methodsFor: 'private'!
  30194. parseError
  30195.  
  30196.     self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken
  30197.             ifTrue: [self endOfInputErrorString]
  30198.             ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! !
  30199.  
  30200. !OptimizedLR1Parser methodsFor: 'exception handling'!
  30201. endOfInputErrorString
  30202.  
  30203.     ^'end of input encountered'! !
  30204.  
  30205. !OptimizedLR1Parser methodsFor: 'exception handling'!
  30206. parserErrorSignal
  30207.  
  30208.     ^self class noTransitionSignal! !
  30209.  
  30210. !OptimizedLR1Parser methodsFor: 'exception handling'!
  30211. raiseNoTransitionExceptionErrorString: aString 
  30212.  
  30213.     self parserErrorSignal raiseErrorString: aString! !
  30214.  
  30215. !OptimizedLR1Parser methodsFor: 'exception handling'!
  30216. scannerErrorSignal
  30217.  
  30218.     ^OptimizedScanner noTransitionSignal! !
  30219.  
  30220. !OptimizedLR1Parser methodsFor: 'exception handling'!
  30221. standardErrorString
  30222.  
  30223.     ^'unexpected token encountered:  '! !
  30224.  
  30225. !OptimizedLR1Parser methodsFor: 'converting'!
  30226. assignNextIDAfter: id toSuccessorOf: state 
  30227.  
  30228.     | nextID nextState |
  30229.     nextID := id + 1.
  30230.     state edgeLabelMap
  30231.         associationsDo: 
  30232.             [:assoc | 
  30233.             tokenTypeTable add: assoc key.
  30234.             nextState := assoc value.
  30235.             nextState stateID isNil
  30236.                 ifTrue: 
  30237.                     [nextState stateID: nextID.
  30238.                     nextID := self assignNextIDAfter: nextID toSuccessorOf: nextState]].
  30239.     state reduceMap associationsDo: [:assoc | tokenTypeTable add: assoc key].
  30240.     ^nextID! !
  30241.  
  30242. !OptimizedLR1Parser methodsFor: 'converting'!
  30243. changeToObjectTable: lrParserState 
  30244.  
  30245.     | sizePlusOne objectTable |
  30246.     lrParserState stateID notNil ifTrue: [lrParserState nilOutStateIDs].
  30247.     lrParserState stateID: self startState.
  30248.     self tokenTypeTable: Set new.
  30249.     sizePlusOne := self assignNextIDAfter: self startState toSuccessorOf: lrParserState.
  30250.     self tokenTypeTable: tokenTypeTable asOrderedCollection asArray.
  30251.     objectTable := Array new: sizePlusOne - 1.
  30252.     ^self convert: lrParserState to: objectTable! !
  30253.  
  30254. !OptimizedLR1Parser methodsFor: 'converting'!
  30255. convert: state to: objectTable 
  30256.     "I try to create a table that maps state ( represented by integer ) to state or state to 
  30257.     production"
  30258.  
  30259.     | arr nextState |
  30260.     arr := Array new: self tokenTypeTable size.
  30261.     objectTable at: state stateID put: arr.
  30262.     state edgeLabelMap
  30263.         associationsDo: 
  30264.             [:assoc | 
  30265.             nextState := assoc value.
  30266.             (objectTable at: nextState stateID) isNil ifTrue: [self convert: nextState to: objectTable].
  30267.             arr at: (tokenTypeTable indexOf: assoc key)
  30268.                 put: nextState stateID].
  30269.     state reduceMap associationsDo: [:assoc | arr at: (tokenTypeTable indexOf: assoc key)
  30270.             put: assoc value first].
  30271.     ^objectTable! !
  30272.  
  30273. !OptimizedLR1Parser methodsFor: 'converting'!
  30274. convertToTable: lr1Parser 
  30275.  
  30276.     self scanner: lr1Parser scanner fastScanner.
  30277.     self parseTable: (self changeToObjectTable: lr1Parser parseTable).
  30278.     self treeBuilder:  lr1Parser treeBuilder.
  30279.     self finalState: lr1Parser finalState stateID! !
  30280.  
  30281. !OptimizedLR1Parser methodsFor: 'scanner/parser generation'!
  30282. classInitializationMethodTextForClassNamed: name spec: grammarSpec 
  30283.     | ws |
  30284.     ws := WriteStream on: (String new: 2048).
  30285.     ws
  30286.         nextPutAll: 'initialize';
  30287.         crtab;
  30288.         nextPut: $";
  30289.         nextPutAll: name;
  30290.         nextPutAll: ' initialize"';
  30291.         crtab;
  30292.         nextPut: $".
  30293.     grammarSpec do: 
  30294.         [:ch | 
  30295.         "double embedded double-quote characters"
  30296.         ws nextPut: ch.
  30297.         ch = $" ifTrue: [ws nextPut: $"]].
  30298.     ws
  30299.         nextPut: $";
  30300.         cr;
  30301.         crtab;
  30302.         nextPutAll: '| table prodTable |';
  30303.         crtab.
  30304.     self reconstructOn: ws.
  30305.     ^ws contents! !
  30306.  
  30307. !OptimizedLR1Parser methodsFor: 'parsing'!
  30308. actionAt: currState 
  30309.  
  30310.     | action |
  30311.     (action := (parseTable at: currState)
  30312.                 at: (tokenTypeTable indexOf: self nextToken)) isNil ifTrue: [(scanner finalStateTable includes: currState)
  30313.             ifTrue: [^#accept]
  30314.             ifFalse: [self parseError]].
  30315.     ^action! !
  30316.  
  30317. !OptimizedLR1Parser methodsFor: 'parsing'!
  30318. at: currState transitionFor: symbol 
  30319.  
  30320.     | value |
  30321.     (value := (parseTable at: currState)
  30322.                 at: (tokenTypeTable indexOf: symbol)) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (symbol = self endOfInputToken
  30323.                 ifTrue: [self endOfInputErrorString]
  30324.                 ifFalse: [self standardErrorString , '''' , symbol printString , ''''])].
  30325.     ^value! !
  30326.  
  30327. !OptimizedLR1Parser methodsFor: 'initialization'!
  30328. init
  30329.  
  30330.     super init.
  30331.     self tokenTypeTable: self myTokenTypeTable! !
  30332.  
  30333. !OptimizedLR1Parser methodsFor: 'accessing'!
  30334. myTokenTypeTable
  30335.  
  30336.     ^self class tokenTypeTable! !
  30337.  
  30338. !OptimizedLR1Parser methodsFor: 'accessing'!
  30339. startState
  30340.  
  30341.     ^1! !
  30342.  
  30343. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  30344.  
  30345. OptimizedLR1Parser class
  30346.     instanceVariableNames: 'tokenTypeTable '!
  30347.  
  30348. !OptimizedLR1Parser class methodsFor: 'class initialization'!
  30349. initialize
  30350.     "OptimizedLR1Parser initialize"
  30351.  
  30352.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  30353.  
  30354. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  30355. noTransitionSignal
  30356.  
  30357.     ^NoTransitionSignal! !
  30358.  
  30359. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  30360. noTransitionSignal: argument 
  30361.  
  30362.     NoTransitionSignal := argument! !
  30363.  
  30364. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  30365. tokenTypeTable
  30366.  
  30367.     ^tokenTypeTable! !
  30368.  
  30369. !OptimizedLR1Parser class methodsFor: 'state accessing'!
  30370. tokenTypeTable: arg 
  30371.  
  30372.     tokenTypeTable := arg! !
  30373.  
  30374. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  30375. constructGrammarProduction: arg with: prodTable 
  30376.  
  30377.     | rhs |
  30378.     (arg at: 2) isEmpty
  30379.         ifTrue: [rhs := OrderedCollection new]
  30380.         ifFalse: 
  30381.             [rhs := OrderedCollection new.
  30382.             (arg at: 2)
  30383.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  30384.     ^GrammarProduction leftHandSide: (prodTable at: (arg at: 1))
  30385.         rightHandSide: rhs! !
  30386.  
  30387. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  30388. constructParseTable: table with: prodTable 
  30389.  
  30390.     | ea row |
  30391.     parseTable := Array new: table size.
  30392.     1 to: table size do: 
  30393.         [:index | 
  30394.         row := Array new: (table at: index) size.
  30395.         parseTable at: index put: row.
  30396.         1 to: (table at: index) size do: 
  30397.             [:i | 
  30398.             ea := (table at: index)
  30399.                         at: i.
  30400.             ea isNil ifFalse: [ea isInteger
  30401.                     ifTrue: [row at: i put: ea]
  30402.                     ifFalse: [ea size == 2
  30403.                             ifTrue: [row at: i put: (self constructGrammarProduction: ea with: prodTable)]
  30404.                             ifFalse: [row at: i put: (self constructTransductionGrammarProduction: ea with: prodTable)]]]]]! !
  30405.  
  30406. !OptimizedLR1Parser class methodsFor: 'reconstructing'!
  30407. constructTransductionGrammarProduction: arg with: prodTable 
  30408.  
  30409.     | rhs |
  30410.     (arg at: 2) isEmpty
  30411.         ifTrue: [rhs := OrderedCollection new]
  30412.         ifFalse: 
  30413.             [rhs := OrderedCollection new.
  30414.             (arg at: 2)
  30415.                 do: [:ea | rhs addLast: (prodTable at: ea)]].
  30416.     ^TransductionGrammarProduction
  30417.         leftHandSide: (prodTable at: (arg at: 1))
  30418.         rightHandSide: rhs
  30419.         translationSymbol: (prodTable at: (arg at: 3))! !
  30420.  
  30421. !OptimizedLR1Parser class methodsFor: 'instance creation'!
  30422. buildFrom: fsaParser
  30423.  
  30424.     ^self new convertToTable: fsaParser! !
  30425.  
  30426. TableDrivenParser initialize!
  30427.  
  30428. OptimizedLL1Parser initialize!
  30429.  
  30430. OptimizedLR1Parser initialize!
  30431.  
  30432. Object subclass: #AbstractScanner
  30433.     instanceVariableNames: 'source nextChar token tokenType buffer '
  30434.     classVariableNames: ''
  30435.     poolDictionaries: ''
  30436.     category: 'Compilers-Scanners'!
  30437. AbstractScanner comment:
  30438. '=================================================
  30439.     Copyright (c) 1992 by Justin O. Graver.
  30440.     All rights reserved (with exceptions).
  30441.     For complete information evaluate "Object tgenCopyright."
  30442. =================================================
  30443.  
  30444. I scan a source string and break it up into tokens using mechanisms provided in concrete subclasses.
  30445.  
  30446. Instance Variables:
  30447.     source            <ReadStream> - character input stream.
  30448.     nextChar        <Character + UndefinedObject> - one-character lookahead buffer for source, nil if no input left.
  30449.     token            <String> - current token buffer.
  30450.     tokenType    <String + Symbol> - current token type buffer.
  30451.     buffer            <WriteStream> - character accumulation buffer for tokens.
  30452. '!
  30453.  
  30454. AbstractScanner comment:
  30455. '=================================================
  30456.     Copyright (c) 1992 by Justin O. Graver.
  30457.     All rights reserved (with exceptions).
  30458.     For complete information evaluate "Object tgenCopyright."
  30459. =================================================
  30460.  
  30461. I scan a source string and break it up into tokens using mechanisms provided in concrete subclasses.
  30462.  
  30463. Instance Variables:
  30464.     source            <ReadStream> - character input stream.
  30465.     nextChar        <Character + UndefinedObject> - one-character lookahead buffer for source, nil if no input left.
  30466.     token            <String> - current token buffer.
  30467.     tokenType    <String + Symbol> - current token type buffer.
  30468.     buffer            <WriteStream> - character accumulation buffer for tokens.
  30469. '!
  30470.  
  30471. !AbstractScanner methodsFor: 'initialization'!
  30472. init
  30473.  
  30474.     self buffer: (RetractableWriteStream on: (String new: 32))! !
  30475.  
  30476. !AbstractScanner methodsFor: 'initialization'!
  30477. reset
  30478.     "Reset the initial state of the scanner before scanning a new source."
  30479.  
  30480.     self buffer reset.
  30481.     self token: nil.
  30482.     self tokenType: nil.
  30483.     self nextChar: nil! !
  30484.  
  30485. !AbstractScanner methodsFor: 'initialization'!
  30486. scanSource: aString 
  30487.     "Convert the input string to a read stream and scan the first token."
  30488.  
  30489.     self reset.
  30490.     self source: (RetractableReadStream on: aString).
  30491.     self nextChar: self source next.
  30492.     self scanToken! !
  30493.  
  30494. !AbstractScanner methodsFor: 'state accessing'!
  30495. buffer
  30496.  
  30497.     ^buffer! !
  30498.  
  30499. !AbstractScanner methodsFor: 'state accessing'!
  30500. buffer: argument 
  30501.  
  30502.     buffer := argument! !
  30503.  
  30504. !AbstractScanner methodsFor: 'state accessing'!
  30505. nextChar
  30506.  
  30507.     ^nextChar! !
  30508.  
  30509. !AbstractScanner methodsFor: 'state accessing'!
  30510. nextChar: argument 
  30511.  
  30512.     nextChar := argument! !
  30513.  
  30514. !AbstractScanner methodsFor: 'state accessing'!
  30515. source
  30516.  
  30517.     ^source! !
  30518.  
  30519. !AbstractScanner methodsFor: 'state accessing'!
  30520. source: argument 
  30521.  
  30522.     source := argument! !
  30523.  
  30524. !AbstractScanner methodsFor: 'state accessing'!
  30525. token
  30526.  
  30527.     ^token! !
  30528.  
  30529. !AbstractScanner methodsFor: 'state accessing'!
  30530. token: argument 
  30531.  
  30532.     token := argument! !
  30533.  
  30534. !AbstractScanner methodsFor: 'state accessing'!
  30535. tokenType
  30536.  
  30537.     ^tokenType! !
  30538.  
  30539. !AbstractScanner methodsFor: 'state accessing'!
  30540. tokenType: argument 
  30541.  
  30542.     tokenType := argument! !
  30543.  
  30544. !AbstractScanner methodsFor: 'scanning'!
  30545. backspaceSource
  30546.     "When the source is at the end, 'source current' is the last character."
  30547.  
  30548.     self atEnd ifFalse: [self source backspace].
  30549.     self nextChar: self source current! !
  30550.  
  30551. !AbstractScanner methodsFor: 'scanning'!
  30552. getNextChar
  30553.     "Source will answer an empty string when no more input is available. 
  30554.     Subclasses may override this to avoid unnecessary buffering."
  30555.  
  30556.     self buffer nextPut: self nextChar.
  30557.     self nextChar: self source next! !
  30558.  
  30559. !AbstractScanner methodsFor: 'scanning'!
  30560. putBackChar
  30561.     "Remove the last character in the buffer and backspace the source. 
  30562.     Subclasses may override this to avoid unnecessary buffering."
  30563.  
  30564.     self buffer backspace.
  30565.     self backspaceSource! !
  30566.  
  30567. !AbstractScanner methodsFor: 'scanning'!
  30568. scanToken
  30569.     "Subclasses must compute values for token and tokenType here."
  30570.  
  30571.     self subclassResponsibility! !
  30572.  
  30573. !AbstractScanner methodsFor: 'scanning'!
  30574. signalEndOfInput
  30575.     "Set scanner to the end-of-input state."
  30576.  
  30577.     self tokenType: self endOfInputTokenType.
  30578.     self token: self endOfInputToken! !
  30579.  
  30580. !AbstractScanner methodsFor: 'testing'!
  30581. atEnd
  30582.  
  30583.     ^self nextChar = self endOfInputToken! !
  30584.  
  30585. !AbstractScanner methodsFor: 'accessing'!
  30586. contents
  30587.  
  30588.     ^self source contents! !
  30589.  
  30590. !AbstractScanner methodsFor: 'accessing'!
  30591. endOfInputToken
  30592.     "Answer a token representing the end of the input."
  30593.  
  30594.     self subclassResponsibility! !
  30595.  
  30596. !AbstractScanner methodsFor: 'accessing'!
  30597. endOfInputTokenType
  30598.     "Answer the token type representing the end of the input."
  30599.  
  30600.     self subclassResponsibility! !
  30601.  
  30602. !AbstractScanner methodsFor: 'accessing'!
  30603. errorPosition
  30604.     "Answer the source position of the last acceptable character."
  30605.  
  30606.     ^source position + (self atEnd
  30607.             ifTrue: [1]
  30608.             ifFalse: [0]) max: 1! !
  30609.  
  30610. !AbstractScanner methodsFor: 'accessing'!
  30611. position
  30612.  
  30613.     ^self source position! !
  30614.  
  30615. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  30616.  
  30617. AbstractScanner class
  30618.     instanceVariableNames: ''!
  30619.  
  30620. !AbstractScanner class methodsFor: 'instance creation'!
  30621. new
  30622.  
  30623.     ^super new init! !
  30624.  
  30625. !AbstractScanner class methodsFor: 'instance creation'!
  30626. scanFrom: aString 
  30627.  
  30628.     | newScanner |
  30629.     newScanner := self new.
  30630.     newScanner scanSource: aString.
  30631.     ^newScanner! !
  30632.  
  30633. AbstractScanner subclass: #FSABasedScanner
  30634.     instanceVariableNames: 'fsa '
  30635.     classVariableNames: ''
  30636.     poolDictionaries: ''
  30637.     category: 'Compilers-Scanners'!
  30638. FSABasedScanner comment:
  30639. '=================================================
  30640.     Copyright (c) 1992 by Justin O. Graver.
  30641.     All rights reserved (with exceptions).
  30642.     For complete information evaluate "Object tgenCopyright."
  30643. =================================================
  30644.  
  30645. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a minimal deterministic finite-state automata (FSA).  Each token is also given a type by its associated final state in the FSA.  Specific FSAs are stored in class instance variables of my concrete subclasses.
  30646.  
  30647. Instance Variables:
  30648.     fsa                <FSAState> - a local reference to the token recognizer, in minimal deterministic form, for this class of scanner.
  30649. '!
  30650.  
  30651. FSABasedScanner comment:
  30652. '=================================================
  30653.     Copyright (c) 1992 by Justin O. Graver.
  30654.     All rights reserved (with exceptions).
  30655.     For complete information evaluate "Object tgenCopyright."
  30656. =================================================
  30657.  
  30658. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a minimal deterministic finite-state automata (FSA).  Each token is also given a type by its associated final state in the FSA.  Specific FSAs are stored in class instance variables of my concrete subclasses.
  30659.  
  30660. Instance Variables:
  30661.     fsa                <FSAState> - a local reference to the token recognizer, in minimal deterministic form, for this class of scanner.
  30662. '!
  30663.  
  30664. !FSABasedScanner methodsFor: 'state accessing'!
  30665. fsa
  30666.  
  30667.     ^fsa! !
  30668.  
  30669. !FSABasedScanner methodsFor: 'state accessing'!
  30670. fsa: argument 
  30671.  
  30672.     fsa := argument! !
  30673.  
  30674. !FSABasedScanner methodsFor: 'scanning directives'!
  30675. compactDoubleApostrophes
  30676.     "Compact all two apostrophe sequences in my current token into a single 
  30677.     apostrophe."
  30678.  
  30679.     | readStream writeStream ch nextCh |
  30680.     readStream := ReadStream on: self token.
  30681.     writeStream := WriteStream on: (String new: 20).
  30682.     [readStream atEnd]
  30683.         whileFalse: 
  30684.             [writeStream nextPut: (ch := readStream next).
  30685.             (ch = $' and: [(nextCh := readStream peek) notNil and: [nextCh = $']])
  30686.                 ifTrue: [readStream skip: 1]].
  30687.     self token: writeStream contents! !
  30688.  
  30689. !FSABasedScanner methodsFor: 'scanning directives'!
  30690. ignoreComment
  30691.  
  30692.     self scanToken! !
  30693.  
  30694. !FSABasedScanner methodsFor: 'scanning directives'!
  30695. ignoreDelimiter
  30696.  
  30697.     self scanToken! !
  30698.  
  30699. !FSABasedScanner methodsFor: 'accessing'!
  30700. endOfInputToken
  30701.     "Answer a token representing the end of the input."
  30702.  
  30703.     ^Character endOfInput! !
  30704.  
  30705. !FSABasedScanner methodsFor: 'accessing'!
  30706. endOfInputTokenType
  30707.     "Answer the token type representing the end of the input."
  30708.  
  30709.     ^self endOfInputToken! !
  30710.  
  30711. !FSABasedScanner methodsFor: 'accessing'!
  30712. myFsa
  30713.  
  30714.     ^self class fsa! !
  30715.  
  30716. !FSABasedScanner methodsFor: 'accessing'!
  30717. startState
  30718.  
  30719.     ^self fsa! !
  30720.  
  30721. !FSABasedScanner methodsFor: 'scanning'!
  30722. scanToken
  30723.     "Scan the next token and compute its token type."
  30724.  
  30725.     | state nextState tok typeAction |
  30726.     self atEnd
  30727.         ifTrue: [self signalEndOfInput]
  30728.         ifFalse: 
  30729.             [state := self startState.
  30730.             [(nextState := self at: state transitionFor: self nextChar) isNil]
  30731.                 whileFalse: 
  30732.                     [state := nextState.
  30733.                     self getNextChar].
  30734.             tok := self buffer contents.
  30735.             typeAction := self at: state tokenTypeAndActionFor: tok.
  30736.             self tokenType: typeAction type.
  30737.             self token: tok.
  30738.             self buffer reset.
  30739.             typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  30740.  
  30741. !FSABasedScanner methodsFor: 'initialization'!
  30742. init
  30743.  
  30744.     super init.
  30745.     self fsa: self myFsa! !
  30746.  
  30747. !FSABasedScanner methodsFor: 'scanner generation'!
  30748. classInitializationMethodTextForClassNamed: name spec: tokenSpec 
  30749.  
  30750.     ^self subclassResponsibility! !
  30751.  
  30752. !FSABasedScanner methodsFor: 'scanner generation'!
  30753. createScannerClassNamed: name category: category spec: tokenSpec 
  30754.  
  30755.     | scannerClass |
  30756.     scannerClass := self defaultScannerClass
  30757.                 subclass: name asSymbol
  30758.                 instanceVariableNames: ''
  30759.                 classVariableNames: ''
  30760.                 poolDictionaries: ''
  30761.                 category: category.
  30762.     scannerClass comment: self generatedScannerClassComment.
  30763.     scannerClass class compile: (self classInitializationMethodTextForClassNamed: name spec: tokenSpec)
  30764.         classified: 'class initialization'.
  30765.     scannerClass initialize.
  30766.     ^scannerClass! !
  30767.  
  30768. !FSABasedScanner methodsFor: 'scanner generation'!
  30769. generatedScannerClassComment
  30770.  
  30771.     ^'This scanner class was automatically generated by ', TranslatorGenerator versionName , '.'! !
  30772.  
  30773. !FSABasedScanner methodsFor: 'scanner generation'!
  30774. defaultScannerClass
  30775.  
  30776.     ^self class! !
  30777.  
  30778. !FSABasedScanner methodsFor: 'scanner generation'!
  30779. defaultOptimizedScannerClass
  30780.  
  30781.     ^OptimizedScanner! !
  30782.  
  30783. !FSABasedScanner methodsFor: 'converting'!
  30784. fastScanner
  30785.  
  30786.     ^self defaultOptimizedScannerClass buildFrom: self! !
  30787.  
  30788. !FSABasedScanner methodsFor: 'private'!
  30789. at: state tokenTypeAndActionFor: tok 
  30790.  
  30791.     ^state tokenTypeAndActionFor: tok! !
  30792.  
  30793. !FSABasedScanner methodsFor: 'private'!
  30794. at: state transitionFor: char 
  30795.  
  30796.     ^state transitionFor: char! !
  30797.  
  30798. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  30799.  
  30800. FSABasedScanner class
  30801.     instanceVariableNames: 'fsa '!
  30802.  
  30803. !FSABasedScanner class methodsFor: 'state accessing'!
  30804. fsa
  30805.  
  30806.     ^fsa! !
  30807.  
  30808. !FSABasedScanner class methodsFor: 'state accessing'!
  30809. fsa: argument 
  30810.  
  30811.     fsa := argument! !
  30812.  
  30813. !FSABasedScanner class methodsFor: 'class initialization'!
  30814. initialize
  30815.     "Concrete subclasses must somehow provide a fsa. Subclasses created by 
  30816.     automatic means may simply 'plug-in' a dynamically computed fsa. However, if a 
  30817.     class that can be filed-out is desired then it is worthwhile to override this 
  30818.     initialization method with one that can build the appropriate fsa directly."
  30819.     "FSABasedScanner initialize"
  30820.  
  30821.     self fsa: nil! !
  30822.  
  30823. FSABasedScanner subclass: #FSABasedLookaheadScanner
  30824.     instanceVariableNames: 'savePosition '
  30825.     classVariableNames: ''
  30826.     poolDictionaries: ''
  30827.     category: 'Compilers-Scanners'!
  30828. FSABasedLookaheadScanner comment:
  30829. '=================================================
  30830.     Copyright (c) 1992 by Justin O. Graver.
  30831.     All rights reserved (with exceptions).
  30832.     For complete information evaluate "Object tgenCopyright."
  30833. =================================================
  30834.  
  30835. This is an abstract class for scanners with lookahead.
  30836.  
  30837. Instance Variables:
  30838.     savePosition <Integer> - pointer into input source for error notification.'!
  30839.  
  30840. FSABasedLookaheadScanner comment:
  30841. '=================================================
  30842.     Copyright (c) 1992 by Justin O. Graver.
  30843.     All rights reserved (with exceptions).
  30844.     For complete information evaluate "Object tgenCopyright."
  30845. =================================================
  30846.  
  30847. This is an abstract class for scanners with lookahead.
  30848.  
  30849. Instance Variables:
  30850.     savePosition <Integer> - pointer into input source for error notification.'!
  30851.  
  30852. !FSABasedLookaheadScanner methodsFor: 'initialization'!
  30853. reset
  30854.     "Reset the initial state of the scanner before scanning a new source."
  30855.  
  30856.     super reset.
  30857.     self savePosition: 0! !
  30858.  
  30859. !FSABasedLookaheadScanner methodsFor: 'state accessing'!
  30860. savePosition
  30861.  
  30862.     ^savePosition! !
  30863.  
  30864. !FSABasedLookaheadScanner methodsFor: 'state accessing'!
  30865. savePosition: argument 
  30866.  
  30867.     savePosition := argument! !
  30868.  
  30869. !FSABasedLookaheadScanner methodsFor: 'accessing'!
  30870. errorPosition
  30871.     "Answer the source position of the last acceptable character."
  30872.  
  30873.     ^self savePosition max: 1! !
  30874.  
  30875. FSABasedLookaheadScanner subclass: #FSABasedScannerWithTwoTokenLookahead
  30876.     instanceVariableNames: 'stateStack saveState saveChar '
  30877.     classVariableNames: ''
  30878.     poolDictionaries: ''
  30879.     category: 'Compilers-Scanners'!
  30880. FSABasedScannerWithTwoTokenLookahead comment:
  30881. '=================================================
  30882.     Copyright (c) 1992 by Justin O. Graver.
  30883.     All rights reserved (with exceptions).
  30884.     For complete information evaluate "Object tgenCopyright."
  30885. =================================================
  30886.  
  30887. This class provides a scanner with simple two-token lookahead.
  30888.  
  30889. Instance Variables:
  30890.     stateStack    <Stack> - primary state stack for scanning tokens.
  30891.     saveState    <Integer> - pointer into input source for error notification.
  30892.     saveChar    <Character> - pointer into input source for error notification.'!
  30893.  
  30894. FSABasedScannerWithTwoTokenLookahead comment:
  30895. '=================================================
  30896.     Copyright (c) 1992 by Justin O. Graver.
  30897.     All rights reserved (with exceptions).
  30898.     For complete information evaluate "Object tgenCopyright."
  30899. =================================================
  30900.  
  30901. This class provides a scanner with simple two-token lookahead.
  30902.  
  30903. Instance Variables:
  30904.     stateStack    <Stack> - primary state stack for scanning tokens.
  30905.     saveState    <Integer> - pointer into input source for error notification.
  30906.     saveChar    <Character> - pointer into input source for error notification.'!
  30907.  
  30908. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanner generation'!
  30909. defaultOptimizedScannerClass
  30910.  
  30911.     ^OptimizedScannerWithTwoTokenLookahead! !
  30912.  
  30913. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  30914. checkForTokenIn: newStateStack buffer: charBuffer 
  30915.     "Scan the input using the arguments. Answer true if a legal token (or no illegal token) was 
  30916.     found and false otherwise."
  30917.  
  30918.     | nextState |
  30919.     self atEnd
  30920.         ifFalse: 
  30921.             [newStateStack push: self startState.
  30922.             "look for longest possible token"
  30923.             [(nextState := newStateStack top transitionFor: self nextChar ifNone: [nil]) isNil]
  30924.                 whileFalse: 
  30925.                     [newStateStack push: nextState.
  30926.                     "getNextChar for local vars"
  30927.                     charBuffer nextPut: self nextChar.
  30928.                     self nextChar: self source next].
  30929.             "save the current position for error notification"
  30930.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  30931.             newStateStack top isFSAFinalState
  30932.                 ifFalse: 
  30933.                     [self saveChar: self nextChar.
  30934.                     self saveState: newStateStack top.
  30935.                     "backup to the previous final state or to the start state"
  30936.                     [newStateStack size = 1 or: [newStateStack top isFSAFinalState]]
  30937.                         whileFalse: 
  30938.                             [newStateStack pop.
  30939.                             "putBackChar for local vars"
  30940.                             charBuffer backspace.
  30941.                             self backspaceSource].
  30942.                     newStateStack size = 1 ifTrue: 
  30943.                         ["backed up to the start state"
  30944.                         self stateStack == newStateStack
  30945.                             ifTrue: 
  30946.                                 ["this is the first token, so signal an error (abort and return)"
  30947.                                 self saveState transitionFor: self saveChar]
  30948.                             ifFalse: 
  30949.                                 ["we may be able to backup in the previous token"
  30950.                                 ^false]]]].
  30951.     ^true! !
  30952.  
  30953. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  30954. scanToken
  30955.     "Scan the next token and compute its token type."
  30956.  
  30957.     | tok typeAction newStateStack charBuffer |
  30958.     newStateStack := Stack new.
  30959.     charBuffer := RetractableWriteStream on: (String new: 32).
  30960.     (self checkForTokenIn: newStateStack buffer: charBuffer)
  30961.         ifTrue: 
  30962.             ["either a legal token or the end on input was found"
  30963.             self stateStack isEmpty ifTrue: [self atEnd
  30964.                     ifTrue: [^self signalEndOfInput]
  30965.                     ifFalse: [self error: 'no more vaild tokens']].
  30966.             tok := self buffer contents.
  30967.             typeAction := self stateStack top tokenTypeAndActionFor: tok.
  30968.             self tokenType: typeAction type.
  30969.             self token: tok.
  30970.             self buffer: charBuffer.
  30971.             self stateStack: newStateStack.
  30972.             typeAction action notNil ifTrue: [self perform: typeAction action]]
  30973.         ifFalse: 
  30974.             ["an illegal token was found, try to look for earlier final state in current token buffers"
  30975.             charBuffer size timesRepeat: 
  30976.                 ["put back illegal token chars"
  30977.                 self backspaceSource].
  30978.             "backup in current token to next smallest legal token"
  30979.             [self stateStack size = 1
  30980.                 or: 
  30981.                     [self stateStack pop.
  30982.                     self putBackChar.
  30983.                     self stateStack top isFSAFinalState]] whileFalse.
  30984.             self stateStack size = 1
  30985.                 ifTrue: 
  30986.                     ["no smaller legal token so signal error"
  30987.                     self saveState transitionFor: self saveChar]
  30988.                 ifFalse: 
  30989.                     ["try again"
  30990.                     self scanToken]]! !
  30991.  
  30992. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  30993. saveChar
  30994.  
  30995.     ^saveChar! !
  30996.  
  30997. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  30998. saveChar: argument 
  30999.  
  31000.     saveChar := argument! !
  31001.  
  31002. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31003. saveState
  31004.  
  31005.     ^saveState! !
  31006.  
  31007. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31008. saveState: argument 
  31009.  
  31010.     saveState := argument! !
  31011.  
  31012. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31013. stateStack
  31014.  
  31015.     ^stateStack! !
  31016.  
  31017. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31018. stateStack: argument 
  31019.  
  31020.     stateStack := argument! !
  31021.  
  31022. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  31023. reset
  31024.     "Reset the initial state of the scanner before scanning a new source."
  31025.  
  31026.     super reset.
  31027.     self stateStack: Stack new! !
  31028.  
  31029. !FSABasedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  31030. scanSource: aString 
  31031.     "Convert the input string to a read stream and scan the first token."
  31032.  
  31033.     self reset.
  31034.     self source: (RetractableReadStream on: aString).
  31035.     self nextChar: self source next.
  31036.     self checkForTokenIn: self stateStack buffer: self buffer.
  31037.     self scanToken! !
  31038.  
  31039. FSABasedLookaheadScanner subclass: #FSABasedScannerWithOneTokenLookahead
  31040.     instanceVariableNames: ''
  31041.     classVariableNames: ''
  31042.     poolDictionaries: ''
  31043.     category: 'Compilers-Scanners'!
  31044. FSABasedScannerWithOneTokenLookahead comment:
  31045. '=================================================
  31046.     Copyright (c) 1992 by Justin O. Graver.
  31047.     All rights reserved (with exceptions).
  31048.     For complete information evaluate "Object tgenCopyright."
  31049. =================================================
  31050.  
  31051. This class provides a scanner with simple one-token lookahead.  '!
  31052.  
  31053. FSABasedScannerWithOneTokenLookahead comment:
  31054. '=================================================
  31055.     Copyright (c) 1992 by Justin O. Graver.
  31056.     All rights reserved (with exceptions).
  31057.     For complete information evaluate "Object tgenCopyright."
  31058. =================================================
  31059.  
  31060. This class provides a scanner with simple one-token lookahead.  '!
  31061.  
  31062. !FSABasedScannerWithOneTokenLookahead methodsFor: 'scanner generation'!
  31063. defaultOptimizedScannerClass
  31064.  
  31065.     ^OptimizedScannerWithOneTokenLookahead! !
  31066.  
  31067. !FSABasedScannerWithOneTokenLookahead methodsFor: 'scanning'!
  31068. scanToken
  31069.     "Scan the next token and compute its token type."
  31070.  
  31071.     | nextState tok typeAction stateStack saveChar saveState |
  31072.     stateStack := Stack new.
  31073.     self atEnd
  31074.         ifTrue: [self signalEndOfInput]
  31075.         ifFalse: 
  31076.             [stateStack push: self startState.
  31077.             [(nextState := stateStack top transitionFor: self nextChar ifNone: [nil]) isNil]
  31078.                 whileFalse: 
  31079.                     [stateStack push: nextState.
  31080.                     self getNextChar].
  31081.             "save the current position for error notification"
  31082.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  31083.             stateStack top isFSAFinalState
  31084.                 ifFalse: 
  31085.                     [saveChar := self nextChar.
  31086.                     saveState := stateStack top.
  31087.                     "backup to the previous final state or to the start state"
  31088.                     [stateStack size = 1 or: [stateStack top isFSAFinalState]]
  31089.                         whileFalse: 
  31090.                             [stateStack pop.
  31091.                             self putBackChar].
  31092.                     stateStack size = 1 ifTrue: 
  31093.                         ["backed up to the start state so signal an error"
  31094.                         saveState transitionFor: saveChar]].
  31095.             "answer the newly scanned token"
  31096.             tok := self buffer contents.
  31097.             typeAction := stateStack top tokenTypeAndActionFor: tok.
  31098.             self tokenType: typeAction type.
  31099.             self token: tok.
  31100.             self buffer reset.
  31101.             typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  31102.  
  31103. FSABasedScanner subclass: #OptimizedScanner
  31104.     instanceVariableNames: 'finalStateTable '
  31105.     classVariableNames: 'NoTransitionSignal '
  31106.     poolDictionaries: ''
  31107.     category: 'Compilers-Scanners'!
  31108. OptimizedScanner comment:
  31109. '=================================================
  31110.     Copyright (c) 1992 by Justin O. Graver.
  31111.     All rights reserved (with exceptions).
  31112.     For complete information evaluate "Object tgenCopyright."
  31113. =================================================
  31114.  
  31115. I am an abstract class of scanner that scans a source string and breaks it up into tokens
  31116. using a table created by converting FSA to integer.
  31117.  
  31118. instance Variables:
  31119.     finalStateTable        - a table that maps integer ( represented as final state ) to 
  31120.                            literal tokens and token classes.
  31121. '!
  31122.  
  31123. OptimizedScanner comment:
  31124. '=================================================
  31125.     Copyright (c) 1992 by Justin O. Graver.
  31126.     All rights reserved (with exceptions).
  31127.     For complete information evaluate "Object tgenCopyright."
  31128. =================================================
  31129.  
  31130. I am an abstract class of scanner that scans a source string and breaks it up into tokens
  31131. using a table created by converting FSA to integer.
  31132.  
  31133. instance Variables:
  31134.     finalStateTable        - a table that maps integer ( represented as final state ) to 
  31135.                            literal tokens and token classes.
  31136. '!
  31137.  
  31138. !OptimizedScanner methodsFor: 'converting'!
  31139. assignNextIDAfter: id toSuccessorOf: state 
  31140.     "I try to assing a number to fsa in order to create a fsa table."
  31141.  
  31142.     | nextID nextState |
  31143.     nextID := id + 1.
  31144.     state edgeLabelMap
  31145.         associationsDo: 
  31146.             [:assoc | 
  31147.             nextState := assoc value.
  31148.             nextState stateID isNil
  31149.                 ifTrue: 
  31150.                     [nextState stateID: nextID.
  31151.                     nextState isFSAFinalState ifTrue: [(finalStateTable includes: nextState)
  31152.                             ifFalse: [finalStateTable at: nextID put: nextState]].
  31153.                     nextID := self assignNextIDAfter: nextID toSuccessorOf: nextState]].
  31154.     ^nextID! !
  31155.  
  31156. !OptimizedScanner methodsFor: 'converting'!
  31157. changeFSAToObjectTable: fsaState 
  31158.  
  31159.     | sizePlusOne objectTable  |
  31160.     fsaState stateID notNil ifTrue: [fsaState nilOutStateIDs].
  31161.     fsaState stateID:  self startState.
  31162.     self finalStateTable: Dictionary new.
  31163.     sizePlusOne := self assignNextIDAfter: self startState toSuccessorOf: fsaState.
  31164.     objectTable := Array new: sizePlusOne - 1.
  31165.     self convert: fsaState to: objectTable.
  31166.     self modifyFSAFinalStates: sizePlusOne - 1.        "convert Dictionary to Array for speed"
  31167.     ^objectTable! !
  31168.  
  31169. !OptimizedScanner methodsFor: 'converting'!
  31170. convert: state to: objectTable 
  31171.     "I try to create a table that maps state ( represented by integer ) to state"
  31172.  
  31173.     | arr nextState |
  31174.     arr := Array new: 127.
  31175.     objectTable at: state stateID put: arr.
  31176.     state edgeLabelMap
  31177.         associationsDo: 
  31178.             [:assoc | 
  31179.             nextState := assoc value.
  31180.             (objectTable at: nextState stateID) isNil ifTrue: [self convert: nextState to: objectTable].
  31181.             arr at: assoc key asInteger put: nextState stateID].
  31182.     ^objectTable! !
  31183.  
  31184. !OptimizedScanner methodsFor: 'converting'!
  31185. convertToTable: fsaScanner 
  31186.  
  31187.     self fsa: (self changeFSAToObjectTable: fsaScanner fsa)! !
  31188.  
  31189. !OptimizedScanner methodsFor: 'converting'!
  31190. modifyFSAFinalStates: index 
  31191.     "Convert Dictionary and its values to Array of Array"
  31192.  
  31193.     | tokenSet table |
  31194.     table := Array new: index.
  31195.     finalStateTable do: 
  31196.         [:st | 
  31197.         tokenSet := Array new: 2.
  31198.         tokenSet at: 1 put: st literalTokens asOrderedCollection asArray; at: 2 put: st tokenClasses asArray.
  31199.         table at: st stateID put: tokenSet].
  31200.     self finalStateTable: table! !
  31201.  
  31202. !OptimizedScanner methodsFor: 'private'!
  31203. at: state transitionFor: char 
  31204.  
  31205.     | value |
  31206.     (value := (fsa at: state)
  31207.                 at: char asInteger) isNil ifTrue: [(finalStateTable at: state) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (char == self endOfInputToken
  31208.                     ifTrue: [self endOfInputErrorString]
  31209.                     ifFalse: [self standardErrorString , '''' , char printString , ''''])]].
  31210.     ^value! !
  31211.  
  31212. !OptimizedScanner methodsFor: 'initialization'!
  31213. init
  31214.  
  31215.     super init.
  31216.     self finalStateTable: self myFinalStateTable! !
  31217.  
  31218. !OptimizedScanner methodsFor: 'state accessing'!
  31219. finalStateTable
  31220.  
  31221.     ^finalStateTable! !
  31222.  
  31223. !OptimizedScanner methodsFor: 'state accessing'!
  31224. finalStateTable: arg 
  31225.  
  31226.     finalStateTable := arg! !
  31227.  
  31228. !OptimizedScanner methodsFor: 'accessing'!
  31229. myFinalStateTable
  31230.  
  31231.     ^self class finalStateTable! !
  31232.  
  31233. !OptimizedScanner methodsFor: 'accessing'!
  31234. startState
  31235.  
  31236.     ^1! !
  31237.  
  31238. !OptimizedScanner methodsFor: 'exception handling'!
  31239. endOfInputErrorString
  31240.  
  31241.     ^'end of input encountered'! !
  31242.  
  31243. !OptimizedScanner methodsFor: 'exception handling'!
  31244. raiseNoTransitionExceptionErrorString: aString 
  31245.  
  31246.     self class noTransitionSignal raiseErrorString: aString! !
  31247.  
  31248. !OptimizedScanner methodsFor: 'exception handling'!
  31249. standardErrorString
  31250.  
  31251.     ^'illegal character encountered:  '! !
  31252.  
  31253. !OptimizedScanner methodsFor: 'testing'!
  31254. atEnd
  31255.  
  31256.     ^nextChar == self endOfInputToken        "end-of-file character"! !
  31257.  
  31258. !OptimizedScanner methodsFor: 'reconstructing'!
  31259. reconstructFinalStateTableOn: aStream 
  31260.  
  31261.     aStream nextPutAll: 'table := '.
  31262.     finalStateTable reconstructOn: aStream.
  31263.     aStream
  31264.         period;
  31265.         crtab;
  31266.         nextPutAll: 'self constructFinalStateTable: table'! !
  31267.  
  31268. !OptimizedScanner methodsFor: 'reconstructing'!
  31269. reconstructFSAOn: aStream 
  31270.  
  31271.     aStream nextPutAll: 'self fsa: '.
  31272.     fsa reconstructOn: aStream.
  31273.     aStream period; crtab! !
  31274.  
  31275. !OptimizedScanner methodsFor: 'reconstructing'!
  31276. reconstructOn: aStream 
  31277.     "Recreate fsa and final state tables"
  31278.  
  31279.     self reconstructFSAOn: aStream.
  31280.     self reconstructFinalStateTableOn: aStream! !
  31281.  
  31282. !OptimizedScanner methodsFor: 'scanner generation'!
  31283. classInitializationMethodTextForClassNamed: name spec: tokenSpec 
  31284.     | ws |
  31285.     ws := WriteStream on: (String new: 2048).
  31286.     ws
  31287.         nextPutAll: 'initialize';
  31288.         crtab;
  31289.         nextPut: $";
  31290.         nextPutAll: name;
  31291.         nextPutAll: ' initialize"';
  31292.         crtab;
  31293.         nextPut: $".
  31294.     tokenSpec do: 
  31295.         [:ch | 
  31296.         "double embedded double-quote characters"
  31297.         ws nextPut: ch.
  31298.         ch = $" ifTrue: [ws nextPut: $"]].
  31299.     ws
  31300.         nextPut: $";
  31301.         cr;
  31302.         crtab;
  31303.         nextPutAll: '| table |';
  31304.         crtab.
  31305.     self reconstructOn: ws.
  31306.     ^ws contents! !
  31307.  
  31308. !OptimizedScanner methodsFor: 'scanning'!
  31309. at: state tokenTypeAndActionFor: aString 
  31310.     "The current implementation does not handle overlapping token classes. Hence, a final state 
  31311.     can only represent a literal or a single token class. Therefore, if not a literal then it must be 
  31312.     the token class."
  31313.  
  31314.     | tc |
  31315.     (((finalStateTable at: state)
  31316.         at: 1)
  31317.         includes: aString)
  31318.         ifTrue: [^TokenTypeActionHolder type: aString action: nil].
  31319.     tc := ((finalStateTable at: state)
  31320.                 at: 2) first .
  31321.     ^TokenTypeActionHolder type: tc tokenType action: tc action! !
  31322.  
  31323. !OptimizedScanner methodsFor: 'scanning'!
  31324. getNextChar
  31325.     "Source will answer an eof char when no more input is available. 
  31326.     Subclasses may override this to avoid unnecessary buffering."
  31327.  
  31328.     buffer nextPut: nextChar.
  31329.     nextChar := source next! !
  31330.  
  31331. !OptimizedScanner methodsFor: 'scanning'!
  31332. signalEndOfInput
  31333.     "Set scanner to the end-of-input state."
  31334.  
  31335.     tokenType := token := self endOfInputToken! !
  31336.  
  31337. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  31338.  
  31339. OptimizedScanner class
  31340.     instanceVariableNames: 'finalStateTable tokenTable '!
  31341.  
  31342. !OptimizedScanner class methodsFor: 'state accessing'!
  31343. finalStateTable
  31344.  
  31345.     ^finalStateTable! !
  31346.  
  31347. !OptimizedScanner class methodsFor: 'state accessing'!
  31348. finalStateTable: arg 
  31349.  
  31350.     finalStateTable := arg! !
  31351.  
  31352. !OptimizedScanner class methodsFor: 'state accessing'!
  31353. noTransitionSignal
  31354.  
  31355.     ^NoTransitionSignal! !
  31356.  
  31357. !OptimizedScanner class methodsFor: 'state accessing'!
  31358. noTransitionSignal: arg 
  31359.  
  31360.     NoTransitionSignal := arg! !
  31361.  
  31362. !OptimizedScanner class methodsFor: 'state accessing'!
  31363. tokenTable
  31364.  
  31365.     ^tokenTable! !
  31366.  
  31367. !OptimizedScanner class methodsFor: 'state accessing'!
  31368. tokenTable: arg 
  31369.  
  31370.     tokenTable := arg! !
  31371.  
  31372. !OptimizedScanner class methodsFor: 'class initialization'!
  31373. initialize
  31374.     "OptimizedScanner initialize"
  31375.  
  31376.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol).! !
  31377.  
  31378. !OptimizedScanner class methodsFor: 'reconstructing'!
  31379. constructFinalStateTable: arg 
  31380.  
  31381.     finalStateTable := Array new: arg size.
  31382.     1 to: arg size do: [:index | finalStateTable at: index put: ((arg at: index) isNil
  31383.                 ifTrue: [nil]
  31384.                 ifFalse: [Array with: ((arg at: index)
  31385.                             at: 1)
  31386.                         with: (self constructTokenClassification: ((arg at: index)
  31387.                                     at: 2))])]! !
  31388.  
  31389. !OptimizedScanner class methodsFor: 'reconstructing'!
  31390. constructTokenClassification: aCollection 
  31391.  
  31392.     | tc ea arr |
  31393.     aCollection size == 1
  31394.         ifTrue: 
  31395.             [tc := aCollection first.
  31396.             ^Array with: (TokenClassification
  31397.                     tokenType: (tc at: 1)
  31398.                     action: (tc at: 2))]
  31399.         ifFalse: 
  31400.             [arr := Array new: aCollection size.
  31401.             1 to: aCollection size do: 
  31402.                 [:index | 
  31403.                 ea := aCollection at: index.
  31404.                 arr at: index put: (TokenClassification
  31405.                         tokenType: (ea at: 1)
  31406.                         action: (ea at: 2))].
  31407.             ^arr]! !
  31408.  
  31409. !OptimizedScanner class methodsFor: 'instance creation'!
  31410. buildFrom: fsaScanner
  31411.  
  31412.     ^self new convertToTable: fsaScanner! !
  31413.  
  31414. OptimizedScanner subclass: #OptimizedLookaheadScanner
  31415.     instanceVariableNames: 'savePosition '
  31416.     classVariableNames: ''
  31417.     poolDictionaries: ''
  31418.     category: 'Compilers-Scanners'!
  31419. OptimizedLookaheadScanner comment:
  31420. '=================================================
  31421.     Copyright (c) 1992 by Justin O. Graver.
  31422.     All rights reserved (with exceptions).
  31423.     For complete information evaluate "Object tgenCopyright."
  31424. =================================================
  31425.  
  31426. This is an abstract class for table-based optimized scanners with lookahead.
  31427.  
  31428. Instance Variables:
  31429.     savePosition <Integer> - pointer into input source for error notification.'!
  31430.  
  31431. OptimizedLookaheadScanner comment:
  31432. '=================================================
  31433.     Copyright (c) 1992 by Justin O. Graver.
  31434.     All rights reserved (with exceptions).
  31435.     For complete information evaluate "Object tgenCopyright."
  31436. =================================================
  31437.  
  31438. This is an abstract class for table-based optimized scanners with lookahead.
  31439.  
  31440. Instance Variables:
  31441.     savePosition <Integer> - pointer into input source for error notification.'!
  31442.  
  31443. !OptimizedLookaheadScanner methodsFor: 'accessing'!
  31444. errorPosition
  31445.     "Answer the source position of the last acceptable character."
  31446.  
  31447.     ^self savePosition max: 1! !
  31448.  
  31449. !OptimizedLookaheadScanner methodsFor: 'initialization'!
  31450. reset
  31451.     "Reset the initial state of the scanner before scanning a new source."
  31452.  
  31453.     super reset.
  31454.     self savePosition: 0! !
  31455.  
  31456. !OptimizedLookaheadScanner methodsFor: 'state accessing'!
  31457. savePosition
  31458.  
  31459.     ^savePosition! !
  31460.  
  31461. !OptimizedLookaheadScanner methodsFor: 'state accessing'!
  31462. savePosition: argument 
  31463.  
  31464.     savePosition := argument! !
  31465.  
  31466. !OptimizedLookaheadScanner methodsFor: 'testing'!
  31467. isFSAFinalState: aState
  31468.     "Answer true if aState is a final state, false otherwise."
  31469.  
  31470.     ^(self finalStateTable at: aState) notNil! !
  31471.  
  31472. AbstractScanner subclass: #HandCodedScanner
  31473.     instanceVariableNames: 'charTypeTable '
  31474.     classVariableNames: ''
  31475.     poolDictionaries: ''
  31476.     category: 'Compilers-Scanners'!
  31477. HandCodedScanner comment:
  31478. '=================================================
  31479.     Copyright (c) 1992 by Justin O. Graver.
  31480.     All rights reserved (with exceptions).
  31481.     For complete information evaluate "Object tgenCopyright."
  31482. =================================================
  31483.  
  31484. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a character type table and hand-coded scanner methods.  Specific type tables are stored in class instance variables of my concrete subclasses.
  31485.  
  31486. Instance Variables:
  31487.     charTypeTable    <Array of: Symbol> - a local reference to the type table for this class of scanner; the ascii value of each character is mapped to a symbol token type.
  31488. '!
  31489.  
  31490. HandCodedScanner comment:
  31491. '=================================================
  31492.     Copyright (c) 1992 by Justin O. Graver.
  31493.     All rights reserved (with exceptions).
  31494.     For complete information evaluate "Object tgenCopyright."
  31495. =================================================
  31496.  
  31497. I am an abstract class of scanner that scans a source string and breaks it up into tokens using a character type table and hand-coded scanner methods.  Specific type tables are stored in class instance variables of my concrete subclasses.
  31498.  
  31499. Instance Variables:
  31500.     charTypeTable    <Array of: Symbol> - a local reference to the type table for this class of scanner; the ascii value of each character is mapped to a symbol token type.
  31501. '!
  31502.  
  31503. !HandCodedScanner methodsFor: 'state accessing'!
  31504. charTypeTable
  31505.  
  31506.     ^charTypeTable! !
  31507.  
  31508. !HandCodedScanner methodsFor: 'state accessing'!
  31509. charTypeTable: argument 
  31510.  
  31511.     charTypeTable := argument! !
  31512.  
  31513. !HandCodedScanner methodsFor: 'initialization'!
  31514. init
  31515.  
  31516.     super init.
  31517.     self charTypeTable: self myTypeTable! !
  31518.  
  31519. !HandCodedScanner methodsFor: 'accessing'!
  31520. endOfInputToken
  31521.     "Answer a token representing the end of the input."
  31522.  
  31523.     ^nil! !
  31524.  
  31525. !HandCodedScanner methodsFor: 'accessing'!
  31526. endOfInputTokenType
  31527.     "Answer the token type representing the end of the input."
  31528.  
  31529.     ^#doIt! !
  31530.  
  31531. !HandCodedScanner methodsFor: 'accessing'!
  31532. myTypeTable
  31533.  
  31534.     ^self class charTypeTable! !
  31535.  
  31536. !HandCodedScanner methodsFor: 'testing'!
  31537. atStartOfComplexToken
  31538.     "Answer true if the first character of the tokenType is an $x and false otherwise."
  31539.  
  31540.     ^(self tokenType at: 1)
  31541.         = $x! !
  31542.  
  31543. !HandCodedScanner methodsFor: 'scanning'!
  31544. scanToken
  31545.     "Scan the next token and compute its token type.  This may be 
  31546.     overridden in subclasses for efficiency and customization."
  31547.  
  31548.     
  31549.     [self atEnd ifTrue: [^self signalEndOfInput].
  31550.     self tokenType: (self charTypeTable at: self nextChar asInteger).
  31551.     self tokenType == #xDelimiter]
  31552.         whileTrue: 
  31553.             ["Skip delimiters fast, there almost always is one."
  31554.             self getNextChar].
  31555.     self atStartOfComplexToken
  31556.         ifTrue: 
  31557.             ["perform to compute token & type"
  31558.             self perform: tokenType]
  31559.         ifFalse: 
  31560.             ["else just the character"
  31561.             self token: self nextChar.
  31562.             self getNextChar]! !
  31563.  
  31564. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  31565.  
  31566. HandCodedScanner class
  31567.     instanceVariableNames: 'charTypeTable '!
  31568.  
  31569. !HandCodedScanner class methodsFor: 'class initialization'!
  31570. initialize
  31571.     "Concrete subclasses must provide a character type table."
  31572.     "HandCodedScanner initialize"
  31573.  
  31574.     | newTable |
  31575.     newTable := Array new: 256 withAll: #xDefault.        "default"
  31576.     self charTypeTable: newTable! !
  31577.  
  31578. !HandCodedScanner class methodsFor: 'state accessing'!
  31579. charTypeTable
  31580.  
  31581.     ^charTypeTable! !
  31582.  
  31583. !HandCodedScanner class methodsFor: 'state accessing'!
  31584. charTypeTable: argument 
  31585.  
  31586.     charTypeTable := argument! !
  31587.  
  31588. OptimizedLookaheadScanner subclass: #OptimizedScannerWithOneTokenLookahead
  31589.     instanceVariableNames: ''
  31590.     classVariableNames: ''
  31591.     poolDictionaries: ''
  31592.     category: 'Compilers-Scanners'!
  31593. OptimizedScannerWithOneTokenLookahead comment:
  31594. '=================================================
  31595.     Copyright (c) 1992 by Justin O. Graver.
  31596.     All rights reserved (with exceptions).
  31597.     For complete information evaluate "Object tgenCopyright."
  31598. =================================================
  31599.  
  31600. This class provides a table-based optimized scanner with simple one-token lookahead.  '!
  31601.  
  31602. OptimizedScannerWithOneTokenLookahead comment:
  31603. '=================================================
  31604.     Copyright (c) 1992 by Justin O. Graver.
  31605.     All rights reserved (with exceptions).
  31606.     For complete information evaluate "Object tgenCopyright."
  31607. =================================================
  31608.  
  31609. This class provides a table-based optimized scanner with simple one-token lookahead.  '!
  31610.  
  31611. !OptimizedScannerWithOneTokenLookahead methodsFor: 'scanning'!
  31612. scanToken
  31613.     "Scan the next token and compute its token type."
  31614.  
  31615.     | nextState tok typeAction stateStack saveChar saveState |
  31616.     stateStack := Stack new.
  31617.     self atEnd
  31618.         ifTrue: [self signalEndOfInput]
  31619.         ifFalse:
  31620.             [stateStack push: self startState.
  31621.             [(nextState := (fsa at: stateStack top) at: self nextChar asInteger) isNil]
  31622.                 whileFalse:
  31623.                     [stateStack push: nextState.
  31624.                     self getNextChar].
  31625.             "save the current position for error notification"
  31626.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  31627.             (self isFSAFinalState: stateStack top)
  31628.                 ifFalse:
  31629.                     ["save the current position for error notification"
  31630.                     saveChar := self nextChar.
  31631.                     saveState := stateStack top.
  31632.                     "backup to the previous final state or to the start state"
  31633.                     [stateStack size = 1 or: [self isFSAFinalState: stateStack top]]
  31634.                         whileFalse:
  31635.                             [stateStack pop.
  31636.                             self putBackChar].
  31637.                     stateStack size = 1
  31638.                         ifTrue:
  31639.                         ["backed up to the start state so signal an error"
  31640.                         self at: saveState transitionFor: saveChar]].
  31641.         "answer the newly scanned token"
  31642.         tok := self buffer contents.
  31643.         typeAction := self at: stateStack top tokenTypeAndActionFor: tok.
  31644.         self tokenType: typeAction type.
  31645.         self token: tok.
  31646.         self buffer reset.
  31647.         typeAction action notNil ifTrue: [self perform: typeAction action]]! !
  31648.  
  31649. OptimizedLookaheadScanner subclass: #OptimizedScannerWithTwoTokenLookahead
  31650.     instanceVariableNames: 'stateStack saveState saveChar '
  31651.     classVariableNames: ''
  31652.     poolDictionaries: ''
  31653.     category: 'Compilers-Scanners'!
  31654. OptimizedScannerWithTwoTokenLookahead comment:
  31655. '=================================================
  31656.     Copyright (c) 1992 by Justin O. Graver.
  31657.     All rights reserved (with exceptions).
  31658.     For complete information evaluate "Object tgenCopyright."
  31659. =================================================
  31660.  
  31661. This class provides a table-based optimized scanner with simple two-token lookahead.
  31662.  
  31663. Instance Variables:
  31664.     stateStack    <Stack> - primary state stack for scanning tokens.
  31665.     saveState    <Integer> - pointer into input source for error notification.
  31666.     saveChar    <Character> - pointer into input source for error notification.'!
  31667.  
  31668. OptimizedScannerWithTwoTokenLookahead comment:
  31669. '=================================================
  31670.     Copyright (c) 1992 by Justin O. Graver.
  31671.     All rights reserved (with exceptions).
  31672.     For complete information evaluate "Object tgenCopyright."
  31673. =================================================
  31674.  
  31675. This class provides a table-based optimized scanner with simple two-token lookahead.
  31676.  
  31677. Instance Variables:
  31678.     stateStack    <Stack> - primary state stack for scanning tokens.
  31679.     saveState    <Integer> - pointer into input source for error notification.
  31680.     saveChar    <Character> - pointer into input source for error notification.'!
  31681.  
  31682. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  31683. checkForTokenIn: newStateStack buffer: charBuffer 
  31684.     "Scan the input using the arguments. Answer true if a legal token (or no illegal token) was 
  31685.     found and false otherwise."
  31686.  
  31687.     | nextState |
  31688.     self atEnd
  31689.         ifFalse: 
  31690.             [newStateStack push: self startState.
  31691.             "look for longest possible token"
  31692.             [(nextState := (fsa at: newStateStack top) at: self nextChar asInteger) isNil]
  31693.                 whileFalse: 
  31694.                     [newStateStack push: nextState.
  31695.                     "getNextChar for local vars"
  31696.                     charBuffer nextPut: self nextChar.
  31697.                     self nextChar: self source next].
  31698.             "save the current position for error notification"
  31699.             self savePosition: self position + (self atEnd ifTrue: [1] ifFalse: [0]).
  31700.             (self isFSAFinalState: newStateStack top)
  31701.                 ifFalse: 
  31702.                     ["save the current position for error notification"
  31703.                     saveChar := self nextChar.
  31704.                     saveState := newStateStack top.
  31705.                     "backup to the previous final state or to the start state"
  31706.                     [newStateStack size = 1 or: [self isFSAFinalState: newStateStack top]]
  31707.                         whileFalse: 
  31708.                             [newStateStack pop.
  31709.                             "putBackChar for local vars"
  31710.                             charBuffer backspace.
  31711.                             self backspaceSource].
  31712.                     newStateStack size = 1 ifTrue: 
  31713.                         ["backed up to the start state"
  31714.                         self stateStack == newStateStack
  31715.                             ifTrue: 
  31716.                                 ["this is the first token, so signal an error (abort and return)"
  31717.                                 self at: saveState transitionFor: saveChar]
  31718.                             ifFalse: 
  31719.                                 ["we may be able to backup in the previous token"
  31720.                                 ^false]]]].
  31721.     ^true! !
  31722.  
  31723. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'scanning'!
  31724. scanToken
  31725.     "Scan the next token and compute its token type."
  31726.  
  31727.     | tok typeAction newStateStack charBuffer |
  31728.     newStateStack := Stack new.
  31729.     charBuffer := RetractableWriteStream on: (String new: 32).
  31730.     (self checkForTokenIn: newStateStack buffer: charBuffer)
  31731.         ifTrue: 
  31732.             ["either a legal token or the end on input was found"
  31733.             self stateStack isEmpty ifTrue: [self atEnd
  31734.                     ifTrue: [^self signalEndOfInput]
  31735.                     ifFalse: [self error: 'no more vaild tokens']].
  31736.             tok := self buffer contents.
  31737.             typeAction := self at: stateStack top tokenTypeAndActionFor: tok.
  31738.             self tokenType: typeAction type.
  31739.             self token: tok.
  31740.             self buffer: charBuffer.
  31741.             self stateStack: newStateStack.
  31742.             typeAction action notNil ifTrue: [self perform: typeAction action]]
  31743.         ifFalse: 
  31744.             ["an illegal token was found, try to look for earlier final state in current token buffers"
  31745.             charBuffer size timesRepeat: 
  31746.                 ["put back illegal token chars"
  31747.                 self backspaceSource].
  31748.             "backup in current token to next smallest legal token"
  31749.             [self stateStack size = 1
  31750.                 or: 
  31751.                     [self stateStack pop.
  31752.                     self putBackChar.
  31753.                     self isFSAFinalState: stateStack top]] whileFalse.
  31754.             self stateStack size = 1
  31755.                 ifTrue: 
  31756.                     ["no smaller legal token so signal error"
  31757.                     self at: saveState transitionFor: saveChar]
  31758.                 ifFalse: 
  31759.                     ["try again"
  31760.                     self scanToken]]! !
  31761.  
  31762. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  31763. reset
  31764.     "Reset the initial state of the scanner before scanning a new source."
  31765.  
  31766.     super reset.
  31767.     self stateStack: Stack new! !
  31768.  
  31769. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'initialization'!
  31770. scanSource: aString 
  31771.     "Convert the input string to a read stream and scan the first token."
  31772.  
  31773.     self reset.
  31774.     self source: (RetractableReadStream on: aString).
  31775.     self nextChar: self source next.
  31776.     self checkForTokenIn: self stateStack buffer: self buffer.
  31777.     self scanToken! !
  31778.  
  31779. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31780. saveChar
  31781.  
  31782.     ^saveChar! !
  31783.  
  31784. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31785. saveChar: argument 
  31786.  
  31787.     saveChar := argument! !
  31788.  
  31789. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31790. saveState
  31791.  
  31792.     ^saveState! !
  31793.  
  31794. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31795. saveState: argument 
  31796.  
  31797.     saveState := argument! !
  31798.  
  31799. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31800. stateStack
  31801.  
  31802.     ^stateStack! !
  31803.  
  31804. !OptimizedScannerWithTwoTokenLookahead methodsFor: 'state accessing'!
  31805. stateStack: argument 
  31806.  
  31807.     stateStack := argument! !
  31808.  
  31809. FSABasedScanner initialize!
  31810.  
  31811. HandCodedScanner initialize!
  31812.  
  31813. OptimizedScanner initialize!
  31814.  
  31815. OrderedCollection variableSubclass: #OrderedChildren
  31816.     instanceVariableNames: ''
  31817.     classVariableNames: ''
  31818.     poolDictionaries: ''
  31819.     category: 'T-gen-Parse Trees'!
  31820. OrderedChildren comment:
  31821. '=================================================
  31822.     Copyright (c) 1992 by Justin O. Graver.
  31823.     All rights reserved (with exceptions).
  31824.     For complete information evaluate "Object tgenCopyright."
  31825. =================================================
  31826.  
  31827. It is often helpful to create a node that has a arbitrary (but flat) collection of nodes as a child.  My instances provide containers for these "collection children".  In other words, I am a collection that acts like a single parse tree node.'!
  31828.  
  31829. OrderedChildren comment:
  31830. '=================================================
  31831.     Copyright (c) 1992 by Justin O. Graver.
  31832.     All rights reserved (with exceptions).
  31833.     For complete information evaluate "Object tgenCopyright."
  31834. =================================================
  31835.  
  31836. It is often helpful to create a node that has a arbitrary (but flat) collection of nodes as a child.  My instances provide containers for these "collection children".  In other words, I am a collection that acts like a single parse tree node.'!
  31837.  
  31838. !OrderedChildren methodsFor: 'building parse trees'!
  31839. addChildrenFirst: anOrderedCollection 
  31840.  
  31841.     self addAllFirst: anOrderedCollection! !
  31842.  
  31843. !OrderedChildren methodsFor: 'building parse trees'!
  31844. addChildrenInitial: anOrderedCollection 
  31845.  
  31846.     self addAll: anOrderedCollection! !
  31847.  
  31848. !OrderedChildren methodsFor: 'building parse trees'!
  31849. addChildrenLast: anOrderedCollection 
  31850.  
  31851.     self addAllLast: anOrderedCollection! !
  31852.  
  31853. !OrderedChildren methodsFor: 'building parse trees'!
  31854. setAttribute: value 
  31855.  
  31856.     self shouldNotImplement! !
  31857.  
  31858. Object subclass: #ParseTreeBuilder
  31859.     instanceVariableNames: 'stack '
  31860.     classVariableNames: ''
  31861.     poolDictionaries: ''
  31862.     category: 'T-gen-Parse Trees'!
  31863. ParseTreeBuilder comment:
  31864. '=================================================
  31865.     Copyright (c) 1992 by Justin O. Graver.
  31866.     All rights reserved (with exceptions).
  31867.     For complete information evaluate "Object tgenCopyright."
  31868. =================================================
  31869.  
  31870. This is an abstract class that provides a framework for building parse trees during parsing.  Parse trees are built in a bottom-up fashion during parsing by processing key productions, and with the help of a stack.  In general, a key production has the form:
  31871.  
  31872.     A -> N1 N2 ... Nk => symbol
  31873.  
  31874. where A and the Ni are nonterminals (terminals may be interspersed freely in the right-hand side) and symbol is the production directive (or translation symbol).  Since trees are built bottom-up, the information flow in a production is from the right-hand side to the left-hand side.  When a production is ready to be processed, the top of the stack contains objects (parse trees) associated with the right-hand-side nonterminals of the production.  Processing a production involves replacing these objects with a single object representing (associated with) the left-hand-side nonterminal.  This can be thought of as computing a value for A as a function of the values of the Ni''s, i.e. value(A) = fcn(value(N1), value(N2), ..., value(Nk)).  Default functions are defined in my concrete subclasses but users may define their own production processing functions by creating a new subclass and implementing appropriate messages.  This enables users to have direct control over exactly how parse trees are built. 
  31875.  
  31876. Instance Variables:
  31877.     stack    <Stack> - holds intermediate node values during production processing.'!
  31878.  
  31879. ParseTreeBuilder comment:
  31880. '=================================================
  31881.     Copyright (c) 1992 by Justin O. Graver.
  31882.     All rights reserved (with exceptions).
  31883.     For complete information evaluate "Object tgenCopyright."
  31884. =================================================
  31885.  
  31886. This is an abstract class that provides a framework for building parse trees during parsing.  Parse trees are built in a bottom-up fashion during parsing by processing key productions, and with the help of a stack.  In general, a key production has the form:
  31887.  
  31888.     A -> N1 N2 ... Nk => symbol
  31889.  
  31890. where A and the Ni are nonterminals (terminals may be interspersed freely in the right-hand side) and symbol is the production directive (or translation symbol).  Since trees are built bottom-up, the information flow in a production is from the right-hand side to the left-hand side.  When a production is ready to be processed, the top of the stack contains objects (parse trees) associated with the right-hand-side nonterminals of the production.  Processing a production involves replacing these objects with a single object representing (associated with) the left-hand-side nonterminal.  This can be thought of as computing a value for A as a function of the values of the Ni''s, i.e. value(A) = fcn(value(N1), value(N2), ..., value(Nk)).  Default functions are defined in my concrete subclasses but users may define their own production processing functions by creating a new subclass and implementing appropriate messages.  This enables users to have direct control over exactly how parse trees are built. 
  31891.  
  31892. Instance Variables:
  31893.     stack    <Stack> - holds intermediate node values during production processing.'!
  31894.  
  31895. !ParseTreeBuilder methodsFor: 'initialization'!
  31896. init
  31897.  
  31898.     self stack: Stack new! !
  31899.  
  31900. !ParseTreeBuilder methodsFor: 'state accessing'!
  31901. stack
  31902.  
  31903.     ^stack! !
  31904.  
  31905. !ParseTreeBuilder methodsFor: 'state accessing'!
  31906. stack: argument 
  31907.  
  31908.     stack := argument! !
  31909.  
  31910. !ParseTreeBuilder methodsFor: 'accessing'!
  31911. popStack
  31912.  
  31913.     ^self stack pop! !
  31914.  
  31915. !ParseTreeBuilder methodsFor: 'accessing'!
  31916. pushStack: anObject 
  31917.  
  31918.     ^self stack push: anObject! !
  31919.  
  31920. !ParseTreeBuilder methodsFor: 'accessing'!
  31921. result
  31922.     "Answer the root of the tree build by this tree builder."
  31923.  
  31924.     self stack size = 1 ifFalse: [self error: 'incorrectly built tree'].
  31925.     ^self popStack! !
  31926.  
  31927. !ParseTreeBuilder methodsFor: 'production processing'!
  31928. addChildrenFirst: children to: aNode 
  31929.     "Add children, as the new first children, to aNode and answer aNode."
  31930.  
  31931.     aNode addChildrenFirst: children.
  31932.     ^aNode! !
  31933.  
  31934. !ParseTreeBuilder methodsFor: 'production processing'!
  31935. addChildrenLast: children to: aNode 
  31936.     "Add children, as the new last children, to aNode and answer aNode."
  31937.  
  31938.     aNode addChildrenLast: children.
  31939.     ^aNode! !
  31940.  
  31941. !ParseTreeBuilder methodsFor: 'production processing'!
  31942. answerArgument: arg 
  31943.  
  31944.     ^arg! !
  31945.  
  31946. !ParseTreeBuilder methodsFor: 'production processing'!
  31947. answerNil
  31948.  
  31949.     ^nil! !
  31950.  
  31951. !ParseTreeBuilder methodsFor: 'production processing'!
  31952. makeNewNode: stringOrSymbol 
  31953.     "Answer a new parse tree node representing the argument."
  31954.  
  31955.     self subclassResponsibility! !
  31956.  
  31957. !ParseTreeBuilder methodsFor: 'production processing'!
  31958. makeNewNode: stringOrSymbol withAttribute: value 
  31959.     "Answer a new parse tree node and initialize its attribute value using the 
  31960.     setAttribute: message."
  31961.  
  31962.     | newNode |
  31963.     newNode := self makeNewNode: stringOrSymbol.
  31964.     newNode setAttribute: value.
  31965.     ^newNode! !
  31966.  
  31967. !ParseTreeBuilder methodsFor: 'production processing'!
  31968. makeNewNode: stringOrSymbol withChildren: children 
  31969.     "Answer a new parse tree node and initialize its children using the 
  31970.     addChildrenInitial: message."
  31971.  
  31972.     | newNode |
  31973.     newNode := self makeNewNode: stringOrSymbol.
  31974.     newNode addChildrenInitial: children.
  31975.     ^newNode! !
  31976.  
  31977. !ParseTreeBuilder methodsFor: 'tree building'!
  31978. popArgNodesForProduction: grammarProd fromParser: parser 
  31979.     "Answer a collection of nodes from my stack required for processing 
  31980.     grammarProd. The order for collecting nodes is parser dependent."
  31981.  
  31982.     | nodes |
  31983.     nodes := OrderedCollection new.
  31984.     grammarProd numberOfRhsNonterminals timesRepeat: (parser performsLeftmostDerivation
  31985.             ifTrue: [[nodes add: self popStack]]
  31986.             ifFalse: [[nodes addFirst: self popStack]]).
  31987.     ^nodes! !
  31988.  
  31989. !ParseTreeBuilder methodsFor: 'tree building'!
  31990. processProduction: grammarProd forParser: parser 
  31991.     "This is the main driver for production processing. The actual production 
  31992.     processing messages are sent indirectly by grammarProd."
  31993.  
  31994.     self pushStack: (grammarProd hasSingleTokenClassRhs
  31995.             ifTrue: [grammarProd computeResultNodeFor: self withTokenClassValue: parser prevToken]
  31996.             ifFalse: [grammarProd computeResultNodeFor: self withArgNodes: (self popArgNodesForProduction: grammarProd fromParser: parser)])! !
  31997.  
  31998. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  31999.  
  32000. ParseTreeBuilder class
  32001.     instanceVariableNames: ''!
  32002.  
  32003. !ParseTreeBuilder class methodsFor: 'instance creation'!
  32004. new
  32005.  
  32006.     ^super new init! !
  32007.  
  32008. ParseTreeBuilder subclass: #AbstractSyntaxTreeBuilder
  32009.     instanceVariableNames: 'shamMode '
  32010.     classVariableNames: ''
  32011.     poolDictionaries: ''
  32012.     category: 'T-gen-Parse Trees'!
  32013. AbstractSyntaxTreeBuilder comment:
  32014. '=================================================
  32015.     Copyright (c) 1992 by Justin O. Graver.
  32016.     All rights reserved (with exceptions).
  32017.     For complete information evaluate "Object tgenCopyright."
  32018. =================================================
  32019.  
  32020. I build parse trees by creating specific objects for each kind of node as indicated by the parser directives in grammar productions.  Parser directives currently fall into one of three groups: node (class) names, special directives, and arbitrary message selectors. For a node name, a new instance of the specified node is created and given the values associated with the right-hand side nonterminals, if any, as its children. The special directive ''nil'' simply returns nil. The directive liftRightChild adds any nodes preceeding the right-most node as children to the right-most node, and returns the right-most node. The directive liftLeftChild works in an analogous fashion. Arbitrary message selectors must take the same number of arguments as there are right-hand-side nodes and are invoked as a builder message, thus allowing users to define their own tree-building messages.
  32021.  
  32022. Productions of the form ''A -> <tc> => symbol'' are treated specially. The symbol can be either a node name or a one-argument message selector. If it is a node name then create a new instance of that node with the specified attribute value. If it is a message selector then invoke the corresponding operation on the builder with the specified value.
  32023.  
  32024. Instance Variables:
  32025.     shamMode    <Boolean> - If true DerivationTreeNode-based ASTs are built, otherwise specific ParseTreeNode-based ASTs are built.'!
  32026.  
  32027. AbstractSyntaxTreeBuilder comment:
  32028. '=================================================
  32029.     Copyright (c) 1992 by Justin O. Graver.
  32030.     All rights reserved (with exceptions).
  32031.     For complete information evaluate "Object tgenCopyright."
  32032. =================================================
  32033.  
  32034. I build parse trees by creating specific objects for each kind of node as indicated by the parser directives in grammar productions.  Parser directives currently fall into one of three groups: node (class) names, special directives, and arbitrary message selectors. For a node name, a new instance of the specified node is created and given the values associated with the right-hand side nonterminals, if any, as its children. The special directive ''nil'' simply returns nil. The directive liftRightChild adds any nodes preceeding the right-most node as children to the right-most node, and returns the right-most node. The directive liftLeftChild works in an analogous fashion. Arbitrary message selectors must take the same number of arguments as there are right-hand-side nodes and are invoked as a builder message, thus allowing users to define their own tree-building messages.
  32035.  
  32036. Productions of the form ''A -> <tc> => symbol'' are treated specially. The symbol can be either a node name or a one-argument message selector. If it is a node name then create a new instance of that node with the specified attribute value. If it is a message selector then invoke the corresponding operation on the builder with the specified value.
  32037.  
  32038. Instance Variables:
  32039.     shamMode    <Boolean> - If true DerivationTreeNode-based ASTs are built, otherwise specific ParseTreeNode-based ASTs are built.'!
  32040.  
  32041. !AbstractSyntaxTreeBuilder methodsFor: 'tree building'!
  32042. makeNewNode: stringOrSymbol 
  32043.     "The argument represents the name of a node class. If in sham mode answer a 
  32044.     new derivation tree node for the argument, otherwise answer a new instance of 
  32045.     that class."
  32046.  
  32047.     ^self shamMode
  32048.         ifTrue: [DerivationTreeNode symbol: stringOrSymbol]
  32049.         ifFalse: [(Smalltalk at: stringOrSymbol asSymbol ifAbsent: [self error: 'no class named ' , stringOrSymbol]) new]! !
  32050.  
  32051. !AbstractSyntaxTreeBuilder methodsFor: 'accessing'!
  32052. setNormalMode
  32053.  
  32054.     self shamMode: false! !
  32055.  
  32056. !AbstractSyntaxTreeBuilder methodsFor: 'accessing'!
  32057. setShamMode
  32058.  
  32059.     self shamMode: true! !
  32060.  
  32061. !AbstractSyntaxTreeBuilder methodsFor: 'state accessing'!
  32062. shamMode
  32063.  
  32064.     ^shamMode! !
  32065.  
  32066. !AbstractSyntaxTreeBuilder methodsFor: 'state accessing'!
  32067. shamMode: argument 
  32068.  
  32069.     shamMode := argument! !
  32070.  
  32071. !AbstractSyntaxTreeBuilder methodsFor: 'initialization'!
  32072. init
  32073.  
  32074.     super init.
  32075.     self setNormalMode! !
  32076.  
  32077. !AbstractSyntaxTreeBuilder methodsFor: 'initialization'!
  32078. reset
  32079.     "Empty the node stack and set to normal mode."
  32080.  
  32081.     self init! !
  32082.  
  32083. ParseTreeBuilder subclass: #DerivationTreeBuilder
  32084.     instanceVariableNames: ''
  32085.     classVariableNames: ''
  32086.     poolDictionaries: ''
  32087.     category: 'T-gen-Parse Trees'!
  32088. DerivationTreeBuilder comment:
  32089. '=================================================
  32090.     Copyright (c) 1992 by Justin O. Graver.
  32091.     All rights reserved (with exceptions).
  32092.     For complete information evaluate "Object tgenCopyright."
  32093. =================================================
  32094.  
  32095. This concrete class is used for building derivation trees for a parse.  It uses homogeneous DerivationTreeNodes for all nodes and a specialized production processor.'!
  32096.  
  32097. DerivationTreeBuilder comment:
  32098. '=================================================
  32099.     Copyright (c) 1992 by Justin O. Graver.
  32100.     All rights reserved (with exceptions).
  32101.     For complete information evaluate "Object tgenCopyright."
  32102. =================================================
  32103.  
  32104. This concrete class is used for building derivation trees for a parse.  It uses homogeneous DerivationTreeNodes for all nodes and a specialized production processor.'!
  32105.  
  32106. !DerivationTreeBuilder methodsFor: 'tree building'!
  32107. epsilon
  32108.     "Answer an object used to represent the empty string (epsilon)."
  32109.  
  32110.     ^'<epsilon>'! !
  32111.  
  32112. !DerivationTreeBuilder methodsFor: 'tree building'!
  32113. processProduction: grammarProd forParser: parser 
  32114.     "This is simple and straightforward to implement, so do it all here."
  32115.  
  32116.     | parent child |
  32117.     parent := DerivationTreeNode symbol: grammarProd leftHandSide.
  32118.     grammarProd rightHandSide isEmpty
  32119.         ifTrue: 
  32120.             [child := DerivationTreeNode symbol: self epsilon.
  32121.             parent addChild: child]
  32122.         ifFalse: [parser performsLeftmostDerivation
  32123.                 ifTrue: [grammarProd rightHandSide do: 
  32124.                         [:sym | 
  32125.                         child := sym isTerminal
  32126.                                     ifTrue: [DerivationTreeNode symbol: sym]
  32127.                                     ifFalse: [self popStack].
  32128.                         parent addChild: child]]
  32129.                 ifFalse: [grammarProd rightHandSide
  32130.                         reverseDo: 
  32131.                             [:sym | 
  32132.                             child := sym isTerminal
  32133.                                         ifTrue: [DerivationTreeNode symbol: sym]
  32134.                                         ifFalse: [self popStack].
  32135.                             parent addFirstChild: child]]].
  32136.     self pushStack: parent! !
  32137.  
  32138. TreeNode subclass: #ParseTreeNode
  32139.     instanceVariableNames: ''
  32140.     classVariableNames: ''
  32141.     poolDictionaries: ''
  32142.     category: 'T-gen-Parse Trees'!
  32143. ParseTreeNode comment:
  32144. '=================================================
  32145.     Copyright (c) 1992 by Justin O. Graver.
  32146.     All rights reserved (with exceptions).
  32147.     For complete information evaluate "Object tgenCopyright."
  32148. =================================================
  32149.  
  32150. I am an abstract class that provides the framework for parse tree nodes, basically just a reminder that the following messages may need to be implemented by concrete subclasses:
  32151.  
  32152.     addChildrenFirst:
  32153.     addChildrenInitial:
  32154.     addChildrenLast:
  32155.     setAttribute:'!
  32156.  
  32157. ParseTreeNode comment:
  32158. '=================================================
  32159.     Copyright (c) 1992 by Justin O. Graver.
  32160.     All rights reserved (with exceptions).
  32161.     For complete information evaluate "Object tgenCopyright."
  32162. =================================================
  32163.  
  32164. I am an abstract class that provides the framework for parse tree nodes, basically just a reminder that the following messages may need to be implemented by concrete subclasses:
  32165.  
  32166.     addChildrenFirst:
  32167.     addChildrenInitial:
  32168.     addChildrenLast:
  32169.     setAttribute:'!
  32170.  
  32171. !ParseTreeNode methodsFor: 'building parse trees'!
  32172. addChildrenFirst: anOrderedCollection 
  32173.     "Subclasses should implement this message."
  32174.  
  32175.     self shouldNotImplement! !
  32176.  
  32177. !ParseTreeNode methodsFor: 'building parse trees'!
  32178. addChildrenInitial: anOrderedCollection 
  32179.     "Subclasses should implement this message."
  32180.  
  32181.     self shouldNotImplement! !
  32182.  
  32183. !ParseTreeNode methodsFor: 'building parse trees'!
  32184. addChildrenLast: anOrderedCollection 
  32185.     "Subclasses should implement this message."
  32186.  
  32187.     self shouldNotImplement! !
  32188.  
  32189. !ParseTreeNode methodsFor: 'building parse trees'!
  32190. setAttribute: value 
  32191.     "Subclasses should implement this message."
  32192.  
  32193.     self shouldNotImplement! !
  32194.  
  32195. ParseTreeNode subclass: #DerivationTreeNode
  32196.     instanceVariableNames: 'symbol children '
  32197.     classVariableNames: ''
  32198.     poolDictionaries: ''
  32199.     category: 'T-gen-Parse Trees'!
  32200. DerivationTreeNode comment:
  32201. '=================================================
  32202.     Copyright (c) 1992 by Justin O. Graver.
  32203.     All rights reserved (with exceptions).
  32204.     For complete information evaluate "Object tgenCopyright."
  32205. =================================================
  32206.  
  32207. I represent an arbitrary node in a derivation or abstract tree.  (It would be nice to expand this concept so that heterogeneous parse trees could be built.)
  32208.  
  32209. Instance Variables:
  32210.     symbol    <String> - node attribute.
  32211.     children    <OrderedCollection of: DerivationTreeNode>'!
  32212.  
  32213. DerivationTreeNode comment:
  32214. '=================================================
  32215.     Copyright (c) 1992 by Justin O. Graver.
  32216.     All rights reserved (with exceptions).
  32217.     For complete information evaluate "Object tgenCopyright."
  32218. =================================================
  32219.  
  32220. I represent an arbitrary node in a derivation or abstract tree.  (It would be nice to expand this concept so that heterogeneous parse trees could be built.)
  32221.  
  32222. Instance Variables:
  32223.     symbol    <String> - node attribute.
  32224.     children    <OrderedCollection of: DerivationTreeNode>'!
  32225.  
  32226. !DerivationTreeNode methodsFor: 'state accessing'!
  32227. children
  32228.  
  32229.     ^children! !
  32230.  
  32231. !DerivationTreeNode methodsFor: 'state accessing'!
  32232. children: argument 
  32233.  
  32234.     children := argument! !
  32235.  
  32236. !DerivationTreeNode methodsFor: 'state accessing'!
  32237. symbol
  32238.  
  32239.     ^symbol! !
  32240.  
  32241. !DerivationTreeNode methodsFor: 'state accessing'!
  32242. symbol: argument 
  32243.  
  32244.     symbol := argument! !
  32245.  
  32246. !DerivationTreeNode methodsFor: 'printing'!
  32247. printOn: aStream 
  32248.  
  32249.     self printOn: aStream level: 0! !
  32250.  
  32251. !DerivationTreeNode methodsFor: 'printing'!
  32252. printOn: aStream dots: anInteger 
  32253.  
  32254.     anInteger timesRepeat: [aStream nextPutAll: ' . ']! !
  32255.  
  32256. !DerivationTreeNode methodsFor: 'printing'!
  32257. printOn: aStream level: level 
  32258.  
  32259.     self printOn: aStream dots: level.
  32260.     self symbol printOn: aStream.
  32261.     aStream cr.
  32262.     self childrenDo: [:child | child printOn: aStream level: level + 1]! !
  32263.  
  32264. !DerivationTreeNode methodsFor: 'initialization'!
  32265. init
  32266.  
  32267.     self children: OrderedCollection new! !
  32268.  
  32269. !DerivationTreeNode methodsFor: 'traversing'!
  32270. childrenDo: aBlock 
  32271.  
  32272.     self children do: aBlock! !
  32273.  
  32274. !DerivationTreeNode methodsFor: 'traversing'!
  32275. updateChildrenUsing: aBlock 
  32276.     "Replace my children according to the value of aBlock."
  32277.  
  32278.     self children: (self children collect: [:child | aBlock value: child])! !
  32279.  
  32280. !DerivationTreeNode methodsFor: 'testing'!
  32281. isNonterminal
  32282.  
  32283.     ^self symbol isNonterminal! !
  32284.  
  32285. !DerivationTreeNode methodsFor: 'testing'!
  32286. isTerminal
  32287.  
  32288.     ^self symbol isTerminal! !
  32289.  
  32290. !DerivationTreeNode methodsFor: 'manipulating children'!
  32291. addChild: aNode 
  32292.  
  32293.     self addLastChild: aNode! !
  32294.  
  32295. !DerivationTreeNode methodsFor: 'manipulating children'!
  32296. addFirstChild: aNode 
  32297.  
  32298.     self children addFirst: aNode! !
  32299.  
  32300. !DerivationTreeNode methodsFor: 'manipulating children'!
  32301. addLastChild: aNode 
  32302.  
  32303.     self children addLast: aNode! !
  32304.  
  32305. !DerivationTreeNode methodsFor: 'building parse trees'!
  32306. addChildrenFirst: anOrderedCollection 
  32307.  
  32308.     anOrderedCollection reverseDo: [:child | self addFirstChild: child]! !
  32309.  
  32310. !DerivationTreeNode methodsFor: 'building parse trees'!
  32311. addChildrenInitial: anOrderedCollection 
  32312.  
  32313.     self children: anOrderedCollection copy! !
  32314.  
  32315. !DerivationTreeNode methodsFor: 'building parse trees'!
  32316. addChildrenLast: anOrderedCollection 
  32317.  
  32318.     anOrderedCollection reverseDo: [:child | self addLastChild: child]! !
  32319.  
  32320. !DerivationTreeNode methodsFor: 'building parse trees'!
  32321. setAttribute: value 
  32322.  
  32323.     self symbol: value! !
  32324.  
  32325. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  32326.  
  32327. DerivationTreeNode class
  32328.     instanceVariableNames: ''!
  32329.  
  32330. !DerivationTreeNode class methodsFor: 'instance creation'!
  32331. symbol: aSymbol 
  32332.  
  32333.     | newNode |
  32334.     newNode := self new init.
  32335.     newNode symbol: aSymbol.
  32336.     ^newNode! !
  32337.  
  32338. Object subclass: #TokenTypeActionHolder
  32339.     instanceVariableNames: 'type action '
  32340.     classVariableNames: ''
  32341.     poolDictionaries: ''
  32342.     category: 'T-gen-Scanning/Parsing'!
  32343. TokenTypeActionHolder comment:
  32344. '=================================================
  32345.     Copyright (c) 1992 by Justin O. Graver.
  32346.     All rights reserved (with exceptions).
  32347.     For complete information evaluate "Object tgenCopyright."
  32348. =================================================
  32349.  
  32350. I am used to package token type and actions together for transport between FSAFinalStates and the scanner.
  32351.  
  32352. Instance Variables:
  32353.     type        <String> - token type.
  32354.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  32355.  
  32356. TokenTypeActionHolder comment:
  32357. '=================================================
  32358.     Copyright (c) 1992 by Justin O. Graver.
  32359.     All rights reserved (with exceptions).
  32360.     For complete information evaluate "Object tgenCopyright."
  32361. =================================================
  32362.  
  32363. I am used to package token type and actions together for transport between FSAFinalStates and the scanner.
  32364.  
  32365. Instance Variables:
  32366.     type        <String> - token type.
  32367.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  32368.  
  32369. !TokenTypeActionHolder methodsFor: 'state accessing'!
  32370. action
  32371.  
  32372.     ^action! !
  32373.  
  32374. !TokenTypeActionHolder methodsFor: 'state accessing'!
  32375. action: argument 
  32376.  
  32377.     action := argument! !
  32378.  
  32379. !TokenTypeActionHolder methodsFor: 'state accessing'!
  32380. type
  32381.  
  32382.     ^type! !
  32383.  
  32384. !TokenTypeActionHolder methodsFor: 'state accessing'!
  32385. type: argument 
  32386.  
  32387.     type := argument! !
  32388.  
  32389. !TokenTypeActionHolder methodsFor: 'printing'!
  32390. printOn: aStream
  32391.  
  32392.     aStream nextPutAll: self type.
  32393.     aStream nextPutAll: ' : {'.
  32394.     aStream nextPutAll: self action.
  32395.     aStream nextPutAll: '} ;'! !
  32396.  
  32397. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  32398.  
  32399. TokenTypeActionHolder class
  32400.     instanceVariableNames: ''!
  32401.  
  32402. !TokenTypeActionHolder class methodsFor: 'instance creation'!
  32403. type: arg1 action: arg2 
  32404.  
  32405.     | newMe |
  32406.     newMe := self new.
  32407.     newMe type: arg1.
  32408.     newMe action: arg2.
  32409.     ^newMe! !
  32410.  
  32411. Object variableSubclass: #GrammarProduction
  32412.     instanceVariableNames: 'leftHandSide rightHandSide '
  32413.     classVariableNames: ''
  32414.     poolDictionaries: ''
  32415.     category: 'T-gen-Scanning/Parsing'!
  32416. GrammarProduction comment:
  32417. '=================================================
  32418.     Copyright (c) 1992 by Justin O. Graver.
  32419.     All rights reserved (with exceptions).
  32420.     For complete information evaluate "Object tgenCopyright."
  32421. =================================================
  32422.  
  32423. I represent one production of a context-free grammar.  I am responsible for some parts of the first/follow set computation algorithm and for converting myself between various related representations (e.g. LR(0) items).
  32424.  
  32425. Instance Variables:
  32426.     leftHandSide        <Symbol>
  32427.     rightHandSide     <OrderedCollection of: (String + Symbol)>'!
  32428.  
  32429. GrammarProduction comment:
  32430. '=================================================
  32431.     Copyright (c) 1992 by Justin O. Graver.
  32432.     All rights reserved (with exceptions).
  32433.     For complete information evaluate "Object tgenCopyright."
  32434. =================================================
  32435.  
  32436. I represent one production of a context-free grammar.  I am responsible for some parts of the first/follow set computation algorithm and for converting myself between various related representations (e.g. LR(0) items).
  32437.  
  32438. Instance Variables:
  32439.     leftHandSide        <Symbol>
  32440.     rightHandSide     <OrderedCollection of: (String + Symbol)>'!
  32441.  
  32442. !GrammarProduction methodsFor: 'state accessing'!
  32443. leftHandSide
  32444.  
  32445.     ^leftHandSide! !
  32446.  
  32447. !GrammarProduction methodsFor: 'state accessing'!
  32448. leftHandSide: argument 
  32449.  
  32450.     leftHandSide := argument! !
  32451.  
  32452. !GrammarProduction methodsFor: 'state accessing'!
  32453. rightHandSide
  32454.  
  32455.     ^rightHandSide! !
  32456.  
  32457. !GrammarProduction methodsFor: 'state accessing'!
  32458. rightHandSide: argument 
  32459.  
  32460.     rightHandSide := argument! !
  32461.  
  32462. !GrammarProduction methodsFor: 'copying'!
  32463. postCopy
  32464.  
  32465.     super postCopy.
  32466.     self rightHandSide: self rightHandSide copy.
  32467.     ^self! !
  32468.  
  32469. !GrammarProduction methodsFor: 'parse tree building'!
  32470. computeResultNodeFor: builder withArgNodes: nodes 
  32471.     "Productions without translation symbols can only pass on a single argument 
  32472.     node."
  32473.  
  32474.     nodes size = 1 ifFalse: [self error: 'Productions without translation symbols can only
  32475. pass on results from a single right-hand side nonterminal'].
  32476.     ^builder answerArgument: nodes first! !
  32477.  
  32478. !GrammarProduction methodsFor: 'parse tree building'!
  32479. computeResultNodeFor: builder withTokenClassValue: value 
  32480.     "See this method in class TransductionGrammarProduction."
  32481.  
  32482.     self error: 'No translation has been specified that would
  32483. create a place to store the token class value.'! !
  32484.  
  32485. !GrammarProduction methodsFor: 'parse tree building'!
  32486. numberOfRhsNonterminals
  32487.     "Answer the number of nonterminals in my right-hand side."
  32488.  
  32489.     ^(self rightHandSide select: [:sym | sym isNonterminal]) size! !
  32490.  
  32491. !GrammarProduction methodsFor: 'testing'!
  32492. hasSingleTokenClassRhs
  32493.     "Answer true if my right hand side consists solely of 
  32494.     a single token class terminal symbol and false otherwise."
  32495.  
  32496.     ^self rightHandSide size = 1 and: [self rightHandSide first isTokenClassTerminal]! !
  32497.  
  32498. !GrammarProduction methodsFor: 'testing'!
  32499. hasTranslation
  32500.     "See class TransductionGrammarProduction."
  32501.  
  32502.     ^false! !
  32503.  
  32504. !GrammarProduction methodsFor: 'testing'!
  32505. isEpsilonProduction
  32506.     "Answer true if I am a production of the form S -> <epsilon> (i.e. if my right hand 
  32507.     side is empty) and false otherwise."
  32508.  
  32509.     ^self rightHandSide isEmpty! !
  32510.  
  32511. !GrammarProduction methodsFor: 'testing'!
  32512. isGrammarProduction
  32513.  
  32514.     ^true! !
  32515.  
  32516. !GrammarProduction methodsFor: 'testing'!
  32517. rightHandSideComprisedOf: aSet 
  32518.     "Answer true if all symbols in my right-hand side 
  32519.     are included in aSet and false otherwise."
  32520.  
  32521.     self rightHandSide detect: [:sym | (aSet includes: sym) not]
  32522.         ifNone: [^true].
  32523.     ^false! !
  32524.  
  32525. !GrammarProduction methodsFor: 'testing'!
  32526. rightHandSideHasAllNontermsIn: aSet 
  32527.     "Answer true if all nonterminals in my right-hand side 
  32528.     are included in aSet and false otherwise."
  32529.  
  32530.     self rightHandSide detect: [:sym | sym isNonterminal and: [(aSet includes: sym) not]]
  32531.         ifNone: [^true].
  32532.     ^false! !
  32533.  
  32534. !GrammarProduction methodsFor: 'printing'!
  32535. printOn: aStream 
  32536.  
  32537.     self printSymbol: self leftHandSide on: aStream.
  32538.     aStream
  32539.          tab;
  32540.          nextPut: $:;
  32541.          space.
  32542.     self rightHandSide do: 
  32543.         [:sym | 
  32544.         self printSymbol: sym on: aStream.
  32545.         aStream space]! !
  32546.  
  32547. !GrammarProduction methodsFor: 'private'!
  32548. lr0ItemClass
  32549.  
  32550.     ^LR0Item! !
  32551.  
  32552. !GrammarProduction methodsFor: 'private'!
  32553. lr1ItemClass
  32554.  
  32555.     ^LR1Item! !
  32556.  
  32557. !GrammarProduction methodsFor: 'private'!
  32558. lrParserStateClass
  32559.  
  32560.     ^LRParserState! !
  32561.  
  32562. !GrammarProduction methodsFor: 'private'!
  32563. printSymbol: sym on: aStream 
  32564.     "Render the given grammar symbol (terminal or nonterminal) on aStream. 
  32565.     This is provided so that grammars are printed in T-gen specification form.
  32566.     Nonterminals and token class terminals are printed without #s or 's and
  32567.     terminals are printed as strings."
  32568.  
  32569.     (sym isNonterminal or: [sym isTokenClassTerminal])
  32570.         ifTrue: [sym do: [:ch | aStream nextPut: ch]]
  32571.         ifFalse: [sym printOn: aStream]! !
  32572.  
  32573. !GrammarProduction methodsFor: 'private'!
  32574. symbolSuffixSeparatorChar
  32575.  
  32576.     ^self lrParserStateClass symbolSuffixSeparatorChar! !
  32577.  
  32578. !GrammarProduction methodsFor: 'conversion'!
  32579. asInitialLR0Item
  32580.  
  32581.     ^self lr0ItemClass
  32582.         leftHandSide: self leftHandSide
  32583.         preDotSymbols: OrderedCollection new
  32584.         postDotSymbols: self rightHandSide copy! !
  32585.  
  32586. !GrammarProduction methodsFor: 'conversion'!
  32587. asInitialLR1ItemWithLookahead: terminal 
  32588.  
  32589.     ^self lr1ItemClass
  32590.         leftHandSide: self leftHandSide
  32591.         preDotSymbols: OrderedCollection new
  32592.         postDotSymbols: self rightHandSide copy
  32593.         lookahead: terminal! !
  32594.  
  32595. !GrammarProduction methodsFor: 'conversion'!
  32596. asNonLalrSuffixedProduction
  32597.     "Assuming I am of the form 'A.<stuff1>* -> B.<stuff2>* C.<stuff3>*', 
  32598.     answer the prefix production 'A -> B C'."
  32599.  
  32600.     | separator lhs rhs |
  32601.     separator := self symbolSuffixSeparatorChar.
  32602.     lhs := self leftHandSide copyUpTo: separator.
  32603.     rhs := self rightHandSide collect: [:sym | sym copyUpTo: separator].
  32604.     ^self species leftHandSide: lhs rightHandSide: rhs! !
  32605.  
  32606. !GrammarProduction methodsFor: 'first/follow sets'!
  32607. computeFirstIn: grammar using: graph 
  32608.     "Build dependency graph for first sets and initialize first sets. Starting at the left 
  32609.     end of my right hand side, symbols are processed until a terminal or non-nullable 
  32610.     nonterminal is encountered. Any terminal encountered is added to the first set 
  32611.     associated with my left hand side node in the graph. Any nonterminal 
  32612.     encountered means that I must include its first set in mine. This accomplished 
  32613.     (indirectly) by adding an edge in the graph from the nonterminal's node to my lhs 
  32614.     node. The actual first set unioning will be done after the graph is complete (see 
  32615.     sender)."
  32616.  
  32617.     self rightHandSide do: 
  32618.         [:sym | 
  32619.         sym isTerminal
  32620.             ifTrue: 
  32621.                 [graph addTerminal: sym toNodeLabeled: self leftHandSide.
  32622.                 ^self].
  32623.         graph addEdgeFromNodeLabeled: sym toNodeLabeled: self leftHandSide.
  32624.         (grammar isNullable: sym)
  32625.             ifFalse: [^self]]! !
  32626.  
  32627. !GrammarProduction methodsFor: 'first/follow sets'!
  32628. computeFollowIn: grammar using: graph 
  32629.     "Build dependency graph for follow sets and initialize follow sets. This method 
  32630.     performs two distinct parts of the algorithm. First, each nonterminal in my right 
  32631.     hand side is checked to what symbols can follow it. Those symbols are added to 
  32632.     the follow set for the nonterminal's graph node. Second, starting at the right end 
  32633.     of my right hand side, symbols are processed until a terminal or non-nullable 
  32634.     nonterminal is encountered. Any nonterminal encountered means that my follow 
  32635.     set should also be included in its follow set. This accomplished (indirectly) by 
  32636.     adding an edge in the graph from my lhs node to the nonterminal's node. The 
  32637.     actual follow set unioning will be done after the graph is complete (see sender)."
  32638.  
  32639.     | n currSym more j nextSym |
  32640.     n := self rightHandSide size.
  32641.     1 to: n - 1 do: [:i | (currSym := self rightHandSide at: i) isNonterminal
  32642.             ifTrue: 
  32643.                 [more := true.
  32644.                 j := i + 1.
  32645.                 [j <= n & more]
  32646.                     whileTrue: 
  32647.                         [nextSym := self rightHandSide at: j.
  32648.                         (grammar firstSetOf: nextSym)
  32649.                             do: [:sym | graph addTerminal: sym toNodeLabeled: currSym].
  32650.                         j := j + 1.
  32651.                         more := grammar isNullable: nextSym]]].
  32652.     self rightHandSide
  32653.         reverseDo: 
  32654.             [:sym | 
  32655.             sym isTerminal ifTrue: [^self].
  32656.             graph addEdgeFromNodeLabeled: self leftHandSide toNodeLabeled: sym.
  32657.             (grammar isNullable: sym)
  32658.                 ifFalse: [^self]]! !
  32659.  
  32660. !GrammarProduction methodsFor: 'comparing'!
  32661. = aProd 
  32662.  
  32663.     ^aProd isGrammarProduction
  32664.         ifTrue: [self leftHandSide = aProd leftHandSide and: [self rightHandSide = aProd rightHandSide]]
  32665.         ifFalse: [false]! !
  32666.  
  32667. !GrammarProduction methodsFor: 'comparing'!
  32668. hash
  32669.     "This is redefined because = is redefined."
  32670.  
  32671.     ^self leftHandSide hash bitXor: self rightHandSide hash! !
  32672.  
  32673. !GrammarProduction methodsFor: 'reconstructing'!
  32674. constructItsContentOn: aStream using: tokenTable 
  32675.     "Emit lhs and #( rhs ) on aStream"
  32676.  
  32677.     (tokenTable indexOf: self leftHandSide)
  32678.         reconstructOn: aStream.
  32679.     aStream
  32680.          space;
  32681.          poundSign;
  32682.          leftParenthesis.
  32683.     self rightHandSide do: 
  32684.         [:ea | 
  32685.         (tokenTable indexOf: ea)
  32686.             reconstructOn: aStream.
  32687.         aStream space].
  32688.     aStream rightParenthesis! !
  32689.  
  32690. !GrammarProduction methodsFor: 'reconstructing'!
  32691. reconstructOn: aStream 
  32692.     "Emit #( productions ) on aStream "
  32693.  
  32694.     aStream poundSign; leftParenthesis.
  32695.     (self symbolTable at: self leftHandSide)
  32696.         reconstructOn: aStream.
  32697.     aStream
  32698.          space;
  32699.          poundSign;
  32700.          leftParenthesis.
  32701.     self rightHandSide do: 
  32702.         [:ea | 
  32703.         (self symbolTable at: ea)
  32704.             reconstructOn: aStream.
  32705.         aStream space].
  32706.     aStream
  32707.          rightParenthesis;
  32708.          rightParenthesis;
  32709.          space! !
  32710.  
  32711. !GrammarProduction methodsFor: 'reconstructing'!
  32712. reconstructOn: aStream using: tokenTable 
  32713.  
  32714.     aStream poundSign; leftParenthesis.
  32715.     self constructItsContentOn: aStream using: tokenTable.
  32716.     aStream rightParenthesis; space! !
  32717.  
  32718. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  32719.  
  32720. GrammarProduction class
  32721.     instanceVariableNames: ''!
  32722.  
  32723. !GrammarProduction class methodsFor: 'instance creation'!
  32724. leftHandSide: arg1 rightHandSide: arg2 
  32725.  
  32726.     | newMe |
  32727.     newMe := self new.
  32728.     newMe leftHandSide: arg1.
  32729.     newMe rightHandSide: arg2.
  32730.     ^newMe! !
  32731.  
  32732. GrammarProduction variableSubclass: #TransductionGrammarProduction
  32733.     instanceVariableNames: 'translationSymbol '
  32734.     classVariableNames: ''
  32735.     poolDictionaries: ''
  32736.     category: 'T-gen-Scanning/Parsing'!
  32737. TransductionGrammarProduction comment:
  32738. '=================================================
  32739.     Copyright (c) 1992 by Justin O. Graver.
  32740.     All rights reserved (with exceptions).
  32741.     For complete information evaluate "Object tgenCopyright."
  32742. =================================================
  32743.  
  32744. I add a translation attribute to context-free grammar productions so that I can be used to build simple transduction grammars (or syntax-directed translation scheme).  Transduction grammars are used to build abstract syntax trees rather than derivation trees during parsing.  For more information, refer to Chapter 7. ("Syntax-Directed Translation") in {\em Compiler Construction:  Theory and Practice} by Barrett, Bates, Gustafson, and Couch.
  32745.  
  32746. Instance Variables:
  32747.     translationSymbol <String> - used as basis for translation node when parsing.'!
  32748.  
  32749. TransductionGrammarProduction comment:
  32750. '=================================================
  32751.     Copyright (c) 1992 by Justin O. Graver.
  32752.     All rights reserved (with exceptions).
  32753.     For complete information evaluate "Object tgenCopyright."
  32754. =================================================
  32755.  
  32756. I add a translation attribute to context-free grammar productions so that I can be used to build simple transduction grammars (or syntax-directed translation scheme).  Transduction grammars are used to build abstract syntax trees rather than derivation trees during parsing.  For more information, refer to Chapter 7. ("Syntax-Directed Translation") in {\em Compiler Construction:  Theory and Practice} by Barrett, Bates, Gustafson, and Couch.
  32757.  
  32758. Instance Variables:
  32759.     translationSymbol <String> - used as basis for translation node when parsing.'!
  32760.  
  32761. !TransductionGrammarProduction methodsFor: 'state accessing'!
  32762. translationSymbol
  32763.  
  32764.     ^translationSymbol! !
  32765.  
  32766. !TransductionGrammarProduction methodsFor: 'state accessing'!
  32767. translationSymbol: argument 
  32768.  
  32769.     translationSymbol := argument! !
  32770.  
  32771. !TransductionGrammarProduction methodsFor: 'testing'!
  32772. hasTranslation
  32773.  
  32774.     ^true! !
  32775.  
  32776. !TransductionGrammarProduction methodsFor: 'printing'!
  32777. printOn: aStream 
  32778.  
  32779.     super printOn: aStream.
  32780.     aStream nextPutAll: ' {'.
  32781.     self printSymbol: self translationSymbol asSymbol on: aStream.
  32782.     aStream nextPutAll: '} '! !
  32783.  
  32784. !TransductionGrammarProduction methodsFor: 'conversion'!
  32785. asInitialLR0Item
  32786.  
  32787.     ^self lr0ItemClass
  32788.         leftHandSide: self leftHandSide
  32789.         preDotSymbols: OrderedCollection new
  32790.         postDotSymbols: self rightHandSide copy
  32791.         translationSymbol: self translationSymbol! !
  32792.  
  32793. !TransductionGrammarProduction methodsFor: 'conversion'!
  32794. asInitialLR1ItemWithLookahead: terminal 
  32795.  
  32796.     ^self lr1ItemClass
  32797.         leftHandSide: self leftHandSide
  32798.         preDotSymbols: OrderedCollection new
  32799.         postDotSymbols: self rightHandSide copy
  32800.         lookahead: terminal
  32801.         translationSymbol: self translationSymbol! !
  32802.  
  32803. !TransductionGrammarProduction methodsFor: 'conversion'!
  32804. asNonLalrSuffixedProduction
  32805.     "Assuming I am of the form 'A.<stuff1>* -> B.<stuff2>* C.<stuff3>*', 
  32806.     answer the prefix production 'A -> B C'."
  32807.  
  32808.     | separator lhs rhs |
  32809.     separator := self symbolSuffixSeparatorChar.
  32810.     lhs := self leftHandSide copyUpTo: separator.
  32811.     rhs := self rightHandSide collect: [:sym | sym copyUpTo: separator].
  32812.     ^self species
  32813.         leftHandSide: lhs
  32814.         rightHandSide: rhs
  32815.         translationSymbol: self translationSymbol! !
  32816.  
  32817. !TransductionGrammarProduction methodsFor: 'private'!
  32818. epsilonSymbol
  32819.  
  32820.     ^#nil! !
  32821.  
  32822. !TransductionGrammarProduction methodsFor: 'private'!
  32823. leftLiftSymbol
  32824.  
  32825.     ^#liftLeftChild! !
  32826.  
  32827. !TransductionGrammarProduction methodsFor: 'private'!
  32828. rightLiftSymbol
  32829.  
  32830.     ^#liftRightChild! !
  32831.  
  32832. !TransductionGrammarProduction methodsFor: 'parse tree building'!
  32833. computeResultNodeFor: builder withArgNodes: nodes 
  32834.     "Three kinds of translation symbols are currently supported: node names, special 
  32835.     directives, and arbitrary message selectors. For a node name, a new instance of 
  32836.     the specified node is created and given nodes, if any, as its children. The special 
  32837.     directive 'nil' simply returns nil. The directive liftRightChild adds any nodes 
  32838.     preceeding the right-most node as children to the right-most node, and returns 
  32839.     the right-most node. The directive liftLeftChild works in an analogous fashion. 
  32840.     Arbitrary message selectors must take the number of arguments in nodes and 
  32841.     are invoked as a builder message, thus allowing users to define their own 
  32842.     tree-building messages."
  32843.  
  32844.     | symbol node |
  32845.     symbol := self translationSymbol asSymbol.
  32846.     symbol first isUppercase ifTrue: [^nodes isEmpty
  32847.             ifTrue: [builder makeNewNode: symbol]
  32848.             ifFalse: [builder makeNewNode: symbol withChildren: nodes]].
  32849.     symbol = self epsilonSymbol ifTrue: [^builder answerNil].
  32850.     symbol = self rightLiftSymbol
  32851.         ifTrue: 
  32852.             [nodes size < 2 ifTrue: [self error: 'Only use liftRightChild when there are at least two right-hand-side nonterminals.'].
  32853.             "special case for building lists ending with epsilon"
  32854.             (nodes size = 2 and: [nodes last isNil])
  32855.                 ifTrue: [^builder answerArgument: nodes first].
  32856.             node := nodes removeLast.
  32857.             ^builder addChildrenFirst: nodes to: node].
  32858.     symbol = self leftLiftSymbol
  32859.         ifTrue: 
  32860.             [nodes size < 2 ifTrue: [self error: 'Only use liftLeftChild when there are at least two right-hand-side nonterminals.'].
  32861.             "special case for building lists beginning with epsilon"
  32862.             (nodes size = 2 and: [nodes first isNil])
  32863.                 ifTrue: [^builder answerArgument: nodes last].
  32864.             node := nodes removeFirst.
  32865.             ^builder addChildrenLast: nodes to: node].
  32866.     symbol numArgs = nodes size ifFalse: [self error: 'Translation message selectors must have the same number of arguments as right-hand-side nonterminals.'].
  32867.     nodes isEmpty ifTrue: [^builder perform: symbol].
  32868.     "It may be more efficient to check the number of arguments and use 
  32869.     perform:with:, etc., but probably not."
  32870.     ^builder perform: symbol withArguments: nodes asArray! !
  32871.  
  32872. !TransductionGrammarProduction methodsFor: 'parse tree building'!
  32873. computeResultNodeFor: builder withTokenClassValue: value 
  32874.     "I am assumed to be a production of the form 'A -> <tc> => symbol'. 
  32875.     The symbol can be either a node name or a one-argument message selector. 
  32876.     If it is a node name then create a new instance of that node with the specified 
  32877.     attribute value. If it is a message selector then invoke the corresponding 
  32878.     operation on the builder with the specified value."
  32879.  
  32880.     | symbol |
  32881.     symbol := self translationSymbol asSymbol.
  32882.     symbol first isUppercase
  32883.         ifTrue: [^builder makeNewNode: symbol withAttribute: value]
  32884.         ifFalse: [symbol numArgs = 1
  32885.                 ifTrue: [^builder perform: symbol with: value]
  32886.                 ifFalse: [self error: 'Expected either a node name or a one argument
  32887. message selector as a translation symbol.']]! !
  32888.  
  32889. !TransductionGrammarProduction methodsFor: 'reconstructing'!
  32890. constructItsContentOn: aStream using: tokenTable 
  32891.     "Emit  lhs , #( rhs ) and translationSymbol on aStream"
  32892.  
  32893.     super constructItsContentOn: aStream using: tokenTable.
  32894.     (tokenTable indexOf: self translationSymbol)
  32895.         reconstructOn: aStream! !
  32896.  
  32897. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  32898.  
  32899. TransductionGrammarProduction class
  32900.     instanceVariableNames: ''!
  32901.  
  32902. !TransductionGrammarProduction class methodsFor: 'instance creation'!
  32903. leftHandSide: arg1 rightHandSide: arg2 translationSymbol: arg3 
  32904.  
  32905.     | newMe |
  32906.     newMe := self new.
  32907.     newMe leftHandSide: arg1.
  32908.     newMe rightHandSide: arg2.
  32909.     newMe translationSymbol: arg3.
  32910.     ^newMe! !
  32911.  
  32912. Object variableSubclass: #TokenClassification
  32913.     instanceVariableNames: 'tokenType action '
  32914.     classVariableNames: ''
  32915.     poolDictionaries: ''
  32916.     category: 'T-gen-Scanning/Parsing'!
  32917. TokenClassification comment:
  32918. '=================================================
  32919.     Copyright (c) 1992 by Justin O. Graver.
  32920.     All rights reserved (with exceptions).
  32921.     For complete information evaluate "Object tgenCopyright."
  32922. =================================================
  32923.  
  32924. I represent a class of tokens. 
  32925.  
  32926. Instance Variables:
  32927.     tokenType    <String> - name of this token class.
  32928.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  32929.  
  32930. TokenClassification comment:
  32931. '=================================================
  32932.     Copyright (c) 1992 by Justin O. Graver.
  32933.     All rights reserved (with exceptions).
  32934.     For complete information evaluate "Object tgenCopyright."
  32935. =================================================
  32936.  
  32937. I represent a class of tokens. 
  32938.  
  32939. Instance Variables:
  32940.     tokenType    <String> - name of this token class.
  32941.     action        <Symbol + UndefinedObject> - a message selector that will be sent to the scanner (via #perform:) when a token with this type is recognized.'!
  32942.  
  32943. !TokenClassification methodsFor: 'state accessing'!
  32944. action
  32945.  
  32946.     ^action! !
  32947.  
  32948. !TokenClassification methodsFor: 'state accessing'!
  32949. action: argument 
  32950.  
  32951.     action := argument! !
  32952.  
  32953. !TokenClassification methodsFor: 'state accessing'!
  32954. tokenType
  32955.  
  32956.     ^tokenType! !
  32957.  
  32958. !TokenClassification methodsFor: 'state accessing'!
  32959. tokenType: argument 
  32960.  
  32961.     tokenType := argument! !
  32962.  
  32963. !TokenClassification methodsFor: 'testing'!
  32964. isTokenClassification
  32965.  
  32966.     ^true! !
  32967.  
  32968. !TokenClassification methodsFor: 'printing'!
  32969. printOn: aStream
  32970.  
  32971.     aStream nextPutAll: self tokenType.
  32972.     aStream nextPutAll: ' : {'.
  32973.     aStream nextPutAll: (self action isNil ifTrue: ['nil'] ifFalse: [self action]).
  32974.     aStream nextPutAll: '} ;'! !
  32975.  
  32976. !TokenClassification methodsFor: 'reconstructing'!
  32977. reconstructOn: aStream 
  32978.     "Emit #( tokenType  action ) on aStream"
  32979.  
  32980.     aStream poundSign; leftParenthesis.
  32981.     self tokenType reconstructOn: aStream.
  32982.     aStream space.
  32983.     self action reconstructOn: aStream.
  32984.     aStream rightParenthesis! !
  32985.  
  32986. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  32987.  
  32988. TokenClassification class
  32989.     instanceVariableNames: ''!
  32990.  
  32991. !TokenClassification class methodsFor: 'instance creation'!
  32992. tokenType: arg1 action: arg2 
  32993.  
  32994.     | newMe |
  32995.     newMe := self new.
  32996.     newMe tokenType: arg1.
  32997.     newMe action: arg2.
  32998.     ^newMe! !
  32999.  
  33000. Array variableSubclass: #Stack
  33001.     instanceVariableNames: 'topPtr '
  33002.     classVariableNames: ''
  33003.     poolDictionaries: ''
  33004.     category: 'T-gen-Scanning/Parsing'!
  33005. Stack comment:
  33006. '=================================================
  33007.     Copyright (c) 1992 by Justin O. Graver.
  33008.     All rights reserved (with exceptions).
  33009.     For complete information evaluate "Object tgenCopyright."
  33010. =================================================
  33011.  
  33012. This class provides a more traditional push/pop interface for Arrays.'!
  33013.  
  33014. Stack comment:
  33015. '=================================================
  33016.     Copyright (c) 1992 by Justin O. Graver.
  33017.     All rights reserved (with exceptions).
  33018.     For complete information evaluate "Object tgenCopyright."
  33019. =================================================
  33020.  
  33021. This class provides a more traditional push/pop interface for Arrays.'!
  33022.  
  33023. !Stack methodsFor: 'private'!
  33024. copyEmpty: aSize
  33025.     "Answer a copy of the receiver that contains no elements.
  33026.  
  33027.     This method should be redefined in subclasses that add
  33028.     instance variables, so that the state of those variables
  33029.     is preserved"
  33030.  
  33031.     ^(super copyEmpty: aSize) topPtr: self topPtr.! !
  33032.  
  33033. !Stack methodsFor: 'state accessing'!
  33034. topPtr
  33035.     ^topPtr! !
  33036.  
  33037. !Stack methodsFor: 'state accessing'!
  33038. topPtr: arg
  33039.     topPtr := arg! !
  33040.  
  33041. !Stack methodsFor: 'testing'!
  33042. isEmpty
  33043.     ^topPtr = 0! !
  33044.  
  33045. !Stack methodsFor: 'testing'!
  33046. isFull
  33047.     ^ topPtr = self basicSize! !
  33048.  
  33049. !Stack methodsFor: 'accessing'!
  33050. pop
  33051.     "Answer the object on top of the stack."
  33052.  
  33053.     | n |
  33054.     n := self at: topPtr.
  33055.     topPtr := topPtr - 1.
  33056.     ^n! !
  33057.  
  33058. !Stack methodsFor: 'accessing'!
  33059. pop: numElem 
  33060.     "Pop and discard top numElems and answer receiver"
  33061.  
  33062.     topPtr := topPtr - numElem! !
  33063.  
  33064. !Stack methodsFor: 'accessing'!
  33065. push: anObject 
  33066.     "Push anObject onto the top of the stack."
  33067.  
  33068.     self isFull ifTrue: [self grow].
  33069.     topPtr := topPtr + 1.
  33070.     ^self at: topPtr put: anObject! !
  33071.  
  33072. !Stack methodsFor: 'accessing'!
  33073. size
  33074.     "Answer the number of objects on the stack."
  33075.  
  33076.     ^topPtr! !
  33077.  
  33078. !Stack methodsFor: 'accessing'!
  33079. top
  33080.     "Answer (without removing) the object on top of the stack."
  33081.  
  33082.     ^self at: topPtr! !
  33083.  
  33084. !Stack methodsFor: 'initialization'!
  33085. init
  33086.  
  33087.     self topPtr: 0! !
  33088.  
  33089. !Stack methodsFor: 'enumerating'!
  33090. do: aBlock
  33091.     "Evaluate aBlock for each object on the stack, from top to bottom."
  33092.  
  33093.     ^super reverseDo: aBlock! !
  33094.  
  33095. !Stack methodsFor: 'enumerating'!
  33096. reverseDo: aBlock
  33097.     "Evaluate aBlock for each object on the stack, from bottom to top."
  33098.  
  33099.     ^super do: aBlock! !
  33100.  
  33101. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  33102.  
  33103. Stack class
  33104.     instanceVariableNames: ''!
  33105.  
  33106. !Stack class methodsFor: 'instance creation'!
  33107. new
  33108.  
  33109.     ^self new: 100! !
  33110.  
  33111. !Stack class methodsFor: 'instance creation'!
  33112. new: arg
  33113.  
  33114.     ^( super new: arg ) init! !
  33115.  
  33116. BidirectionalEdgeLabeledDigraphNode variableSubclass: #LRParserState
  33117.     instanceVariableNames: 'reduceMap '
  33118.     classVariableNames: ''
  33119.     poolDictionaries: ''
  33120.     category: 'T-gen-Scanning/Parsing'!
  33121. LRParserState comment:
  33122. '=================================================
  33123.     Copyright (c) 1992 by Justin O. Graver.
  33124.     All rights reserved (with exceptions).
  33125.     For complete information evaluate "Object tgenCopyright."
  33126. =================================================
  33127.  
  33128. I represent a node in an LR parser characteristic finite state machine.
  33129.  
  33130. Instance Variables:
  33131.  
  33132.     edgeLabelMap        <Dictionary from: symbols to: successors> - overridden from EdgeLabeledDigraphNode for efficiency since only deterministic FSAs are constructed.
  33133.     reduceMap        <SetDictionary from: symbols to: productions>'!
  33134.  
  33135. LRParserState comment:
  33136. '=================================================
  33137.     Copyright (c) 1992 by Justin O. Graver.
  33138.     All rights reserved (with exceptions).
  33139.     For complete information evaluate "Object tgenCopyright."
  33140. =================================================
  33141.  
  33142. I represent a node in an LR parser characteristic finite state machine.
  33143.  
  33144. Instance Variables:
  33145.  
  33146.     edgeLabelMap        <Dictionary from: symbols to: successors> - overridden from EdgeLabeledDigraphNode for efficiency since only deterministic FSAs are constructed.
  33147.     reduceMap        <SetDictionary from: symbols to: productions>'!
  33148.  
  33149. !LRParserState methodsFor: 'initialization'!
  33150. init
  33151.  
  33152.     super init.
  33153.     self edgeLabelMap: Dictionary new.        "overrides use of SetDictionary in superclass"
  33154.     self reduceMap: SetDictionary new! !
  33155.  
  33156. !LRParserState methodsFor: 'state accessing'!
  33157. reduceMap
  33158.  
  33159.     ^reduceMap! !
  33160.  
  33161. !LRParserState methodsFor: 'state accessing'!
  33162. reduceMap: argument 
  33163.  
  33164.     reduceMap := argument! !
  33165.  
  33166. !LRParserState methodsFor: 'exception handling'!
  33167. standardErrorString
  33168.  
  33169.     ^'unexpected token encountered:  '! !
  33170.  
  33171. !LRParserState methodsFor: 'printing'!
  33172. printOn: aStream 
  33173.  
  33174.     super printOn: aStream.
  33175.     aStream cr.
  33176.     self reduceMap printOn: aStream! !
  33177.  
  33178. !LRParserState methodsFor: 'lalr analysis'!
  33179. appendHashTo: sym 
  33180.     "Answer a new nonterminal or terminal with my hash value appended."
  33181.  
  33182.     | newSym |
  33183.     newSym := sym , self symbolSuffixSeparatorString , self hash printString.
  33184.     ^sym isNonterminal
  33185.         ifTrue: [newSym asNonterminal]
  33186.         ifFalse: [newSym]! !
  33187.  
  33188. !LRParserState methodsFor: 'lalr analysis'!
  33189. buildLalrGrammarWith: stateDict originalGrammar: aGrammar 
  33190.     "Answer my corresponding LALR(1) grammar. The new productions will not be in any 
  33191.     particular order so we must be sure to locate and explicitly specify the new start symbol."
  33192.  
  33193.     | productions startSymbol pattern startSyms |
  33194.     productions := OrderedCollection new.
  33195.     self
  33196.         collectLalrProductionsIn: productions
  33197.         andProdMapsIn: stateDict
  33198.         traversedStates: Set new.
  33199.     pattern := aGrammar startSymbol , self symbolSuffixSeparatorString , '*'.
  33200.     startSyms := Set new.
  33201.     productions do: [:prod | (pattern match: prod leftHandSide) ifTrue: [startSyms add: prod leftHandSide]].
  33202.     startSyms size = 1
  33203.         ifTrue: [startSymbol := startSyms first]
  33204.         ifFalse: [self error: 'multiple start symbols in LALR grammar'].
  33205.     ^self buildGrammarWithProductions: productions startSymbol: startSymbol! !
  33206.  
  33207. !LRParserState methodsFor: 'lalr analysis'!
  33208. collectLalrProductionsIn: aCollection andProdMapsIn: stateDict traversedStates: aSet 
  33209.  
  33210.     | newProds |
  33211.     (aSet includes: self)
  33212.         ifFalse: 
  33213.             [aSet add: self.
  33214.             self isReduceState ifTrue: [self
  33215.                     reductionsDo: 
  33216.                         [:prod | 
  33217.                         newProds := self makeLalrProductionFor: prod.
  33218.                         (stateDict includesKey: self)
  33219.                             ifTrue: 
  33220.                                 ["only need to retain data for conflict states"
  33221.                                 newProds do: [:np | (stateDict at: self)
  33222.                                         at: prod add: np leftHandSide]].
  33223.                         aCollection addAll: newProds]].
  33224.             self successorsExceptSelfDo: [:state | state
  33225.                     collectLalrProductionsIn: aCollection
  33226.                     andProdMapsIn: stateDict
  33227.                     traversedStates: aSet]]! !
  33228.  
  33229. !LRParserState methodsFor: 'lalr analysis'!
  33230. lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar 
  33231.  
  33232.     | conflictStateMap newGrammar prodMap prod follows conflictStates |
  33233.     conflictStates := Set new.
  33234.     conflictStateMap := Dictionary new: stateSet size.
  33235.     stateSet do: [:state | conflictStateMap at: state put: SetDictionary new].
  33236.     newGrammar := self buildLalrGrammarWith: conflictStateMap originalGrammar: aGrammar.
  33237.     "rebuild reduce maps for inconsistent states"
  33238.     stateSet do: 
  33239.         [:state | 
  33240.         state reduceMap: SetDictionary new.
  33241.         prodMap := conflictStateMap at: state.
  33242.         prodMap
  33243.             associationsDo: 
  33244.                 [:assoc | 
  33245.                 prod := assoc key.
  33246.                 follows := Set new.
  33247.                 assoc value do: [:nonterm | (newGrammar followSetOf: nonterm)
  33248.                         do: [:term | follows add: (term copyUpToLast: self symbolSuffixSeparatorChar)]].
  33249.                 follows do: [:term | state reduceBy: prod on: term]].
  33250.         state hasReduceReduceConflict | state hasShiftReduceConflict ifTrue: [conflictStates add: state]].
  33251.     ^conflictStates isEmpty! !
  33252.  
  33253. !LRParserState methodsFor: 'lalr analysis'!
  33254. makeLalrProductionFor: prod 
  33255.  
  33256.     | stateSet rhs newProds lhs currState |
  33257.     stateSet := Set with: self.
  33258.     prod rightHandSide reverseDo: [:sym | stateSet := stateSet inject: Set new into: [:set :state | set union: (state predecessorLabelMap at: sym)]].
  33259.     newProds := Set new.
  33260.     stateSet do: 
  33261.         [:state | 
  33262.         lhs := state appendHashTo: prod leftHandSide.
  33263.         currState := state.
  33264.         rhs := OrderedCollection new.
  33265.         prod rightHandSide do: 
  33266.             [:sym | 
  33267.             rhs add: (currState appendHashTo: sym).
  33268.             currState := currState transitionFor: sym].
  33269.         newProds add: (self makeProductionWithLeftHandSide: lhs rightHandSide: rhs)].
  33270.     ^newProds! !
  33271.  
  33272. !LRParserState methodsFor: 'building'!
  33273. goto: aState on: transitionSymbol 
  33274.  
  33275.     self addSuccessor: aState withEdgeLabeled: transitionSymbol.
  33276.     aState addPredecessor: self withEdgeLabeled: transitionSymbol! !
  33277.  
  33278. !LRParserState methodsFor: 'state transitions'!
  33279. actionFor: aTerminal 
  33280.  
  33281.     | action |
  33282.     (action := self reductionFor: aTerminal) isNil ifTrue: [(action := self transitionFor: aTerminal) isNil ifTrue: [action := self acceptSymbol]].
  33283.     ^action! !
  33284.  
  33285. !LRParserState methodsFor: 'modifying'!
  33286. addSuccessor: node withEdgeLabeled: label 
  33287.     "overridden for Dictionary edgeLabelMap"
  33288.  
  33289.     (self edgeLabelMap includesKey: label)
  33290.         ifTrue: [self error: 'check it out'].
  33291.     self edgeLabelMap at: label put: node! !
  33292.  
  33293. !LRParserState methodsFor: 'accessing'!
  33294. successors
  33295.     "overriden for Dictionary edgeLabelMap"
  33296.  
  33297.     ^self edgeLabelMap values! !
  33298.  
  33299. !LRParserState methodsFor: 'private'!
  33300. acceptSymbol
  33301.  
  33302.     ^self class acceptSymbol! !
  33303.  
  33304. !LRParserState methodsFor: 'private'!
  33305. buildGrammarWithProductions: prods startSymbol: aSymbol 
  33306.  
  33307.     ^self grammarClass buildGrammarWithProductions: prods startSymbol: aSymbol! !
  33308.  
  33309. !LRParserState methodsFor: 'private'!
  33310. grammarClass
  33311.  
  33312.     ^Grammar! !
  33313.  
  33314. !LRParserState methodsFor: 'private'!
  33315. grammarProductionClass
  33316.  
  33317.     ^GrammarProduction! !
  33318.  
  33319. !LRParserState methodsFor: 'private'!
  33320. makeProductionWithLeftHandSide: lhs rightHandSide: rhs 
  33321.  
  33322.     ^self grammarProductionClass leftHandSide: lhs rightHandSide: rhs! !
  33323.  
  33324. !LRParserState methodsFor: 'private'!
  33325. symbolSuffixSeparatorChar
  33326.  
  33327.     ^self class symbolSuffixSeparatorChar! !
  33328.  
  33329. !LRParserState methodsFor: 'private'!
  33330. symbolSuffixSeparatorString
  33331.  
  33332.     ^String with: self symbolSuffixSeparatorChar! !
  33333.  
  33334. !LRParserState methodsFor: 'accessing reductions'!
  33335. reduceBy: aProduction on: aTerminal 
  33336.  
  33337.     self reduceMap at: aTerminal add: aProduction! !
  33338.  
  33339. !LRParserState methodsFor: 'accessing reductions'!
  33340. reductionFor: aSymbol 
  33341.  
  33342.     ^self reduceMap
  33343.         at: aSymbol
  33344.         ifAbsent: [nil]
  33345.         ifNotUnique: [self error: 'reduce/reduce conflict in parser']! !
  33346.  
  33347. !LRParserState methodsFor: 'testing'!
  33348. hasReduceReduceConflict
  33349.     "Answer true if there is a reduce/reduce conflict in this state, and false 
  33350.     otherwise."
  33351.  
  33352.     ^self reduceMap isDeterministic not! !
  33353.  
  33354. !LRParserState methodsFor: 'testing'!
  33355. hasShiftReduceConflict
  33356.     "Answer true if there is a shift/reduce conflict in this state, and false 
  33357.     otherwise."
  33358.  
  33359.     | reduceSyms shiftSyms |
  33360.     reduceSyms := self reduceMap keys.
  33361.     shiftSyms := self edgeLabelMap keys.
  33362.     ^reduceSyms size + shiftSyms size ~= (reduceSyms union: shiftSyms) size! !
  33363.  
  33364. !LRParserState methodsFor: 'testing'!
  33365. isReduceState
  33366.  
  33367.     ^self reduceMap isEmpty not! !
  33368.  
  33369. !LRParserState methodsFor: 'enumerating'!
  33370. reductionsDo: aBlock 
  33371.     "Evaluate aBlock for each of my reduce productions."
  33372.  
  33373.     self reduceMap elementsDo: aBlock! !
  33374.  
  33375. !LRParserState methodsFor: 'converting'!
  33376. spaceOptimizeMap
  33377.     "Predecessors are only needed for LALR(1) analysis."
  33378.  
  33379.     super spaceOptimizeMap.
  33380.     self predecessorLabelMap: nil! !
  33381.  
  33382. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  33383.  
  33384. LRParserState class
  33385.     instanceVariableNames: ''!
  33386.  
  33387. !LRParserState class methodsFor: 'constants'!
  33388. acceptSymbol
  33389.  
  33390.     ^#accept! !
  33391.  
  33392. !LRParserState class methodsFor: 'constants'!
  33393. symbolSuffixSeparatorChar
  33394.  
  33395.     ^$.! !
  33396.  
  33397. !LRParserState class methodsFor: 'class initialization'!
  33398. initialize
  33399.     "LRParserState initialize"
  33400.  
  33401.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  33402.  
  33403. Dictionary variableSubclass: #LLParserTable
  33404.     instanceVariableNames: ''
  33405.     classVariableNames: ''
  33406.     poolDictionaries: ''
  33407.     category: 'T-gen-Scanning/Parsing'!
  33408. LLParserTable comment:
  33409. '=================================================
  33410.     Copyright (c) 1992 by Justin O. Graver.
  33411.     All rights reserved (with exceptions).
  33412.     For complete information evaluate "Object tgenCopyright."
  33413. =================================================
  33414.  
  33415. I implement a two dimensional LL(1) parser table with rows indexed by nonterminals, columns indexed by terminals, and with production table entries.  At the top level I''m a Dictionary from nonterminals to rows; each row is a SetDictionary from terminals to productions.  In deterministic tables (tables without multiple entries) the SetDictionaries can be (and are) converted into simple Dictionaries.'!
  33416.  
  33417. LLParserTable comment:
  33418. '=================================================
  33419.     Copyright (c) 1992 by Justin O. Graver.
  33420.     All rights reserved (with exceptions).
  33421.     For complete information evaluate "Object tgenCopyright."
  33422. =================================================
  33423.  
  33424. I implement a two dimensional LL(1) parser table with rows indexed by nonterminals, columns indexed by terminals, and with production table entries.  At the top level I''m a Dictionary from nonterminals to rows; each row is a SetDictionary from terminals to productions.  In deterministic tables (tables without multiple entries) the SetDictionaries can be (and are) converted into simple Dictionaries.'!
  33425.  
  33426. !LLParserTable methodsFor: 'testing'!
  33427. isDeterministic
  33428.  
  33429.     self detect: [:row | row isDeterministic not]
  33430.         ifNone: [^true].
  33431.     ^false! !
  33432.  
  33433. !LLParserTable methodsFor: 'private'!
  33434. newRow
  33435.  
  33436.     ^self rowClass new! !
  33437.  
  33438. !LLParserTable methodsFor: 'private'!
  33439. rowClass
  33440.  
  33441.     ^SetDictionary! !
  33442.  
  33443. !LLParserTable methodsFor: 'accessing'!
  33444. atNonterminal: nont andTerminal: term addProduction: prod 
  33445.  
  33446.     | row |
  33447.     row := self at: nont ifAbsent: [self at: nont put: self newRow].
  33448.     ^row at: term add: prod! !
  33449.  
  33450. !LLParserTable methodsFor: 'accessing'!
  33451. productionAtNonterminal: nont andTerminal: term 
  33452.  
  33453.     | row |
  33454.     row := self at: nont ifAbsent: [self raiseNoTransitionExceptionErrorString: 'illegal nonterminal symbol encountered:  ' , nont].
  33455.     ^row at: term ifAbsent: [self raiseNoTransitionExceptionErrorString: 'expecting one of ' , row keys printString , ' but encountered:  ''' , term , '''']! !
  33456.  
  33457. !LLParserTable methodsFor: 'converting'!
  33458. spaceOptimize
  33459.     "Assumes self isDeterministic."
  33460.  
  33461.     self associationsDo: [:assoc | self at: assoc key put: assoc value asDictionary]! !
  33462.  
  33463. !LLParserTable methodsFor: 'exception handling'!
  33464. raiseNoTransitionExceptionErrorString: aString 
  33465.  
  33466.     self class noTransitionSignal raiseErrorString: aString! !
  33467.  
  33468. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  33469.  
  33470. LLParserTable class
  33471.     instanceVariableNames: 'noTransitionSignal '!
  33472.  
  33473. !LLParserTable class methodsFor: 'state accessing'!
  33474. noTransitionSignal
  33475.  
  33476.     ^noTransitionSignal! !
  33477.  
  33478. !LLParserTable class methodsFor: 'state accessing'!
  33479. noTransitionSignal: argument 
  33480.  
  33481.     noTransitionSignal := argument! !
  33482.  
  33483. !LLParserTable class methodsFor: 'class initialization'!
  33484. initialize
  33485.     "LLParserTable initialize"
  33486.  
  33487.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  33488.  
  33489. EdgeLabeledDigraphNode subclass: #FSAState
  33490.     instanceVariableNames: 'stateID '
  33491.     classVariableNames: ''
  33492.     poolDictionaries: ''
  33493.     category: 'T-gen-Scanning/Parsing'!
  33494. FSAState comment:
  33495. '=================================================
  33496.     Copyright (c) 1992 by Justin O. Graver.
  33497.     All rights reserved (with exceptions).
  33498.     For complete information evaluate "Object tgenCopyright."
  33499. =================================================
  33500.  
  33501. I am a general state in a finite state automata.'!
  33502.  
  33503. FSAState comment:
  33504. '=================================================
  33505.     Copyright (c) 1992 by Justin O. Graver.
  33506.     All rights reserved (with exceptions).
  33507.     For complete information evaluate "Object tgenCopyright."
  33508. =================================================
  33509.  
  33510. I am a general state in a finite state automata.'!
  33511.  
  33512. !FSAState methodsFor: 'state accessing'!
  33513. stateID
  33514.  
  33515.     ^stateID! !
  33516.  
  33517. !FSAState methodsFor: 'state accessing'!
  33518. stateID: id 
  33519.  
  33520.     stateID := id! !
  33521.  
  33522. !FSAState methodsFor: 'testing'!
  33523. hasStateID
  33524.  
  33525.     ^self stateID notNil! !
  33526.  
  33527. !FSAState methodsFor: 'building'!
  33528. goto: aState on: transitionSymbol 
  33529.  
  33530.     self addSuccessor: aState withEdgeLabeled: transitionSymbol! !
  33531.  
  33532. !FSAState methodsFor: 'private'!
  33533. collectStatesIn: stateSet 
  33534.     "Add myself and all states reachable from me to stateSet. 
  33535.     If I'm the start state of an fsa then all my states are added."
  33536.  
  33537.     (stateSet includes: self)
  33538.         ifFalse: 
  33539.             [stateSet add: self.
  33540.             self successorsExceptSelfDo: [:succ | succ collectStatesIn: stateSet]]! !
  33541.  
  33542. !FSAState methodsFor: 'private'!
  33543. dfsaFinalStateClass
  33544.  
  33545.     ^FSAFinalState! !
  33546.  
  33547. !FSAState methodsFor: 'private'!
  33548. dfsaStateClass
  33549.  
  33550.     ^FSAState! !
  33551.  
  33552. !FSAState methodsFor: 'private'!
  33553. endOfInputToken
  33554.     "Answer a token representing the end of the input."
  33555.  
  33556.     ^Character endOfInput! !
  33557.  
  33558. !FSAState methodsFor: 'private'!
  33559. epsilon
  33560.     "Answer an object used to represent the empty string (epsilon)."
  33561.  
  33562.     ^EpsilonNode epsilon! !
  33563.  
  33564. !FSAState methodsFor: 'private'!
  33565. newDFSAStateFor: multiState 
  33566.     "Answer a new dfsa state that will represent the argument, a collection of states. 
  33567.     Make sure to transfer any final state information to the new state."
  33568.  
  33569.     | newFinalState finalStates |
  33570.     (finalStates := multiState select: [:state | state isFSAFinalState]) isEmpty
  33571.         ifTrue: [^self dfsaStateClass new]
  33572.         ifFalse: 
  33573.             [newFinalState := self dfsaFinalStateClass new.
  33574.             finalStates do: 
  33575.                 [:fs | 
  33576.                 fs literalTokens do: [:lit | newFinalState addLiteralToken: lit].
  33577.                 fs tokenClasses do: [:tc | newFinalState addTokenClass: tc]].
  33578.             ^newFinalState]! !
  33579.  
  33580. !FSAState methodsFor: 'private'!
  33581. nilOutStateIDs
  33582.     "Set my stateID to nil, likewise with all my successors."
  33583.  
  33584.     self stateID notNil
  33585.         ifTrue:
  33586.             [self stateID: nil.
  33587.             self successorsDo: [:succ | succ nilOutStateIDs]]! !
  33588.  
  33589. !FSAState methodsFor: 'private'!
  33590. partitionTransitionMapClass
  33591.  
  33592.     ^PartitionTransitionMap! !
  33593.  
  33594. !FSAState methodsFor: 'private'!
  33595. stateSetClass
  33596.  
  33597.     ^ItemSet! !
  33598.  
  33599. !FSAState methodsFor: 'removing nondeterminism'!
  33600. asDeterministicFSA
  33601.     "Answer a new deterministic version of myself. 
  33602.     
  33603.     Based on Algorithm 3.1 from 'Principles of Compiler Design', 
  33604.     by Aho and Ullman, 1977."
  33605.  
  33606.     | multiStateMap unprocessedStates newStartState currState ch transitStates multiState epsilonClosures newMultiState newState |
  33607.     epsilonClosures := self computeEpsilonClosures.
  33608.     multiStateMap := Dictionary new.
  33609.     unprocessedStates := Set new.
  33610.     newStartState := self newDFSAStateFor: (epsilonClosures at: self).
  33611.     multiStateMap at: (epsilonClosures at: self)
  33612.         put: newStartState.
  33613.     unprocessedStates add: newStartState.
  33614.     [unprocessedStates isEmpty]
  33615.         whileFalse: 
  33616.             [currState := unprocessedStates removeFirst.
  33617.             multiState := multiStateMap keyAtValue: currState.
  33618.             (self computeTransitionMapFor: multiState)
  33619.                 associationsDo: 
  33620.                     [:assoc | 
  33621.                     ch := assoc key.
  33622.                     transitStates := assoc value.
  33623.                     newMultiState := self stateSetClass new.
  33624.                     transitStates do: [:ts | newMultiState addAll: (epsilonClosures at: ts)].
  33625.                     (multiStateMap includesKey: newMultiState)
  33626.                         ifTrue: 
  33627.                             ["previously encountered state"
  33628.                             newState := multiStateMap at: newMultiState]
  33629.                         ifFalse: 
  33630.                             ["make a new state"
  33631.                             newState := self newDFSAStateFor: newMultiState.
  33632.                             multiStateMap at: newMultiState put: newState.
  33633.                             unprocessedStates add: newState].
  33634.                     currState goto: newState on: ch]].
  33635.     ^newStartState spaceOptimize! !
  33636.  
  33637. !FSAState methodsFor: 'removing nondeterminism'!
  33638. computeEpsilonClosureOf: stateSet 
  33639.     "Answer the set of states that can be reached from those in stateSet by epsilon 
  33640.     transitions alone."
  33641.  
  33642.     (stateSet includes: self)
  33643.         ifFalse: 
  33644.             [stateSet add: self.
  33645.             (self edgeLabelMap at: self epsilon ifAbsent: [^self])
  33646.                 do: [:state | state computeEpsilonClosureOf: stateSet]]! !
  33647.  
  33648. !FSAState methodsFor: 'removing nondeterminism'!
  33649. computeEpsilonClosures
  33650.     "Answer a Dictionary from states to their corresponding closures."
  33651.  
  33652.     | closures |
  33653.     closures := Dictionary new.
  33654.     self states do: [:state | closures at: state put: state epsilonClosure].
  33655.     ^closures! !
  33656.  
  33657. !FSAState methodsFor: 'removing nondeterminism'!
  33658. computeTransitionMapFor: multiState 
  33659.     "Answer a transition map (minus any epsilon transitons) for multiState, 
  33660.     a collection of states."
  33661.  
  33662.     | newMap |
  33663.     newMap := SetDictionary new.
  33664.     multiState do: [:state | state copyTransitionsTo: newMap].
  33665.     newMap removeKey: self epsilon ifAbsent: [].
  33666.     ^newMap! !
  33667.  
  33668. !FSAState methodsFor: 'removing nondeterminism'!
  33669. epsilonClosure
  33670.     "Answer the set of states that can be reached from me by epsilon transitions 
  33671.     alone."
  33672.  
  33673.     | states |
  33674.     states := self stateSetClass new.
  33675.     self computeEpsilonClosureOf: states.
  33676.     ^states! !
  33677.  
  33678. !FSAState methodsFor: 'minimizing'!
  33679. asMinimalDFSA
  33680.     "Answer a new minimal deterministic version of myself. 
  33681.     NOTE: the recipient of the DFSA should send the spaceOptimize 
  33682.     message to the DFSA.
  33683.     
  33684.     Based on Algorithm 3.3 from 'Principles of Compiler Design', 
  33685.     by Aho and Ullman, 1977."
  33686.  
  33687.     | dfsa states statePartitionMap oldPartition newPartition |
  33688.     dfsa := self asDeterministicFSA.
  33689.     states := dfsa states.
  33690.     newPartition := self computeInitialPartitionFor: states.
  33691.     oldPartition := Set new.
  33692.     [newPartition size = oldPartition size]
  33693.         whileFalse: 
  33694.             [oldPartition := newPartition.
  33695.             statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
  33696.             self computePartitionTransitionsFor: states using: statePartitionMap.
  33697.             newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
  33698.     ^self
  33699.         computeNewDFSAFor: oldPartition
  33700.         using: statePartitionMap
  33701.         startState: dfsa! !
  33702.  
  33703. !FSAState methodsFor: 'minimizing'!
  33704. asNearMinimalDFSAWithUniqueTokenClasses
  33705.     "Answer a new almost minimal deterministic version of myself. The result is not always 
  33706.     minimal due to the extra constraint that final state partitions containing final states for two 
  33707.     different token classes must be split. This allows the DFSA to properly handle overlapping 
  33708.     token classes.  NOTE: the recipient of the DFSA should send the spaceOptimize 
  33709.     message to the DFSA.
  33710.     
  33711.     Based on Algorithm 3.3 from 'Principles of Compiler Design', 
  33712.     by Aho and Ullman, 1977."
  33713.  
  33714.     | dfsa states statePartitionMap oldPartition newPartition |
  33715.     dfsa := self asDeterministicFSA.
  33716.     states := dfsa states.
  33717.     newPartition := self computeNearMinimalInitialPartitionFor: states.
  33718.     oldPartition := Set new.
  33719.     [newPartition size = oldPartition size]
  33720.         whileFalse: 
  33721.             [oldPartition := newPartition.
  33722.             statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
  33723.             self computePartitionTransitionsFor: states using: statePartitionMap.
  33724.             newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
  33725.     ^self
  33726.         computeNewDFSAFor: oldPartition
  33727.         using: statePartitionMap
  33728.         startState: dfsa! !
  33729.  
  33730. !FSAState methodsFor: 'minimizing'!
  33731. computeNearMinimalInitialPartitionFor: states 
  33732.     "Partition states into nonfinal, literal final, and common token class final state partitions."
  33733.  
  33734.     | finalStates nonFinalStates partition tokenClasses literalTokens tc |
  33735.     finalStates := states select: [:state | state isFSAFinalState].
  33736.     nonFinalStates := states reject: [:state | state isFSAFinalState].
  33737.     partition := nonFinalStates isEmpty
  33738.                 ifTrue: [Set new]
  33739.                 ifFalse: [Set with: nonFinalStates].
  33740.     tokenClasses := SetDictionary new.
  33741.     literalTokens := Set new.
  33742.     finalStates do: 
  33743.         [:finalState | 
  33744.         (tc := finalState tokenClasses) size > 1 ifTrue: [self error: 'multiple token class states are not currently supported'].
  33745.         tc size = 0
  33746.             ifTrue: [literalTokens add: finalState]
  33747.             ifFalse: [tokenClasses at: tc first tokenType add: finalState]].
  33748.     literalTokens isEmpty ifFalse: [partition add: literalTokens].
  33749.     tokenClasses isEmpty ifFalse: [partition addAll: tokenClasses].
  33750.     ^partition! !
  33751.  
  33752. !FSAState methodsFor: 'minimizing'!
  33753. computeInitialPartitionFor: states 
  33754.     "Partition states into final and nonfinal states."
  33755.  
  33756.     | finalStates nonFinalStates |
  33757.     finalStates := states select: [:state | state isFSAFinalState].
  33758.     nonFinalStates := states reject: [:state | state isFSAFinalState].
  33759.     ^nonFinalStates isEmpty
  33760.         ifTrue: [Set with: finalStates]
  33761.         ifFalse: [Set with: nonFinalStates with: finalStates]! !
  33762.  
  33763. !FSAState methodsFor: 'minimizing'!
  33764. computeNewDFSAFor: partition using: statePartitionMap startState: startState 
  33765.     "Answer a new dfsa whose states represent partitions and whose transitions are 
  33766.     computed from the statePartitionMap. The state for the partition containing 
  33767.     startState is the new start state.  NOTE: the recipient of the DFSA should send
  33768.     the spaceOptimize message to the DFSA."
  33769.  
  33770.     | newStateMap partitionRepresentativeState newState ch st newStartState |
  33771.     newStateMap := IdentityDictionary new.
  33772.     partition do: [:part | newStateMap at: part put: (self newDFSAStateFor: part)].
  33773.     partition do: 
  33774.         [:part | 
  33775.         partitionRepresentativeState := part first.
  33776.         newState := newStateMap at: part.
  33777.         (statePartitionMap at: partitionRepresentativeState) transitionMap
  33778.             associationsDo: 
  33779.                 [:assoc | 
  33780.                 ch := assoc key.
  33781.                 st := newStateMap at: assoc value.
  33782.                 newState goto: st on: ch]].
  33783.     newStartState := newStateMap at: (statePartitionMap at: startState) partition.
  33784.     ^newStartState! !
  33785.  
  33786. !FSAState methodsFor: 'minimizing'!
  33787. computeNewPartitionFor: oldPartition using: statePartitionMap 
  33788.     "Answer a new state partition that is a refinement of oldPartition based on 
  33789.     partition transitions. An old partition is split into partitions of states with 
  33790.     equivalent partition transition maps."
  33791.  
  33792.     | newPartition partCopy initialState newPart |
  33793.     newPartition := Set new.
  33794.     oldPartition do: 
  33795.         [:part | 
  33796.         partCopy := part copy.
  33797.         [partCopy isEmpty]
  33798.             whileFalse: 
  33799.                 [initialState := partCopy removeFirst.
  33800.                 newPart := self stateSetClass with: initialState.
  33801.                 partCopy copy do: [:state | ((statePartitionMap at: initialState)
  33802.                         hasSameTransitionMapAs: (statePartitionMap at: state))
  33803.                         ifTrue: 
  33804.                             [partCopy remove: state.
  33805.                             newPart add: state]].
  33806.                 newPartition add: newPart]].
  33807.     ^newPartition! !
  33808.  
  33809. !FSAState methodsFor: 'minimizing'!
  33810. computePartitionTransitionsFor: states using: statePartitionMap 
  33811.     "For each state in states compute its partition-based transition map, 
  33812.     i.e. a transition map from characters to partitions."
  33813.  
  33814.     | char targetPartition |
  33815.     states do: [:state | state edgeLabelMap
  33816.             associationsDo: 
  33817.                 [:assoc | 
  33818.                 char := assoc key.
  33819.                 targetPartition := (statePartitionMap at: (state transitionFor: char)) partition.
  33820.                 (statePartitionMap at: state)
  33821.                     goto: targetPartition on: char]]! !
  33822.  
  33823. !FSAState methodsFor: 'minimizing'!
  33824. computeStatePartitionMapFor: states using: partition 
  33825.     "Answer a Dictionary mapping each state to an object containing its 
  33826.     corresponding partition and a partition-based transition map for the state."
  33827.  
  33828.     | statePartitionMap |
  33829.     statePartitionMap := Dictionary new.
  33830.     states do: [:state | statePartitionMap at: state put: (self partitionTransitionMapClass forPartition: (partition detect: [:par | par includes: state]))].
  33831.     ^statePartitionMap! !
  33832.  
  33833. !FSAState methodsFor: 'exception handling'!
  33834. endOfInputErrorString
  33835.  
  33836.     ^'end of input encountered'! !
  33837.  
  33838. !FSAState methodsFor: 'exception handling'!
  33839. raiseNoTransitionExceptionErrorString: aString 
  33840.  
  33841.     self class noTransitionSignal raiseErrorString: aString! !
  33842.  
  33843. !FSAState methodsFor: 'exception handling'!
  33844. standardErrorString
  33845.  
  33846.     ^'illegal character encountered:  '! !
  33847.  
  33848. !FSAState methodsFor: 'state transitions'!
  33849. copyTransitionsTo: transitionMap 
  33850.  
  33851.     self edgeLabelMap associationsDo: [:assoc | transitionMap at: assoc key addAll: assoc value]! !
  33852.  
  33853. !FSAState methodsFor: 'state transitions'!
  33854. transitionFor: aSymbol 
  33855.  
  33856.     ^self transitionFor: aSymbol ifNone: [self raiseNoTransitionExceptionErrorString: (aSymbol = self endOfInputToken
  33857.                 ifTrue: [self endOfInputErrorString]
  33858.                 ifFalse: [self standardErrorString , '''' , aSymbol printString , ''''])]! !
  33859.  
  33860. !FSAState methodsFor: 'state transitions'!
  33861. transitionFor: aSymbol ifNone: aBlock 
  33862.  
  33863.     ^self edgeLabelMap at: aSymbol ifAbsent: [^aBlock value]! !
  33864.  
  33865. !FSAState methodsFor: 'converting'!
  33866. spaceOptimize
  33867.  
  33868.     self states do: [:state | state spaceOptimizeMap]! !
  33869.  
  33870. !FSAState methodsFor: 'accessing'!
  33871. states
  33872.     "Answer the Set states reachable from here. 
  33873.     If I am the start state this is all my states."
  33874.  
  33875.     | states |
  33876.     states := self stateSetClass new.
  33877.     self collectStatesIn: states.
  33878.     ^states! !
  33879.  
  33880. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  33881.  
  33882. FSAState class
  33883.     instanceVariableNames: 'noTransitionSignal '!
  33884.  
  33885. !FSAState class methodsFor: 'instance creation'!
  33886. new
  33887.  
  33888.     ^super new init! !
  33889.  
  33890. !FSAState class methodsFor: 'class initialization'!
  33891. initialize
  33892.     "FSAState initialize"
  33893.  
  33894.     self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !
  33895.  
  33896. !FSAState class methodsFor: 'state accessing'!
  33897. noTransitionSignal
  33898.  
  33899.     ^noTransitionSignal! !
  33900.  
  33901. !FSAState class methodsFor: 'state accessing'!
  33902. noTransitionSignal: argument 
  33903.  
  33904.     noTransitionSignal := argument! !
  33905.  
  33906. FSAState subclass: #FSAFinalState
  33907.     instanceVariableNames: 'literalTokens tokenClasses '
  33908.     classVariableNames: ''
  33909.     poolDictionaries: ''
  33910.     category: 'T-gen-Scanning/Parsing'!
  33911. FSAFinalState comment:
  33912. '=================================================
  33913.     Copyright (c) 1992 by Justin O. Graver.
  33914.     All rights reserved (with exceptions).
  33915.     For complete information evaluate "Object tgenCopyright."
  33916. =================================================
  33917.  
  33918. I am a final state of a finite state automata.  If I''m part of a minimal deterministic fsa then it is possible that I represent several final states of some original non-deterministic fsa.  My instance variables are used to distinguish between these various different final states.  Final states for literal tokens (keywords) are represented by name in literalTokens.  Final states for larger token classes are represented by TokenClassifications.  When a token is recognized by this final state, it is first checked against the list of literal tokens.  If not found, it is then classified as belonging to the one token class of which it is a member.  The current implementation does not support overlapping token classes, hence, there can only really be one element in the OrderedCollection.  However, in the future we hope to be able to support overlapping token classes.
  33919.  
  33920. Instance Variables:
  33921.     literalTokens        <Set of: String> - the literal tokens I recognize.
  33922.     tokenClasses     <OrderedCollection of: TokenClassification> - the token classes I recognize.'!
  33923.  
  33924. FSAFinalState comment:
  33925. '=================================================
  33926.     Copyright (c) 1992 by Justin O. Graver.
  33927.     All rights reserved (with exceptions).
  33928.     For complete information evaluate "Object tgenCopyright."
  33929. =================================================
  33930.  
  33931. I am a final state of a finite state automata.  If I''m part of a minimal deterministic fsa then it is possible that I represent several final states of some original non-deterministic fsa.  My instance variables are used to distinguish between these various different final states.  Final states for literal tokens (keywords) are represented by name in literalTokens.  Final states for larger token classes are represented by TokenClassifications.  When a token is recognized by this final state, it is first checked against the list of literal tokens.  If not found, it is then classified as belonging to the one token class of which it is a member.  The current implementation does not support overlapping token classes, hence, there can only really be one element in the OrderedCollection.  However, in the future we hope to be able to support overlapping token classes.
  33932.  
  33933. Instance Variables:
  33934.     literalTokens        <Set of: String> - the literal tokens I recognize.
  33935.     tokenClasses     <OrderedCollection of: TokenClassification> - the token classes I recognize.'!
  33936.  
  33937. !FSAFinalState methodsFor: 'initialization'!
  33938. init
  33939.  
  33940.     super init.
  33941.     self literalTokens: Set new.
  33942.     self tokenClasses: OrderedCollection new! !
  33943.  
  33944. !FSAFinalState methodsFor: 'state accessing'!
  33945. literalTokens
  33946.  
  33947.     ^literalTokens! !
  33948.  
  33949. !FSAFinalState methodsFor: 'state accessing'!
  33950. literalTokens: argument 
  33951.  
  33952.     literalTokens := argument! !
  33953.  
  33954. !FSAFinalState methodsFor: 'state accessing'!
  33955. tokenClasses
  33956.  
  33957.     ^tokenClasses! !
  33958.  
  33959. !FSAFinalState methodsFor: 'state accessing'!
  33960. tokenClasses: argument 
  33961.  
  33962.     tokenClasses := argument! !
  33963.  
  33964. !FSAFinalState methodsFor: 'state transitions'!
  33965. transitionFor: aSymbol 
  33966.     "The default for final states is to not raise an exception 
  33967.     if no transitions are possible, rather, they answer nil."
  33968.  
  33969.     ^self transitionFor: aSymbol ifNone: [nil]! !
  33970.  
  33971. !FSAFinalState methodsFor: 'testing'!
  33972. isFSAFinalState
  33973.  
  33974.     ^true! !
  33975.  
  33976. !FSAFinalState methodsFor: 'token classifying'!
  33977. addLiteralToken: literal 
  33978.  
  33979.     self literalTokens add: literal! !
  33980.  
  33981. !FSAFinalState methodsFor: 'token classifying'!
  33982. addTokenClass: tokenClass 
  33983.     "Don't add the same tokenClass twice."
  33984.  
  33985.     self tokenClasses detect: [:tc | tc tokenType = tokenClass tokenType]
  33986.         ifNone: [self tokenClasses size ~~ 0
  33987.                 ifTrue: [self error: 'Current implementation only handles non-overlapping token classes.']
  33988.                 ifFalse: [self tokenClasses add: tokenClass]]! !
  33989.  
  33990. !FSAFinalState methodsFor: 'token classifying'!
  33991. tokenTypeAndActionFor: aString 
  33992.     "The current implementation does not handle overlapping token classes. Hence, a final state 
  33993.     can only represent a literal or a single token class. Therefore, if not a literal then it must be 
  33994.     the token class."
  33995.  
  33996.     | tc |
  33997.     ((self literalTokens includes: aString)
  33998.         or: [aString size = 0])
  33999.         ifTrue: [^self typeActionHolderClass type: aString action: nil].
  34000.     tc := self tokenClasses first.
  34001.     ^self typeActionHolderClass type: tc tokenType action: tc action! !
  34002.  
  34003. !FSAFinalState methodsFor: 'private'!
  34004. typeActionHolderClass
  34005.  
  34006.     ^TokenTypeActionHolder! !
  34007.  
  34008. LRParserState initialize!
  34009.  
  34010. LLParserTable initialize!
  34011.  
  34012. FSAState initialize!
  34013.  
  34014. !NoController methodsFor: 'accessing'!
  34015. textHasChanged
  34016.  
  34017.     ^false! !
  34018.  
  34019. !Character methodsFor: 'copying'!
  34020. copyUpToLast: char 
  34021.  
  34022.     ^self! !
  34023.  
  34024. !Character methodsFor: 'converting'!
  34025. asString
  34026.     "Answer the receiver converted into a String."
  34027.  
  34028.     ^String with: self! !
  34029.  
  34030. !Character class methodsFor: 'accessing untypeable characters'!
  34031. endOfInput
  34032.     "Answer the Character representing ctrl-d ."
  34033.  
  34034.     ^self value: 4! !
  34035.  
  34036. !Character class methodsFor: 'accessing untypeable characters'!
  34037. leftParenthesis
  34038.     "Answer the Character representing a left parenthesis."
  34039.  
  34040.     ^self value: 40! !
  34041.  
  34042. !Character class methodsFor: 'accessing untypeable characters'!
  34043. period
  34044.     "Answer the Character representing a carriage period."
  34045.  
  34046.     ^self value: 46! !
  34047.  
  34048. !Character class methodsFor: 'accessing untypeable characters'!
  34049. poundSign
  34050.     "Answer the Character representing a pound sign."
  34051.  
  34052.     ^self value: 35! !
  34053.  
  34054. !Character class methodsFor: 'accessing untypeable characters'!
  34055. rightParenthesis
  34056.     "Answer the Character representing a right parenthesis."
  34057.  
  34058.     ^self value: 41! !
  34059.  
  34060. !Stream methodsFor: 'character writing'!
  34061. leftParenthesis
  34062.     "Append a left parenthesis character to the receiver."
  34063.  
  34064.     self nextPut: Character leftParenthesis! !
  34065.  
  34066. !Stream methodsFor: 'character writing'!
  34067. period
  34068.     "Append a period character to the receiver."
  34069.  
  34070.     self nextPut: Character period! !
  34071.  
  34072. !Stream methodsFor: 'character writing'!
  34073. poundSign
  34074.     "Append a # character to the receiver."
  34075.  
  34076.     self nextPut: Character poundSign! !
  34077.  
  34078. !Stream methodsFor: 'character writing'!
  34079. rightParenthesis
  34080.     "Append a right parenthesis character to the receiver."
  34081.  
  34082.     self nextPut: Character rightParenthesis! !
  34083.  
  34084. WriteStream subclass: #RetractableWriteStream
  34085.     instanceVariableNames: ''
  34086.     classVariableNames: ''
  34087.     poolDictionaries: ''
  34088.     category: 'Collections-Streams'!
  34089. RetractableWriteStream comment:
  34090. '=================================================
  34091.     Copyright (c) 1992 by Justin O. Graver.
  34092.     All rights reserved (with exceptions).
  34093.     For complete information evaluate "Object tgenCopyright."
  34094. =================================================
  34095.  
  34096. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  34097.  
  34098. RetractableWriteStream comment:
  34099. '=================================================
  34100.     Copyright (c) 1992 by Justin O. Graver.
  34101.     All rights reserved (with exceptions).
  34102.     For complete information evaluate "Object tgenCopyright."
  34103. =================================================
  34104.  
  34105. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  34106.  
  34107. !RetractableWriteStream methodsFor: 'positioning'!
  34108. backspace
  34109.     "Backup one position, if possible. It may be best to signal an error when attempting to backup 
  34110.     past the beginning of the stream, but for now just do nothing."
  34111.  
  34112.     self atBeginning ifFalse: [self skip: -1]! !
  34113.  
  34114. !RetractableWriteStream methodsFor: 'accessing'!
  34115. size
  34116.     "Answer how many elements the receiver contains."
  34117.  
  34118.     ^position! !
  34119.  
  34120. !RetractableWriteStream methodsFor: 'testing'!
  34121. atBeginning
  34122.  
  34123.     ^position = 0! !
  34124.  
  34125. ReadStream subclass: #RetractableReadStream
  34126.     instanceVariableNames: ''
  34127.     classVariableNames: ''
  34128.     poolDictionaries: ''
  34129.     category: 'Collections-Streams'!
  34130. RetractableReadStream comment:
  34131. '=================================================
  34132.     Copyright (c) 1992 by Justin O. Graver.
  34133.     All rights reserved (with exceptions).
  34134.     For complete information evaluate "Object tgenCopyright."
  34135. =================================================
  34136.  
  34137. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  34138.  
  34139. RetractableReadStream comment:
  34140. '=================================================
  34141.     Copyright (c) 1992 by Justin O. Graver.
  34142.     All rights reserved (with exceptions).
  34143.     For complete information evaluate "Object tgenCopyright."
  34144. =================================================
  34145.  
  34146. This class adds a ''backspace'' method and overrides several methods to correctly support this behavior.'!
  34147.  
  34148. !RetractableReadStream methodsFor: 'positioning'!
  34149. backspace
  34150.     "Backup one position, if possible. It may be best to signal an error when attempting to backup 
  34151.     past the beginning of the stream, but for now just do nothing."
  34152.  
  34153.     self atBeginning ifFalse: [self skip: -1]! !
  34154.  
  34155. !RetractableReadStream methodsFor: 'testing'!
  34156. atBeginning
  34157.  
  34158.     ^position = 0! !
  34159.  
  34160. !RetractableReadStream methodsFor: 'accessing'!
  34161. current
  34162.     "Answer the element at the current position or nil if at the beginning. This is useful for 
  34163.     rereading the stream after backspacing."
  34164.  
  34165.     ^self atBeginning
  34166.         ifTrue: [nil]
  34167.         ifFalse: [collection at: position]! !
  34168.  
  34169. !RetractableReadStream methodsFor: 'private'!
  34170. pastEnd
  34171.     "The receiver has attempted to read past the end, answer an EOF indicator."
  34172.     "NOTE: currently, this class is used only by T-gen so it is acceptable to use the end-of-input character
  34173.     rather than nil to denote the end of the stream. However, in a more general context, it may 
  34174.     be desirable to change this back to nil. If this is done then either the transitionFor:ifNone: 
  34175.     method in class FSAState must be changed to check for nil as a transition symbol 
  34176.     (Dictionaries do not allow nil keys), or scanners must be changed to translate a nil character 
  34177.     to the end-of-input character. These changes affect what happens when a scanner runs out of
  34178.       input in the middle of a token."
  34179.  
  34180.     ^Signal noHandlerSignal handle: [:ex | ex parameter proceedWith: (Character endOfInput)]
  34181.         do: [self class endOfStreamSignal raiseRequestFrom: self]! !
  34182.  
  34183. TextView subclass: #NonrelianceTextView
  34184.     instanceVariableNames: ''
  34185.     classVariableNames: ''
  34186.     poolDictionaries: ''
  34187.     category: 'Interface-Text'!
  34188. NonrelianceTextView comment:
  34189. '=================================================
  34190.     Copyright (c) 1992 by Justin O. Graver.
  34191.     All rights reserved (with exceptions).
  34192.     For complete information evaluate "Object tgenCopyright."
  34193. =================================================
  34194.  
  34195. This class represents text views upon which no other view depends.  Hence, another view will never be prevented from changing because of the status of a NonrelianceTextView.'!
  34196.  
  34197. NonrelianceTextView comment:
  34198. '=================================================
  34199.     Copyright (c) 1992 by Justin O. Graver.
  34200.     All rights reserved (with exceptions).
  34201.     For complete information evaluate "Object tgenCopyright."
  34202. =================================================
  34203.  
  34204. This class represents text views upon which no other view depends.  Hence, another view will never be prevented from changing because of the status of a NonrelianceTextView.'!
  34205.  
  34206. !NonrelianceTextView methodsFor: 'updating'!
  34207. updateRequest
  34208.     "Answer regarding whether the receiver may change."
  34209.  
  34210.     ^true! !
  34211.  
  34212. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34213.  
  34214. NonrelianceTextView class
  34215.     instanceVariableNames: ''!
  34216.  
  34217. !Object methodsFor: 'reconstructing'!
  34218. reconstructOn: aStream 
  34219.  
  34220.     self printOn: aStream! !
  34221.  
  34222. !Object methodsFor: 'reconstructing'!
  34223. reconstructOn: aStream using: dummy 
  34224.  
  34225.     self printOn: aStream! !
  34226.  
  34227. !Object methodsFor: 'testing'!
  34228. isAlternationNode
  34229.  
  34230.     ^false! !
  34231.  
  34232. !Object methodsFor: 'testing'!
  34233. isConcatenationNode
  34234.  
  34235.     ^false! !
  34236.  
  34237. !Object methodsFor: 'testing'!
  34238. isEpsilonNode
  34239.  
  34240.     ^false! !
  34241.  
  34242. !Object methodsFor: 'testing'!
  34243. isTerminalNode
  34244.  
  34245.     ^false! !
  34246.  
  34247. !Object methodsFor: 'testing'!
  34248. isFSAFinalState
  34249.  
  34250.     ^false! !
  34251.  
  34252. !Object methodsFor: 'testing'!
  34253. isGrammarProduction
  34254.  
  34255.     ^false! !
  34256.  
  34257. !Object methodsFor: 'testing'!
  34258. isItemSet
  34259.  
  34260.     ^false! !
  34261.  
  34262. !Object methodsFor: 'testing'!
  34263. isLR0Item
  34264.  
  34265.     ^false! !
  34266.  
  34267. !Object methodsFor: 'testing'!
  34268. isLR1Item
  34269.  
  34270.     ^false! !
  34271.  
  34272. !Object methodsFor: 'testing'!
  34273. isNonterminal
  34274.  
  34275.     ^false! !
  34276.  
  34277. !Object methodsFor: 'testing'!
  34278. isPartitionTransitionMap
  34279.  
  34280.     ^false! !
  34281.  
  34282. !Object methodsFor: 'testing'!
  34283. isTerminal
  34284.  
  34285.     ^false! !
  34286.  
  34287. !Object methodsFor: 'testing'!
  34288. isTokenClassification
  34289.  
  34290.     ^false! !
  34291.  
  34292. !Collection methodsFor: 'reconstructing'!
  34293. reconstructOn: aStream 
  34294.     "Emit #( elements ) on aStream "
  34295.  
  34296.     aStream poundSign; leftParenthesis.
  34297.     self do: 
  34298.         [:ea | 
  34299.         ea reconstructOn: aStream.
  34300.         aStream space].
  34301.     aStream rightParenthesis! !
  34302.  
  34303. !Array methodsFor: 'reconstructing'!
  34304. reconstructOn: aStream 
  34305.     "Emit #( elements) on aStream ."
  34306.  
  34307.     aStream
  34308.          poundSign;
  34309.          leftParenthesis;
  34310.          space.
  34311.     1 to: self size do: 
  34312.         [:index | 
  34313.         (self at: index)
  34314.             reconstructOn: aStream.
  34315.         aStream space].
  34316.     aStream rightParenthesis! !
  34317.  
  34318. !Array methodsFor: 'reconstructing'!
  34319. reconstructOn: aStream using: tokenTable 
  34320.  
  34321.     aStream
  34322.          poundSign;
  34323.          leftParenthesis;
  34324.          space.
  34325.     1 to: self size do: 
  34326.         [:index | 
  34327.         (self at: index)
  34328.             reconstructOn: aStream using: tokenTable.
  34329.         aStream space].
  34330.     aStream rightParenthesis! !
  34331.  
  34332. !CharacterArray methodsFor: 'copying'!
  34333. copyUpToLast: aCharacter 
  34334.     "Answer a copy of the receiver from index 1 to the last occurrence of 
  34335.     aCharacter, non-inclusive."
  34336.  
  34337.     | index |
  34338.     (index := self
  34339.                 prevIndexOf: aCharacter
  34340.                 from: self size
  34341.                 to: 1) isNil ifTrue: [^self].
  34342.     ^self copyFrom: 1 to: index - 1! !
  34343.  
  34344. !String methodsFor: 'converting'!
  34345. asNonterminal
  34346.  
  34347.     ^self asSymbol! !
  34348.  
  34349. !String methodsFor: 'testing'!
  34350. isTerminal
  34351.  
  34352.     ^true! !
  34353.  
  34354. !String methodsFor: 'testing'!
  34355. isTokenClassTerminal
  34356.  
  34357.     ^'<*>' match: self! !
  34358.  
  34359. !String methodsFor: 'reconstructing'!
  34360. reconstructOn: aStream 
  34361.  
  34362.     self printOn: aStream! !
  34363.  
  34364. !Symbol methodsFor: 'testing'!
  34365. isNonterminal
  34366.  
  34367.     ^true! !
  34368.  
  34369. !Symbol methodsFor: 'testing'!
  34370. isTerminal
  34371.  
  34372.     ^false! !
  34373.  
  34374. !Symbol methodsFor: 'testing'!
  34375. isTokenClassTerminal
  34376.  
  34377.     ^false! !
  34378.  
  34379. !SequenceableCollection methodsFor: 'enumerating'!
  34380. reverseDetect: aBlock ifNone: exceptionBlock 
  34381.     "Evaluate aBlock with each of the receiver's elements as the argument.
  34382.     Answer the last element for which aBlock evaluates to true."
  34383.  
  34384.     self reverseDo: [:each | (aBlock value: each) ifTrue: [^each]].
  34385.     ^exceptionBlock value! !
  34386.  
  34387. !Set methodsFor: 'accessing'!
  34388. first
  34389.     "Answer an arbitrary element. If the receiver is empty, provide an error 
  34390.     notification. The selector 'first' is used for compatibility with 
  34391.     SequenceableCollections."
  34392.  
  34393.     self emptyCheck.
  34394.     self do: [:each | ^each]! !
  34395.  
  34396. !Set methodsFor: 'removing'!
  34397. removeFirst
  34398.     "Answer (and remove) an arbitrary element. The selector 'removeFirst' is used for 
  34399.     compatibility with SequenceableCollections."
  34400.  
  34401.     | element |
  34402.     element := self first.
  34403.     self remove: element.
  34404.     ^element! !
  34405.  
  34406. !Set methodsFor: 'set operations'!
  34407. intersect: aSet 
  34408.     "Answer a new set which is the intersection of myself and aSet."
  34409.  
  34410.     ^self size < aSet size
  34411.         ifTrue: [self select: [:each | aSet includes: each]]
  34412.         ifFalse: [aSet select: [:each | self includes: each]]! !
  34413.  
  34414. !Set methodsFor: 'set operations'!
  34415. union: aSet 
  34416.     "Answer a new set which is the union of myself and aSet."
  34417.  
  34418.     | newSet |
  34419.     newSet := self species new.
  34420.     newSet addAll: self; addAll: aSet.
  34421.     ^newSet! !
  34422.  
  34423. !Dictionary methodsFor: 'accessing'!
  34424. elements
  34425.  
  34426.     ^self values! !
  34427.  
  34428. !Dictionary methodsFor: 'accessing'!
  34429. valuesAsSet
  34430.     "Answer a set containing the receiver's values."
  34431.  
  34432.     | aSet |
  34433.     aSet := Set new: self size.
  34434.     self do: [:each | aSet add: each].
  34435.     ^aSet! !
  34436.  
  34437. !Dictionary methodsFor: 'converting'!
  34438. asDictionary
  34439.  
  34440.     ^self! !
  34441.  
  34442. !Dictionary methodsFor: 'reconstructing'!
  34443. reconstructOn: aStream 
  34444.     "Emit #( keys ) and #( values ) on aSteam"
  34445.  
  34446.     aStream
  34447.          poundSign;
  34448.          leftParenthesis;
  34449.          space.
  34450.     self
  34451.         associationsDo: 
  34452.             [:assoc | 
  34453.             assoc key reconstructOn: aStream.
  34454.             aStream space].
  34455.     aStream
  34456.          rightParenthesis;
  34457.          space;
  34458.          poundSign;
  34459.          leftParenthesis.
  34460.     self
  34461.         associationsDo: 
  34462.             [:assoc | 
  34463.             assoc value reconstructOn: aStream.
  34464.             aStream space].
  34465.     aStream rightParenthesis; space! !
  34466.  
  34467. Dictionary variableSubclass: #SetDictionary
  34468.     instanceVariableNames: ''
  34469.     classVariableNames: ''
  34470.     poolDictionaries: ''
  34471.     category: 'Collections-Unordered'!
  34472. SetDictionary comment:
  34473. '=================================================
  34474.     Copyright (c) 1992 by Justin O. Graver.
  34475.     All rights reserved (with exceptions).
  34476.     For complete information evaluate "Object tgenCopyright."
  34477. =================================================
  34478.  
  34479. This class represents a Dictionary of Sets.'!
  34480.  
  34481. SetDictionary comment:
  34482. '=================================================
  34483.     Copyright (c) 1992 by Justin O. Graver.
  34484.     All rights reserved (with exceptions).
  34485.     For complete information evaluate "Object tgenCopyright."
  34486. =================================================
  34487.  
  34488. This class represents a Dictionary of Sets.'!
  34489.  
  34490. !SetDictionary methodsFor: 'removing'!
  34491. at: key remove: anObject 
  34492.  
  34493.     ^(self at: key)
  34494.         remove: anObject! !
  34495.  
  34496. !SetDictionary methodsFor: 'removing'!
  34497. at: key remove: anObject ifAbsent: aBlock 
  34498.  
  34499.     ^(self at: key)
  34500.         remove: anObject ifAbsent: aBlock! !
  34501.  
  34502. !SetDictionary methodsFor: 'accessing'!
  34503. at: key ifAbsent: absentBlock ifNotUnique: notUniqueBlock 
  34504.  
  34505.     | elementSet |
  34506.     elementSet := self at: key ifAbsent: [^absentBlock value].
  34507.     ^elementSet size > 1
  34508.         ifTrue: [notUniqueBlock value]
  34509.         ifFalse: [elementSet first]! !
  34510.  
  34511. !SetDictionary methodsFor: 'accessing'!
  34512. at: key ifNotUnique: aBlock 
  34513.  
  34514.     | elementSet |
  34515.     elementSet := self at: key.
  34516.     ^elementSet size > 1
  34517.         ifTrue: [aBlock value]
  34518.         ifFalse: [elementSet first]! !
  34519.  
  34520. !SetDictionary methodsFor: 'accessing'!
  34521. elements
  34522.  
  34523.     | elements |
  34524.     elements := Set new.
  34525.     self do: [:set | elements addAll: set].
  34526.     ^elements! !
  34527.  
  34528. !SetDictionary methodsFor: 'adding'!
  34529. at: key add: anObject 
  34530.  
  34531.     (self at: key ifAbsent: [self at: key put: Set new])
  34532.         add: anObject! !
  34533.  
  34534. !SetDictionary methodsFor: 'adding'!
  34535. at: key addAll: aSet 
  34536.  
  34537.     (self at: key ifAbsent: [self at: key put: Set new])
  34538.         addAll: aSet! !
  34539.  
  34540. !SetDictionary methodsFor: 'testing'!
  34541. isDeterministic
  34542.  
  34543.     self associationsDo: [:assoc | assoc value size > 1 ifTrue: [^false]].
  34544.     ^true! !
  34545.  
  34546. !SetDictionary methodsFor: 'converting'!
  34547. asDictionary
  34548.  
  34549.     | newDict |
  34550.     self isDeterministic
  34551.         ifTrue: 
  34552.             [newDict := Dictionary new: self size.
  34553.             self associationsDo: [:assoc | newDict at: assoc key put: assoc value first].
  34554.             ^newDict]
  34555.         ifFalse: [self error: 'SetDictionary cannot be converted to a Dictionary']! !
  34556.  
  34557. !SetDictionary methodsFor: 'dictionary enumerating'!
  34558. elementsDo: aBlock 
  34559.     "Evaluate aBlock with each element of each of the receiver's set elements as the 
  34560.     argument."
  34561.  
  34562.     self elements do: [:element | aBlock value: element]! !
  34563.  
  34564. Object subclass: #OrderedPair
  34565.     instanceVariableNames: 'x y'
  34566.     classVariableNames: ''
  34567.     poolDictionaries: ''
  34568.     category: 'Kernel-Objects'!
  34569. OrderedPair comment:
  34570. '=================================================
  34571.     Copyright (c) 1992 by Justin O. Graver.
  34572.     All rights reserved (with exceptions).
  34573.     For complete information evaluate "Object tgenCopyright."
  34574. =================================================
  34575.  
  34576. An OrderedPair extends the concept of a Point from Numbers to Objects. It is often
  34577. convenient to associate two objects together or to return a pair of objects from a
  34578. method.  OrderedPair provides the mechanism to do this without the inconvenience
  34579. of verbose syntax (as would be required if an Array or OrderedCollection were used).
  34580. The main instance creation method for OrderedPairs is the binary operator @.  This
  34581. operator is defined in Object and (now) overridden in Number so that numerical
  34582. points are treated and created in the traditional manner.
  34583.  
  34584. instance variables:
  34585.     x    <Object>    the first component of the pair
  34586.     y    <Object>    the second component of the pair
  34587. '!
  34588.  
  34589. OrderedPair comment:
  34590. '=================================================
  34591.     Copyright (c) 1992 by Justin O. Graver.
  34592.     All rights reserved (with exceptions).
  34593.     For complete information evaluate "Object tgenCopyright."
  34594. =================================================
  34595.  
  34596. An OrderedPair extends the concept of a Point from Numbers to Objects. It is often
  34597. convenient to associate two objects together or to return a pair of objects from a
  34598. method.  OrderedPair provides the mechanism to do this without the inconvenience
  34599. of verbose syntax (as would be required if an Array or OrderedCollection were used).
  34600. The main instance creation method for OrderedPairs is the binary operator @.  This
  34601. operator is defined in Object and (now) overridden in Number so that numerical
  34602. points are treated and created in the traditional manner.
  34603.  
  34604. instance variables:
  34605.     x    <Object>    the first component of the pair
  34606.     y    <Object>    the second component of the pair
  34607. '!
  34608.  
  34609. !OrderedPair methodsFor: 'initialization'!
  34610. x: anObject y: anotherObject
  34611.     "initializes an OrderedPair"
  34612.  
  34613.     x := anObject.
  34614.     y := anotherObject.! !
  34615.  
  34616. !OrderedPair methodsFor: 'accessing'!
  34617. x
  34618.     "answer the first element of the pair"
  34619.  
  34620.     ^x! !
  34621.  
  34622. !OrderedPair methodsFor: 'accessing'!
  34623. y
  34624.     "answer the second element of the pair"
  34625.  
  34626.     ^y! !
  34627.  
  34628. !OrderedPair methodsFor: 'comparing'!
  34629. = anOrderedPair
  34630.     "answers whether two OrderedPairs are equal"
  34631.  
  34632.     ^self species = anOrderedPair species
  34633.         and: [(x = anOrderedPair x) & (y = anOrderedPair y)]! !
  34634.  
  34635. !OrderedPair methodsFor: 'comparing'!
  34636. hash
  34637.     "answer the receiver's hash value"
  34638.  
  34639.     ^(x hash bitShift: -1) + (y hash bitShift: -2)! !
  34640.  
  34641. !OrderedPair methodsFor: 'printing'!
  34642. printOn: aStream 
  34643.     "Append to the argument aStream a sequence of characters that identifies the receiver."
  34644.  
  34645.     x printOn: aStream.
  34646.     aStream nextPutAll: ' @ '.
  34647.     y printString printOn: aStream.! !
  34648.  
  34649. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34650.  
  34651. OrderedPair class
  34652.     instanceVariableNames: ''!
  34653.  
  34654. !OrderedPair class methodsFor: 'instance creation'!
  34655. x: anObject y: anotherObject
  34656.     "Answer a new OrderedPair whose x element is anObject and whose y element is anotherObject."
  34657.  
  34658.     ^self new x: anObject y: anotherObject! !
  34659.  
  34660. !Object methodsFor: 'converting'!
  34661. @ anObject
  34662.     "Answer an OrderedPair with the receiver as the x element and anObject as the y element."
  34663.  
  34664.     ^OrderedPair x: self y: anObject! !
  34665.  
  34666. !Object methodsFor: 'converting'!
  34667. reversePairWith: x
  34668.     "Answer a new OrderedPair whose x value is the argument and whose y value is the receiver."
  34669.  
  34670.     ^OrderedPair x: x y: self! !
  34671.  
  34672. !Number methodsFor: 'converting'!
  34673. @ y 
  34674.     "Answer a new pair (Point or OrderedPair or ...) whose x value is the receiver
  34675.     and whose y value is the argument.  Optional.  No Lookup.  See Object 
  34676.     documentation whatIsAPrimitive."
  34677.  
  34678.     <primitive: 18>
  34679.     ^y reversePairWith: self! !
  34680.  
  34681. !Number methodsFor: 'converting'!
  34682. reversePairWith: x
  34683.     "Answer a new Point whose x value is the argument and whose y value is the receiver."
  34684.  
  34685.     ^Point x: x y: self! !
  34686.  
  34687. OptimizedLR1Parser subclass: #BuildAEParser
  34688.     instanceVariableNames: ''
  34689.     classVariableNames: ''
  34690.     poolDictionaries: ''
  34691.     category: 'Build-Parsers'!
  34692. BuildAEParser comment:
  34693. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34694.  
  34695. BuildAEParser comment:
  34696. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34697.  
  34698. !BuildAEParser methodsFor: 'private'!
  34699. scannerClass
  34700.     ^BuildAEScanner! !
  34701.  
  34702. !BuildAEParser methodsFor: 'private'!
  34703. treeBuilderClass
  34704.     ^AbstractSyntaxTreeBuilder! !
  34705.  
  34706. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34707.  
  34708. BuildAEParser class
  34709.     instanceVariableNames: ''!
  34710.  
  34711. !BuildAEParser class methodsFor: 'class initialization'!
  34712. initialize
  34713.     "BuildAEParser initialize"
  34714.     "ArithmeticExpr    :  Expr ;
  34715.  
  34716. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  34717. STerm : PTerm | Term;
  34718.  
  34719. ModExpr : STerm;
  34720. ModExpr : STerm '%' STerm {BuildPTNMod };
  34721.  
  34722. MulExpr : ModExpr;
  34723. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  34724. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  34725.  
  34726. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  34727.       |  Expr '-' MulExpr {BuildPTNSub}
  34728.       | MulExpr;
  34729. ""Simple Terms""
  34730.  
  34731. Num : <number> {BuildPTNArgNum};
  34732. Term    : Num   ;
  34733. Term    : NegNum ;
  34734. Term : AlphaTerm;
  34735. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  34736. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  34737. Term    : PosNum ;
  34738. PosNum    : '+' Num ;
  34739. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  34740. NegNum    : '-' Num  {BuildPTNUSub};"
  34741.  
  34742.     | table prodTable |
  34743.     prodTable := #( #Num '+' $ '<ident>' '<number>' #Term #ModExpr '<variables>' '-' #PosNum #PTerm '(' #Expr #NegNum #ArithmeticExpr ')' #MulExpr '/' '*' '%' #AlphaTerm #STerm 'BuildPTNArgNum' 'BuildPTNDiv' 'BuildPTNMod' 'BuildPTNSub' 'BuildPTNAdd' 'BuildPTNArgVar' 'BuildPTNArgTerm' 'BuildPTNParenthesis' 'BuildPTNMul' 'BuildPTNUSub' ).
  34744.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  22).
  34745.     table := #( #( 2 3 nil 6 5 7 8 10 12 11 15 16 32 19 33 nil 28 nil nil nil 21 22 ) #( nil #(6 #(1 ))  #(6 #(1 ))  nil nil nil nil nil #(6 #(1 ))  nil nil nil nil nil nil #(6 #(1 ))  nil #(6 #(1 ))  #(6 #(1 ))  #(6 #(1 ))  nil nil ) #( 4 nil nil nil 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil #(10 #(2 1 ))  #(10 #(2 1 ))  nil nil nil nil nil #(10 #(2 1 ))  nil nil nil nil nil nil #(10 #(2 1 ))  nil #(10 #(2 1 ))  #(10 #(2 1 ))  #(10 #(2 1 ))  nil nil ) #( nil #(1 #(5 )23)  #(1 #(5 )23)  nil nil nil nil nil #(1 #(5 )23)  nil nil nil nil nil nil #(1 #(5 )23)  nil #(1 #(5 )23)  #(1 #(5 )23)  #(1 #(5 )23)  nil nil ) #( nil #(21 #(4 )29)  #(21 #(4 )29)  nil nil nil nil nil #(21 #(4 )29)  nil nil nil nil nil nil #(21 #(4 )29)  nil #(21 #(4 )29)  #(21 #(4 )29)  #(21 #(4 )29)  nil nil ) #( nil #(22 #(6 ))  #(22 #(6 ))  nil nil nil nil nil #(22 #(6 ))  nil nil nil nil nil nil #(22 #(6 ))  nil #(22 #(6 ))  #(22 #(6 ))  #(22 #(6 ))  nil nil ) #( nil #(17 #(7 ))  #(17 #(7 ))  nil nil nil nil nil #(17 #(7 ))  nil nil nil nil nil nil #(17 #(7 ))  nil 9 30 nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 29 nil nil nil 21 22 ) #( nil #(21 #(8 )28)  #(21 #(8 )28)  nil nil nil nil nil #(21 #(8 )28)  nil nil nil nil nil nil #(21 #(8 )28)  nil #(21 #(8 )28)  #(21 #(8 )28)  #(21 #(8 )28)  nil nil ) #( nil #(6 #(10 ))  #(6 #(10 ))  nil nil nil nil nil #(6 #(10 ))  nil nil nil nil nil nil #(6 #(10 ))  nil #(6 #(10 ))  #(6 #(10 ))  #(6 #(10 ))  nil nil ) #( 13 nil nil 6 5 nil nil 10 nil nil nil nil nil nil nil nil nil nil nil nil 14 nil ) #( nil #(14 #(9 1 )32)  #(14 #(9 1 )32)  nil nil nil nil nil #(14 #(9 1 )32)  nil nil nil nil nil nil #(14 #(9 1 )32)  nil #(14 #(9 1 )32)  #(14 #(9 1 )32)  #(14 #(9 1 )32)  nil nil ) #( nil #(14 #(9 21 )32)  #(14 #(9 21 )32)  nil nil nil nil nil #(14 #(9 21 )32)  nil nil nil nil nil nil #(14 #(9 21 )32)  nil #(14 #(9 21 )32)  #(14 #(9 21 )32)  #(14 #(9 21 )32)  nil nil ) #( nil #(22 #(11 ))  #(22 #(11 ))  nil nil nil nil nil #(22 #(11 ))  nil nil nil nil nil nil #(22 #(11 ))  nil #(22 #(11 ))  #(22 #(11 ))  #(22 #(11 ))  nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 17 19 nil nil 28 nil nil nil 21 22 ) #( nil 26 nil nil nil nil nil nil 18 nil nil nil nil nil nil 25 nil nil nil nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 20 nil nil nil 21 22 ) #( nil #(6 #(14 ))  #(6 #(14 ))  nil nil nil nil nil #(6 #(14 ))  nil nil nil nil nil nil #(6 #(14 ))  nil #(6 #(14 ))  #(6 #(14 ))  #(6 #(14 ))  nil nil ) #( nil #(13 #(13 9 17 )26)  #(13 #(13 9 17 )26)  nil nil nil nil nil #(13 #(13 9 17 )26)  nil nil nil nil nil nil #(13 #(13 9 17 )26)  nil nil nil nil nil nil ) #( nil #(6 #(21 ))  #(6 #(21 ))  nil nil nil nil nil #(6 #(21 ))  nil nil nil nil nil nil #(6 #(21 ))  nil #(6 #(21 ))  #(6 #(21 ))  #(6 #(21 ))  nil nil ) #( nil #(7 #(22 ))  #(7 #(22 ))  nil nil nil nil nil #(7 #(22 ))  nil nil nil nil nil nil #(7 #(22 ))  nil #(7 #(22 ))  #(7 #(22 ))  23 nil nil ) #( 2 3 nil 6 5 7 nil 10 12 11 15 16 nil 19 nil nil nil nil nil nil 21 24 ) #( nil #(7 #(22 20 22 )25)  #(7 #(22 20 22 )25)  nil nil nil nil nil #(7 #(22 20 22 )25)  nil nil nil nil nil nil #(7 #(22 20 22 )25)  nil #(7 #(22 20 22 )25)  #(7 #(22 20 22 )25)  nil nil nil ) #( nil #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  nil nil nil nil nil #(11 #(12 13 16 )30)  nil nil nil nil nil nil #(11 #(12 13 16 )30)  nil #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  #(11 #(12 13 16 )30)  nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 27 nil nil nil 21 22 ) #( nil #(13 #(13 2 17 )27)  #(13 #(13 2 17 )27)  nil nil nil nil nil #(13 #(13 2 17 )27)  nil nil nil nil nil nil #(13 #(13 2 17 )27)  nil nil nil nil nil nil ) #( nil #(13 #(17 ))  #(13 #(17 ))  nil nil nil nil nil #(13 #(17 ))  nil nil nil nil nil nil #(13 #(17 ))  nil nil nil nil nil nil ) #( nil #(17 #(7 18 17 )24)  #(17 #(7 18 17 )24)  nil nil nil nil nil #(17 #(7 18 17 )24)  nil nil nil nil nil nil #(17 #(7 18 17 )24)  nil nil nil nil nil nil ) #( 2 3 nil 6 5 7 8 10 12 11 15 16 nil 19 nil nil 31 nil nil nil 21 22 ) #( nil #(17 #(7 19 17 )31)  #(17 #(7 19 17 )31)  nil nil nil nil nil #(17 #(7 19 17 )31)  nil nil nil nil nil nil #(17 #(7 19 17 )31)  nil nil nil nil nil nil ) #( nil 26 #(15 #(13 ))  nil nil nil nil nil 18 nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil 34 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) ).
  34746.     self constructParseTable: table  with: prodTable.
  34747.     self finalState: 34! !
  34748.  
  34749. Object subclass: #BuildTFExpr
  34750.     instanceVariableNames: 'expression ast result currentValue currentArg stack lastResult avDictionary dvDictionary simulateWindow '
  34751.     classVariableNames: ''
  34752.     poolDictionaries: ''
  34753.     category: 'Build-Parsers'!
  34754.  
  34755. !BuildTFExpr methodsFor: 'evaluating'!
  34756. bottomUpTraverse
  34757.     ast isNil ifFalse: [self bottomUpTraverse: ast]! !
  34758.  
  34759. !BuildTFExpr methodsFor: 'evaluating'!
  34760. bottomUpTraverse: aNode 
  34761.     aNode isNil
  34762.         ifFalse: 
  34763.             [aNode left isNil ifFalse: [self bottomUpTraverse: aNode left].
  34764.             aNode right isNil ifFalse: [self bottomUpTraverse: aNode right]].
  34765.     aNode doOperation: self! !
  34766.  
  34767. !BuildTFExpr methodsFor: 'evaluating'!
  34768. evaluate
  34769.     self bottomUpTraverse.
  34770.     ^ast result! !
  34771.  
  34772. !BuildTFExpr methodsFor: 'initialization'!
  34773. initialize
  34774.     currentValue := 0.
  34775.     stack := OrderedCollection new! !
  34776.  
  34777. !BuildTFExpr methodsFor: 'variable access'!
  34778. ast: anAst 
  34779.     ast := anAst! !
  34780.  
  34781. !BuildTFExpr methodsFor: 'variable access'!
  34782. avDictionary
  34783.     ^avDictionary! !
  34784.  
  34785. !BuildTFExpr methodsFor: 'variable access'!
  34786. avDictionary: aDictionary 
  34787.     avDictionary := aDictionary! !
  34788.  
  34789. !BuildTFExpr methodsFor: 'variable access'!
  34790. currentArg: aValue 
  34791.     currentArg := aValue! !
  34792.  
  34793. !BuildTFExpr methodsFor: 'variable access'!
  34794. dvDictionary
  34795.     ^dvDictionary! !
  34796.  
  34797. !BuildTFExpr methodsFor: 'variable access'!
  34798. dvDictionary: aDictionary 
  34799.     dvDictionary := aDictionary! !
  34800.  
  34801. !BuildTFExpr methodsFor: 'variable access'!
  34802. expression
  34803.     ^expression! !
  34804.  
  34805. !BuildTFExpr methodsFor: 'variable access'!
  34806. expression: aString 
  34807.     expression := aString.! !
  34808.  
  34809. !BuildTFExpr methodsFor: 'variable access'!
  34810. getValueOfVariableNamed: aString 
  34811.     | temp |
  34812.     temp := simulateWindow valueOf: aString.
  34813.     temp isInteger
  34814.         ifTrue: [^temp]
  34815.         ifFalse: [(temp at: 1) isDigit
  34816.                 ifTrue: [^temp asNumber]
  34817.                 ifFalse: [^temp]]! !
  34818.  
  34819. !BuildTFExpr methodsFor: 'variable access'!
  34820. getValueOfVariableNamedOld: aString 
  34821.     | temp |
  34822.     (temp := dvDictionary at: aString ifAbsent: [^nil]) isNil
  34823.         ifTrue: [^temp := avDictionary at: aString ifAbsent: [^nil]]
  34824.         ifFalse: [^temp asNumber]! !
  34825.  
  34826. !BuildTFExpr methodsFor: 'variable access'!
  34827. lastResult
  34828.     ^lastResult! !
  34829.  
  34830. !BuildTFExpr methodsFor: 'variable access'!
  34831. lastResult: aValue 
  34832.     lastResult := aValue! !
  34833.  
  34834. !BuildTFExpr methodsFor: 'variable access'!
  34835. result
  34836.     ^result! !
  34837.  
  34838. !BuildTFExpr methodsFor: 'variable access'!
  34839. simulateWindow
  34840.     ^simulateWindow! !
  34841.  
  34842. !BuildTFExpr methodsFor: 'variable access'!
  34843. simulateWindow: aSimulateWindow 
  34844.     simulateWindow := aSimulateWindow! !
  34845.  
  34846. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34847.  
  34848. BuildTFExpr class
  34849.     instanceVariableNames: ''!
  34850.  
  34851. !BuildTFExpr class methodsFor: 'instance creation'!
  34852. new
  34853.     ^super new initialize! !
  34854.  
  34855. !BuildTFExpr class methodsFor: 'instance creation'!
  34856. valueWithAST: anAST withAVs: dict1 withDVs: dict2 
  34857.     ^(self new) ast: anAST; avDictionary: dict1; dvDictionary: dict2; evaluate! !
  34858.  
  34859. !BuildTFExpr class methodsFor: 'instance creation'!
  34860. valueWithAST: anAST withSw: aSimulateWindow 
  34861.     ^(self new) ast: anAST; simulateWindow: aSimulateWindow; evaluate! !
  34862.  
  34863. OptimizedLR1Parser subclass: #BuildTFParser
  34864.     instanceVariableNames: ''
  34865.     classVariableNames: ''
  34866.     poolDictionaries: ''
  34867.     category: 'Build-Parsers'!
  34868. BuildTFParser comment:
  34869. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34870.  
  34871. BuildTFParser comment:
  34872. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34873.  
  34874. !BuildTFParser methodsFor: 'private'!
  34875. scannerClass
  34876.     ^BuildTFScanner! !
  34877.  
  34878. !BuildTFParser methodsFor: 'private'!
  34879. treeBuilderClass
  34880.     ^AbstractSyntaxTreeBuilder! !
  34881.  
  34882. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34883.  
  34884. BuildTFParser class
  34885.     instanceVariableNames: ''!
  34886.  
  34887. !BuildTFParser class methodsFor: 'class initialization'!
  34888. initialize
  34889.     "BuildTFParser initialize"
  34890.     "ArithmeticExpr    :  Ass ;
  34891.  
  34892. Ass :  T;
  34893. Ass : Ass ',' T{BuildPTNSeq};
  34894. T : AlphaTerm ':' Expr {BuildPTNAss};
  34895. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  34896. STerm : PTerm | Term;
  34897.  
  34898. ModExpr : STerm;
  34899. ModExpr : STerm '%' STerm {BuildPTNMod };
  34900.  
  34901. MulExpr : ModExpr;
  34902. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  34903. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  34904.  
  34905. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  34906.       |  Expr '-' MulExpr {BuildPTNSub}
  34907.       | MulExpr;
  34908.  
  34909.  
  34910. ""Simple Terms""
  34911.  
  34912. Num : <number> {BuildPTNArgNum};
  34913. Term    : Num   ;
  34914. Term    : NegNum ;
  34915. Term : AlphaTerm;
  34916. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  34917. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  34918. Term    : PosNum ;
  34919. PosNum    : '+' Num ;
  34920. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  34921. NegNum    : '-' Num  {BuildPTNUSub};"
  34922.  
  34923.     | table prodTable |
  34924.     prodTable := #( #Num '+' $ '<ident>' '<number>' ',' #Term #ModExpr '<variables>' '-' #PosNum #PTerm '(' #Expr #T #NegNum #ArithmeticExpr #Ass ')' #MulExpr '/' '*' ':' '%' #AlphaTerm #STerm 'BuildPTNArgNum' 'BuildPTNAss' 'BuildPTNDiv' 'BuildPTNMod' 'BuildPTNSub' 'BuildPTNAdd' 'BuildPTNArgVar' 'BuildPTNArgTerm' 'BuildPTNParenthesis' 'BuildPTNMul' 'BuildPTNSeq' 'BuildPTNUSub' ).
  34925.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  26).
  34926.     table := #( #( nil nil nil 10 nil nil nil nil 14 nil nil nil nil nil 37 nil 2 38 nil nil nil nil nil nil 4 nil ) #( nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 36 nil 23 nil nil nil 32 nil nil nil nil 25 26 ) #( nil #(7 #(1 ))  #(7 #(1 ))  nil nil #(7 #(1 ))  nil nil nil #(7 #(1 ))  nil nil nil nil nil nil nil nil #(7 #(1 ))  nil #(7 #(1 ))  #(7 #(1 ))  nil #(7 #(1 ))  nil nil ) #( 8 nil nil nil 9 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil #(11 #(2 1 ))  #(11 #(2 1 ))  nil nil #(11 #(2 1 ))  nil nil nil #(11 #(2 1 ))  nil nil nil nil nil nil nil nil #(11 #(2 1 ))  nil #(11 #(2 1 ))  #(11 #(2 1 ))  nil #(11 #(2 1 ))  nil nil ) #( nil #(1 #(5 )27)  #(1 #(5 )27)  nil nil #(1 #(5 )27)  nil nil nil #(1 #(5 )27)  nil nil nil nil nil nil nil nil #(1 #(5 )27)  nil #(1 #(5 )27)  #(1 #(5 )27)  nil #(1 #(5 )27)  nil nil ) #( nil #(25 #(4 )34)  #(25 #(4 )34)  nil nil #(25 #(4 )34)  nil nil nil #(25 #(4 )34)  nil nil nil nil nil nil nil nil #(25 #(4 )34)  nil #(25 #(4 )34)  #(25 #(4 )34)  #(25 #(4 )34)  #(25 #(4 )34)  nil nil ) #( nil #(26 #(7 ))  #(26 #(7 ))  nil nil #(26 #(7 ))  nil nil nil #(26 #(7 ))  nil nil nil nil nil nil nil nil #(26 #(7 ))  nil #(26 #(7 ))  #(26 #(7 ))  nil #(26 #(7 ))  nil nil ) #( nil #(20 #(8 ))  #(20 #(8 ))  nil nil #(20 #(8 ))  nil nil nil #(20 #(8 ))  nil nil nil nil nil nil nil nil #(20 #(8 ))  nil 13 34 nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 33 nil nil nil nil 25 26 ) #( nil #(25 #(9 )33)  #(25 #(9 )33)  nil nil #(25 #(9 )33)  nil nil nil #(25 #(9 )33)  nil nil nil nil nil nil nil nil #(25 #(9 )33)  nil #(25 #(9 )33)  #(25 #(9 )33)  #(25 #(9 )33)  #(25 #(9 )33)  nil nil ) #( nil #(7 #(11 ))  #(7 #(11 ))  nil nil #(7 #(11 ))  nil nil nil #(7 #(11 ))  nil nil nil nil nil nil nil nil #(7 #(11 ))  nil #(7 #(11 ))  #(7 #(11 ))  nil #(7 #(11 ))  nil nil ) #( 17 nil nil 10 9 nil nil nil 14 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 18 nil ) #( nil #(16 #(10 1 )38)  #(16 #(10 1 )38)  nil nil #(16 #(10 1 )38)  nil nil nil #(16 #(10 1 )38)  nil nil nil nil nil nil nil nil #(16 #(10 1 )38)  nil #(16 #(10 1 )38)  #(16 #(10 1 )38)  nil #(16 #(10 1 )38)  nil nil ) #( nil #(16 #(10 25 )38)  #(16 #(10 25 )38)  nil nil #(16 #(10 25 )38)  nil nil nil #(16 #(10 25 )38)  nil nil nil nil nil nil nil nil #(16 #(10 25 )38)  nil #(16 #(10 25 )38)  #(16 #(10 25 )38)  nil #(16 #(10 25 )38)  nil nil ) #( nil #(26 #(12 ))  #(26 #(12 ))  nil nil #(26 #(12 ))  nil nil nil #(26 #(12 ))  nil nil nil nil nil nil nil nil #(26 #(12 ))  nil #(26 #(12 ))  #(26 #(12 ))  nil #(26 #(12 ))  nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 21 nil 23 nil nil nil 32 nil nil nil nil 25 26 ) #( nil 30 nil nil nil nil nil nil nil 22 nil nil nil nil nil nil nil nil 29 nil nil nil nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 24 nil nil nil nil 25 26 ) #( nil #(7 #(16 ))  #(7 #(16 ))  nil nil #(7 #(16 ))  nil nil nil #(7 #(16 ))  nil nil nil nil nil nil nil nil #(7 #(16 ))  nil #(7 #(16 ))  #(7 #(16 ))  nil #(7 #(16 ))  nil nil ) #( nil #(14 #(14 10 20 )31)  #(14 #(14 10 20 )31)  nil nil #(14 #(14 10 20 )31)  nil nil nil #(14 #(14 10 20 )31)  nil nil nil nil nil nil nil nil #(14 #(14 10 20 )31)  nil nil nil nil nil nil nil ) #( nil #(7 #(25 ))  #(7 #(25 ))  nil nil #(7 #(25 ))  nil nil nil #(7 #(25 ))  nil nil nil nil nil nil nil nil #(7 #(25 ))  nil #(7 #(25 ))  #(7 #(25 ))  nil #(7 #(25 ))  nil nil ) #( nil #(8 #(26 ))  #(8 #(26 ))  nil nil #(8 #(26 ))  nil nil nil #(8 #(26 ))  nil nil nil nil nil nil nil nil #(8 #(26 ))  nil #(8 #(26 ))  #(8 #(26 ))  nil 27 nil nil ) #( 6 7 nil 10 9 nil 11 nil 14 16 15 19 20 nil nil 23 nil nil nil nil nil nil nil nil 25 28 ) #( nil #(8 #(26 24 26 )30)  #(8 #(26 24 26 )30)  nil nil #(8 #(26 24 26 )30)  nil nil nil #(8 #(26 24 26 )30)  nil nil nil nil nil nil nil nil #(8 #(26 24 26 )30)  nil #(8 #(26 24 26 )30)  #(8 #(26 24 26 )30)  nil nil nil nil ) #( nil #(12 #(13 14 19 )35)  #(12 #(13 14 19 )35)  nil nil #(12 #(13 14 19 )35)  nil nil nil #(12 #(13 14 19 )35)  nil nil nil nil nil nil nil nil #(12 #(13 14 19 )35)  nil #(12 #(13 14 19 )35)  #(12 #(13 14 19 )35)  nil #(12 #(13 14 19 )35)  nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 31 nil nil nil nil 25 26 ) #( nil #(14 #(14 2 20 )32)  #(14 #(14 2 20 )32)  nil nil #(14 #(14 2 20 )32)  nil nil nil #(14 #(14 2 20 )32)  nil nil nil nil nil nil nil nil #(14 #(14 2 20 )32)  nil nil nil nil nil nil nil ) #( nil #(14 #(20 ))  #(14 #(20 ))  nil nil #(14 #(20 ))  nil nil nil #(14 #(20 ))  nil nil nil nil nil nil nil nil #(14 #(20 ))  nil nil nil nil nil nil nil ) #( nil #(20 #(8 21 20 )29)  #(20 #(8 21 20 )29)  nil nil #(20 #(8 21 20 )29)  nil nil nil #(20 #(8 21 20 )29)  nil nil nil nil nil nil nil nil #(20 #(8 21 20 )29)  nil nil nil nil nil nil nil ) #( 6 7 nil 10 9 nil 11 12 14 16 15 19 20 nil nil 23 nil nil nil 35 nil nil nil nil 25 26 ) #( nil #(20 #(8 22 20 )36)  #(20 #(8 22 20 )36)  nil nil #(20 #(8 22 20 )36)  nil nil nil #(20 #(8 22 20 )36)  nil nil nil nil nil nil nil nil #(20 #(8 22 20 )36)  nil nil nil nil nil nil nil ) #( nil 30 #(15 #(25 23 14 )28)  nil nil #(15 #(25 23 14 )28)  nil nil nil 22 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil #(18 #(15 ))  nil nil #(18 #(15 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil #(17 #(18 ))  nil nil 39 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil 10 nil nil nil nil 14 nil nil nil nil nil 40 nil nil nil nil nil nil nil nil nil 4 nil ) #( nil nil #(18 #(18 6 15 )37)  nil nil #(18 #(18 6 15 )37)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) ).
  34927.     self constructParseTable: table  with: prodTable.
  34928.     self finalState: 3! !
  34929.  
  34930. OptimizedLR1Parser subclass: #BuildBoolParser
  34931.     instanceVariableNames: ''
  34932.     classVariableNames: ''
  34933.     poolDictionaries: ''
  34934.     category: 'Build-Parsers'!
  34935. BuildBoolParser comment:
  34936. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34937.  
  34938. BuildBoolParser comment:
  34939. 'This parser class was automatically generated by T-gen, Version 2.1.'!
  34940.  
  34941. !BuildBoolParser methodsFor: 'private'!
  34942. scannerClass
  34943.     ^BuildBoolScanner! !
  34944.  
  34945. !BuildBoolParser methodsFor: 'private'!
  34946. treeBuilderClass
  34947.     ^AbstractSyntaxTreeBuilder! !
  34948.  
  34949. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  34950.  
  34951. BuildBoolParser class
  34952.     instanceVariableNames: ''!
  34953.  
  34954. !BuildBoolParser class methodsFor: 'class initialization'!
  34955. initialize
  34956.     "BuildBoolParser initialize"
  34957.     "    ""Boolean Expressions""
  34958. S : BExpr;
  34959. BExpr : BTerm ;
  34960. BExpr : BExpr ',' BTerm{BuildPTNAND };
  34961. ""BExpr : '(' BExpr ')'{BuildPTNParenthesis};""
  34962. BExpr : BExpr ';' BTerm{BuildPTNOR };
  34963.  
  34964. ""PBTerm2 : '(' BTerm ')'{BuildPTNParenthesis};""
  34965. PBTerm2 : '(' BExpr ')'{BuildPTNParenthesis};
  34966. BTerm :  ABExpr  | 'true' | 'false' | PBTerm2 ;
  34967.  
  34968. ""Arithmetic relational operators""
  34969. ABExpr :  ANEQ | AGT | ALT | AGTE | ALTE | ANNEQ;
  34970. ANNEQ : ArithmeticExpr '#' ArithmeticExpr{BuildPTNNEQ };
  34971. ANEQ : ArithmeticExpr '=' ArithmeticExpr {BuildPTNEQ };
  34972. AGT : ArithmeticExpr '>' ArithmeticExpr  {BuildPTNGT };
  34973. ALT : ArithmeticExpr '<' ArithmeticExpr{BuildPTNLT };
  34974. AGTE : ArithmeticExpr '>=' ArithmeticExpr{BuildPTNGTE };
  34975. ALTE : ArithmeticExpr '=<' ArithmeticExpr{BuildPTNLTE };
  34976.  
  34977.  
  34978. ArithmeticExpr    :  Expr ;
  34979. PTerm : '(' Expr ')' {BuildPTNParenthesis};
  34980. STerm : PTerm | Term;
  34981.  
  34982. ModExpr : STerm;
  34983. ModExpr : STerm '%' STerm {BuildPTNMod };
  34984.  
  34985. MulExpr : ModExpr;
  34986. MulExpr : ModExpr '*' MulExpr{BuildPTNMul };
  34987. MulExpr : ModExpr '/' MulExpr {BuildPTNDiv};
  34988.  
  34989. Expr :  Expr '+' MulExpr {BuildPTNAdd}
  34990.       |  Expr '-' MulExpr {BuildPTNSub}
  34991.       | MulExpr;
  34992.  
  34993.  
  34994. ""Simple Terms""
  34995.  
  34996. Num : <number> {BuildPTNArgNum};
  34997. Term    : Num   ;
  34998. Term    : NegNum ;
  34999. Term : AlphaTerm;
  35000. AlphaTerm    : <variables>  {BuildPTNArgVar} ;
  35001. AlphaTerm    : <ident>  {BuildPTNArgTerm} ;
  35002. Term    : PosNum ;
  35003. PosNum    : '+' Num ;
  35004. NegNum   : '-' AlphaTerm {BuildPTNUSub};
  35005. NegNum    : '-' Num  {BuildPTNUSub};
  35006. "
  35007.  
  35008.     | table prodTable |
  35009.     prodTable := #( #ModExpr #PosNum #PBTerm2 $ '=' ')' #ALTE #ABExpr '<' '>=' '(' #STerm #PTerm #NegNum ';' '=<' #AGTE #BTerm #S '/' '<variables>' '%' #Term #AlphaTerm #ALT #Num #ANEQ #BExpr '-' '#' 'false' #Expr ',' #AGT '<ident>' '<number>' #MulExpr #ArithmeticExpr #ANNEQ '+' 'true' '>' '*' 'BuildPTNAND' 'BuildPTNUSub' 'BuildPTNGT' 'BuildPTNArgNum' 'BuildPTNLT' 'BuildPTNOR' 'BuildPTNMod' 'BuildPTNArgVar' 'BuildPTNAdd' 'BuildPTNNEQ' 'BuildPTNGTE' 'BuildPTNLTE' 'BuildPTNEQ' 'BuildPTNParenthesis' 'BuildPTNDiv' 'BuildPTNMul' 'BuildPTNArgTerm' 'BuildPTNSub' ).
  35010.     self tokenTypeTable:  (prodTable copyFrom: 1 to:  43).
  35011.     table := #( #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 37 65 nil 10 nil 9 21 38 4 39 67 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(37 #(1 ))  #(37 #(1 ))  #(37 #(1 ))  nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil nil 3 nil nil nil nil nil nil nil nil #(37 #(1 ))  #(37 #(1 ))  nil nil #(37 #(1 ))  nil nil nil nil nil nil #(37 #(1 ))  nil #(37 #(1 ))  30 ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 29 nil nil 5 nil nil nil ) #( nil nil nil #(23 #(26 ))  #(23 #(26 ))  #(23 #(26 ))  nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil nil #(23 #(26 ))  nil #(23 #(26 ))  nil nil nil nil nil nil #(23 #(26 ))  #(23 #(26 ))  nil nil #(23 #(26 ))  nil nil nil nil nil nil #(23 #(26 ))  nil #(23 #(26 ))  #(23 #(26 ))  ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 nil nil nil nil nil nil nil nil nil 7 nil nil nil nil nil nil nil ) #( nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil nil #(2 #(40 26 ))  nil #(2 #(40 26 ))  nil nil nil nil nil nil #(2 #(40 26 ))  #(2 #(40 26 ))  nil nil #(2 #(40 26 ))  nil nil nil nil nil nil #(2 #(40 26 ))  nil #(2 #(40 26 ))  #(2 #(40 26 ))  ) #( nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  #(26 #(36 )47)  nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil nil #(26 #(36 )47)  nil #(26 #(36 )47)  nil nil nil nil nil nil #(26 #(36 )47)  #(26 #(36 )47)  nil nil #(26 #(36 )47)  nil nil nil nil nil nil #(26 #(36 )47)  nil #(26 #(36 )47)  #(26 #(36 )47)  ) #( nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  #(24 #(35 )60)  nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil nil #(24 #(35 )60)  nil #(24 #(35 )60)  nil nil nil nil nil nil #(24 #(35 )60)  #(24 #(35 )60)  nil nil #(24 #(35 )60)  nil nil nil nil nil nil #(24 #(35 )60)  nil #(24 #(35 )60)  #(24 #(35 )60)  ) #( nil nil nil #(12 #(23 ))  #(12 #(23 ))  #(12 #(23 ))  nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil nil #(12 #(23 ))  nil #(12 #(23 ))  nil nil nil nil nil nil #(12 #(23 ))  #(12 #(23 ))  nil nil #(12 #(23 ))  nil nil nil nil nil nil #(12 #(23 ))  nil #(12 #(23 ))  #(12 #(23 ))  ) #( nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  #(24 #(21 )51)  nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil nil #(24 #(21 )51)  nil #(24 #(21 )51)  nil nil nil nil nil nil #(24 #(21 )51)  #(24 #(21 )51)  nil nil #(24 #(21 )51)  nil nil nil nil nil nil #(24 #(21 )51)  nil #(24 #(21 )51)  #(24 #(21 )51)  ) #( nil nil nil #(23 #(2 ))  #(23 #(2 ))  #(23 #(2 ))  nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil nil #(23 #(2 ))  nil #(23 #(2 ))  nil nil nil nil nil nil #(23 #(2 ))  #(23 #(2 ))  nil nil #(23 #(2 ))  nil nil nil nil nil nil #(23 #(2 ))  nil #(23 #(2 ))  #(23 #(2 ))  ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 10 nil nil 14 nil 13 nil nil nil nil nil nil nil nil 8 7 nil nil nil nil nil nil nil ) #( nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil nil #(14 #(29 26 )45)  nil #(14 #(29 26 )45)  nil nil nil nil nil nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  nil nil #(14 #(29 26 )45)  nil nil nil nil nil nil #(14 #(29 26 )45)  nil #(14 #(29 26 )45)  #(14 #(29 26 )45)  ) #( nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil nil #(14 #(29 24 )45)  nil #(14 #(29 24 )45)  nil nil nil nil nil nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  nil nil #(14 #(29 24 )45)  nil nil nil nil nil nil #(14 #(29 24 )45)  nil #(14 #(29 24 )45)  #(14 #(29 24 )45)  ) #( nil nil nil #(12 #(13 ))  #(12 #(13 ))  #(12 #(13 ))  nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil nil #(12 #(13 ))  nil #(12 #(13 ))  nil nil nil nil nil nil #(12 #(13 ))  #(12 #(13 ))  nil nil #(12 #(13 ))  nil nil nil nil nil nil #(12 #(13 ))  nil #(12 #(13 ))  #(12 #(13 ))  ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 17 nil nil 8 7 28 nil nil 5 nil nil nil ) #( nil nil nil nil nil 25 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 18 nil nil nil nil nil nil nil nil nil nil 26 nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 20 nil nil 5 nil nil nil ) #( nil nil nil #(23 #(14 ))  #(23 #(14 ))  #(23 #(14 ))  nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil nil #(23 #(14 ))  nil #(23 #(14 ))  nil nil nil nil nil nil #(23 #(14 ))  #(23 #(14 ))  nil nil #(23 #(14 ))  nil nil nil nil nil nil #(23 #(14 ))  nil #(23 #(14 ))  #(23 #(14 ))  ) #( nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(32 29 37 )61)  #(32 #(32 29 37 )61)  nil nil #(32 #(32 29 37 )61)  nil nil nil nil nil nil #(32 #(32 29 37 )61)  nil #(32 #(32 29 37 )61)  nil ) #( nil nil nil #(23 #(24 ))  #(23 #(24 ))  #(23 #(24 ))  nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil nil #(23 #(24 ))  nil #(23 #(24 ))  nil nil nil nil nil nil #(23 #(24 ))  #(23 #(24 ))  nil nil #(23 #(24 ))  nil nil nil nil nil nil #(23 #(24 ))  nil #(23 #(24 ))  #(23 #(24 ))  ) #( nil nil nil #(1 #(12 ))  #(1 #(12 ))  #(1 #(12 ))  nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil nil #(1 #(12 ))  nil 23 nil nil nil nil nil nil #(1 #(12 ))  #(1 #(12 ))  nil nil #(1 #(12 ))  nil nil nil nil nil nil #(1 #(12 ))  nil #(1 #(12 ))  #(1 #(12 ))  ) #( nil 11 nil nil nil nil nil nil nil nil 16 24 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 nil nil nil 5 nil nil nil ) #( nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil nil #(1 #(12 22 12 )50)  nil nil nil nil nil nil nil nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  nil nil #(1 #(12 22 12 )50)  nil nil nil nil nil nil #(1 #(12 22 12 )50)  nil #(1 #(12 22 12 )50)  #(1 #(12 22 12 )50)  ) #( nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil nil #(13 #(11 32 6 )57)  nil #(13 #(11 32 6 )57)  nil nil nil nil nil nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  nil nil #(13 #(11 32 6 )57)  nil nil nil nil nil nil #(13 #(11 32 6 )57)  nil #(13 #(11 32 6 )57)  #(13 #(11 32 6 )57)  ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 27 nil nil 5 nil nil nil ) #( nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(32 40 37 )52)  #(32 #(32 40 37 )52)  nil nil #(32 #(32 40 37 )52)  nil nil nil nil nil nil #(32 #(32 40 37 )52)  nil #(32 #(32 40 37 )52)  nil ) #( nil nil nil #(32 #(37 ))  #(32 #(37 ))  #(32 #(37 ))  nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil nil nil nil nil nil nil nil nil nil nil #(32 #(37 ))  #(32 #(37 ))  nil nil #(32 #(37 ))  nil nil nil nil nil nil #(32 #(37 ))  nil #(32 #(37 ))  nil ) #( nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil nil nil nil nil nil nil nil nil nil nil #(37 #(1 20 37 )58)  #(37 #(1 20 37 )58)  nil nil #(37 #(1 20 37 )58)  nil nil nil nil nil nil #(37 #(1 20 37 )58)  nil #(37 #(1 20 37 )58)  nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil nil nil nil 8 7 31 nil nil 5 nil nil nil ) #( nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil nil nil nil nil nil nil nil nil nil nil #(37 #(1 43 37 )59)  #(37 #(1 43 37 )59)  nil nil #(37 #(1 43 37 )59)  nil nil nil nil nil nil #(37 #(1 43 37 )59)  nil #(37 #(1 43 37 )59)  nil ) #( nil nil nil #(18 #(3 ))  nil #(18 #(3 ))  nil nil nil nil nil nil nil nil #(18 #(3 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(3 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(7 ))  nil #(8 #(7 ))  nil nil nil nil nil nil nil nil #(8 #(7 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(7 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(8 ))  nil #(18 #(8 ))  nil nil nil nil nil nil nil nil #(18 #(8 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(8 ))  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 37 nil nil 10 nil 9 21 38 4 39 40 12 nil 43 64 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(8 #(17 ))  nil #(8 #(17 ))  nil nil nil nil nil nil nil nil #(8 #(17 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(17 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(28 #(18 ))  nil #(28 #(18 ))  nil nil nil nil nil nil nil nil #(28 #(18 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(18 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(25 ))  nil #(8 #(25 ))  nil nil nil nil nil nil nil nil #(8 #(25 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(25 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(27 ))  nil #(8 #(27 ))  nil nil nil nil nil nil nil nil #(8 #(27 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(27 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil 61 nil nil nil nil nil nil nil nil 41 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 42 nil nil 10 nil 9 21 38 4 39 nil 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(28 #(28 15 18 )49)  nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(28 15 18 )49)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(31 ))  nil #(18 #(31 ))  nil nil nil nil nil nil nil nil #(18 #(31 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(31 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(38 #(32 ))  #(38 #(32 ))  #(38 #(32 ))  nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil nil nil nil nil nil nil nil nil 18 #(38 #(32 ))  nil nil #(38 #(32 ))  nil nil nil nil nil nil 26 nil #(38 #(32 ))  nil ) #( nil nil nil #(8 #(34 ))  nil #(8 #(34 ))  nil nil nil nil nil nil nil nil #(8 #(34 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(34 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil 55 nil nil nil 47 49 nil nil nil nil nil 53 nil nil nil nil nil nil nil nil nil nil nil nil nil 57 nil nil nil nil nil nil nil nil nil nil nil 51 nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 48 nil 5 nil nil nil ) #( nil nil nil #(25 #(38 9 38 )48)  nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(25 #(38 9 38 )48)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 50 nil 5 nil nil nil ) #( nil nil nil #(17 #(38 10 38 )54)  nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(17 #(38 10 38 )54)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 52 nil 5 nil nil nil ) #( nil nil nil #(34 #(38 42 38 )46)  nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(34 #(38 42 38 )46)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 54 nil 5 nil nil nil ) #( nil nil nil #(7 #(38 16 38 )55)  nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(7 #(38 16 38 )55)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 56 nil 5 nil nil nil ) #( nil nil nil #(27 #(38 5 38 )56)  nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(27 #(38 5 38 )56)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 nil nil nil nil nil nil nil nil 16 22 15 19 nil nil nil nil nil nil 10 nil 9 21 nil 4 nil nil 12 nil nil 44 nil nil 8 7 28 58 nil 5 nil nil nil ) #( nil nil nil #(39 #(38 30 38 )53)  nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(39 #(38 30 38 )53)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(8 #(39 ))  nil #(8 #(39 ))  nil nil nil nil nil nil nil nil #(8 #(39 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(8 #(39 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(18 #(41 ))  nil #(18 #(41 ))  nil nil nil nil nil nil nil nil #(18 #(41 ))  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(18 #(41 ))  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(3 #(11 28 6 )57)  nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(3 #(11 28 6 )57)  nil nil nil nil nil nil nil nil nil nil ) #( 2 11 32 nil nil nil 33 34 nil nil 35 22 15 19 nil nil 36 63 nil nil 10 nil 9 21 38 4 39 nil 12 nil 43 44 nil 45 8 7 28 46 59 5 60 nil nil ) #( nil nil nil #(28 #(28 33 18 )44)  nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil #(28 #(28 33 18 )44)  nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil #(38 #(32 ))  25 nil nil #(38 #(32 ))  #(38 #(32 ))  nil nil nil nil nil #(38 #(32 ))  nil nil nil nil nil nil nil nil nil nil nil nil 18 #(38 #(32 ))  nil nil nil nil nil nil nil nil nil 26 nil #(38 #(32 ))  nil ) #( nil nil nil 66 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil #(19 #(28 ))  nil nil nil nil nil nil nil nil nil nil 41 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil nil nil nil nil nil nil nil ) ).
  35012.     self constructParseTable: table  with: prodTable.
  35013.     self finalState: 66! !
  35014.  
  35015. OptimizedScanner subclass: #BuildAEScanner
  35016.     instanceVariableNames: ''
  35017.     classVariableNames: ''
  35018.     poolDictionaries: ''
  35019.     category: 'Build-Parsers'!
  35020. BuildAEScanner comment:
  35021. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35022.  
  35023. BuildAEScanner comment:
  35024. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35025.  
  35026. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  35027.  
  35028. BuildAEScanner class
  35029.     instanceVariableNames: ''!
  35030.  
  35031. !BuildAEScanner class methodsFor: 'class initialization'!
  35032. initialize
  35033.     "BuildAEScanner initialize"
  35034.     " <ident> : [a-z][a-zA-Z0-9_]*;
  35035.  <variables> : [A-Z][a-zA-Z0-9_]*;
  35036. <number> : [1-9][0-9]* | [0];
  35037. <space> : [\s\t\r]+ {ignoreDelimiter};"
  35038.  
  35039.     | table |
  35040.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 3 nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil 6 nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil 7 nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) ).
  35041.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' '*' ')' ':' '(' '/' '%' '-' ',' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( ) #( #('<ident>' nil) ) ) ).
  35042.     self constructFinalStateTable: table! !
  35043.  
  35044. OptimizedScanner subclass: #BuildBoolScanner
  35045.     instanceVariableNames: ''
  35046.     classVariableNames: ''
  35047.     poolDictionaries: ''
  35048.     category: 'Build-Parsers'!
  35049. BuildBoolScanner comment:
  35050. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35051.  
  35052. BuildBoolScanner comment:
  35053. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35054.  
  35055. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  35056.  
  35057. BuildBoolScanner class
  35058.     instanceVariableNames: ''!
  35059.  
  35060. !BuildBoolScanner class methodsFor: 'class initialization'!
  35061. initialize
  35062.     "BuildBoolScanner initialize"
  35063.     " <ident> : [a-z][a-zA-Z0-9_]*;
  35064.  <variables> : [A-Z][a-zA-Z0-9_]*;
  35065. <number> : [1-9][0-9]* | [0];
  35066. <space> : [\s\t\r]+ {ignoreDelimiter};"
  35067.  
  35068.     | table |
  35069.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil 3 nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 nil 3 3 6 7 nil nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 3 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil nil nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil 8 nil 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil nil nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil 9 nil 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 nil nil nil nil nil ) ).
  35070.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' ';' ',' '<' '-' '(' '#' ')' '=<' '/' '*' '%' '>=' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( '=' ) #( ) ) #( #( '>' ) #( ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( 'true' 'false' ) #( #('<ident>' nil) ) ) ).
  35071.     self constructFinalStateTable: table! !
  35072.  
  35073. OptimizedScanner subclass: #BuildTFScanner
  35074.     instanceVariableNames: ''
  35075.     classVariableNames: ''
  35076.     poolDictionaries: ''
  35077.     category: 'Build-Parsers'!
  35078. BuildTFScanner comment:
  35079. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35080.  
  35081. BuildTFScanner comment:
  35082. 'This scanner class was automatically generated by T-gen, Version 2.1.'!
  35083.  
  35084. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  35085.  
  35086. BuildTFScanner class
  35087.     instanceVariableNames: ''!
  35088.  
  35089. !BuildTFScanner class methodsFor: 'class initialization'!
  35090. initialize
  35091.     "BuildTFScanner initialize"
  35092.     " <ident> : [a-z][a-zA-Z0-9_]*;
  35093.  <variables> : [A-Z][a-zA-Z0-9_]*;
  35094. <number> : [1-9][0-9]* | [0];
  35095. <space> : [\s\t\r]+ {ignoreDelimiter};"
  35096.  
  35097.     | table |
  35098.     self fsa: #( #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil 3 nil nil 3 3 3 3 3 3 nil 3 4 5 5 5 5 5 5 5 5 5 3 nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil 2 nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 2 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 5 5 5 5 5 5 5 5 5 5 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil nil nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil 6 nil 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 nil nil nil nil nil ) #( nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil nil nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil 7 nil 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 nil nil nil nil nil ) ).
  35099.     table := #( nil #( #( ) #( #('<space>' #ignoreDelimiter) ) ) #( #( '+' '*' ')' ':' '(' '/' '%' '-' ',' ) #( ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<number>' nil) ) ) #( #( ) #( #('<variables>' nil) ) ) #( #( ) #( #('<ident>' nil) ) ) ).
  35100.     self constructFinalStateTable: table! !
  35101.  
  35102. ParseTreeNode subclass: #BuildParseTreeNode
  35103.     instanceVariableNames: 'left right children result error rhsVars '
  35104.     classVariableNames: ''
  35105.     poolDictionaries: ''
  35106.     category: 'Build-Parsers'!
  35107.  
  35108. !BuildParseTreeNode methodsFor: 'evaluating'!
  35109. evaluateFromExpr: aBuildTFExpr! !
  35110.  
  35111. !BuildParseTreeNode methodsFor: 'variable access'!
  35112. left
  35113.     children isNil
  35114.         ifTrue: [^nil]
  35115.         ifFalse: [children size = 0 ifFalse: [^children at: 1]
  35116.                 ifTrue: [^nil]]! !
  35117.  
  35118. !BuildParseTreeNode methodsFor: 'variable access'!
  35119. result
  35120.     ^result! !
  35121.  
  35122. !BuildParseTreeNode methodsFor: 'variable access'!
  35123. rhsVars
  35124.     "This variable passes the names of the variables appearing in the 
  35125.     sub-tree"
  35126.  
  35127.     ^rhsVars! !
  35128.  
  35129. !BuildParseTreeNode methodsFor: 'variable access'!
  35130. right
  35131.     children isNil
  35132.         ifTrue: [^nil]
  35133.         ifFalse: [children size < 2 ifFalse: [^children at: 2]
  35134.                 ifTrue: [^nil]]! !
  35135.  
  35136. !BuildParseTreeNode methodsFor: 'access'!
  35137. addChildrenFirst: anOrderedCollection 
  35138.     anOrderedCollection do: [:x | children addFirst: x].
  35139.     rhsVars := OrderedCollection new.
  35140.     children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]! !
  35141.  
  35142. !BuildParseTreeNode methodsFor: 'access'!
  35143. addChildrenInitial: anOrderedCollection 
  35144.     children := anOrderedCollection.
  35145.     rhsVars := OrderedCollection new.
  35146.     children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]! !
  35147.  
  35148. !BuildParseTreeNode methodsFor: 'access'!
  35149. addChildrenLast: anOrderedCollection 
  35150.     children notNil
  35151.         ifTrue: [anOrderedCollection do: [:x | children addLast: x]]
  35152.         ifFalse: 
  35153.             [children := anOrderedCollection.
  35154.             rhsVars := OrderedCollection new.
  35155.             children notNil ifTrue: [children do: [:x | x rhsVars notNil ifTrue: [rhsVars addAll: x rhsVars]]]]! !
  35156.  
  35157. BuildParseTreeNode subclass: #BuildPTNArg
  35158.     instanceVariableNames: 'value expr '
  35159.     classVariableNames: ''
  35160.     poolDictionaries: ''
  35161.     category: 'Build-Parsers'!
  35162.  
  35163. !BuildPTNArg methodsFor: 'evaluating'!
  35164. doOperation: e 
  35165.     expr := e.
  35166.     ^result := self actualValue! !
  35167.  
  35168. !BuildPTNArg methodsFor: 'access'!
  35169. actualValue
  35170.     "Sub-Class Responsibility"
  35171.  
  35172.     ^self! !
  35173.  
  35174. !BuildPTNArg methodsFor: 'access'!
  35175. expr
  35176.     ^expr! !
  35177.  
  35178. !BuildPTNArg methodsFor: 'access'!
  35179. expr: anExpr 
  35180.     expr := anExpr! !
  35181.  
  35182. !BuildPTNArg methodsFor: 'access'!
  35183. setAttribute: aValue 
  35184.     value := aValue! !
  35185.  
  35186. !BuildPTNArg methodsFor: 'access'!
  35187. value
  35188.     ^value! !
  35189.  
  35190. BuildPTNArg subclass: #BuildPTNArgVar
  35191.     instanceVariableNames: ''
  35192.     classVariableNames: ''
  35193.     poolDictionaries: ''
  35194.     category: 'Build-Parsers'!
  35195.  
  35196. !BuildPTNArgVar methodsFor: 'access'!
  35197. actualValue
  35198.     ^result := expr getValueOfVariableNamed: value! !
  35199.  
  35200. !BuildPTNArgVar methodsFor: 'access'!
  35201. addChildrenInitial: anOrderedCollection 
  35202.     super addChildrenInitial: anOrderedCollection.
  35203.     "value := OrderedCollection with: (children at: 1) value"! !
  35204.  
  35205. !BuildPTNArgVar methodsFor: 'access'!
  35206. setAttribute: aValue 
  35207.     super setAttribute: aValue.
  35208.     rhsVars := OrderedCollection with: aValue.! !
  35209.  
  35210. !BuildPTNArgVar methodsFor: 'evaluation'!
  35211. doOperation: e 
  35212.     expr := e.
  35213.     result := self actualValue.
  35214.     rhsVars add: result.
  35215.     ^result! !
  35216.  
  35217. !BuildPTNArgVar methodsFor: 'evaluation'!
  35218. handleVisitation: aBuildTFExpr 
  35219.     ^result := self actualValue.! !
  35220.  
  35221. BuildPTNArg subclass: #BuildPTNParenthesis
  35222.     instanceVariableNames: ''
  35223.     classVariableNames: ''
  35224.     poolDictionaries: ''
  35225.     category: 'Build-Parsers'!
  35226.  
  35227. !BuildPTNParenthesis methodsFor: 'access'!
  35228. actualValue
  35229.     ^BuildTFExpr valueWithAST: (children at: 1)
  35230.         withSw: expr simulateWindow! !
  35231.  
  35232. !BuildPTNParenthesis methodsFor: 'access'!
  35233. left
  35234.     ^nil! !
  35235.  
  35236. !BuildPTNParenthesis methodsFor: 'access'!
  35237. right
  35238.     ^nil! !
  35239.  
  35240. !BuildPTNParenthesis methodsFor: 'access'!
  35241. setAttribute: aValue 
  35242.     value := '()'! !
  35243.  
  35244. BuildPTNArg subclass: #BuildPTNSeq
  35245.     instanceVariableNames: ''
  35246.     classVariableNames: ''
  35247.     poolDictionaries: ''
  35248.     category: 'Build-Parsers'!
  35249.  
  35250. !BuildPTNSeq methodsFor: 'access'!
  35251. addChildrenInitial: anOrderedCollection 
  35252.     super addChildrenInitial: anOrderedCollection.
  35253.     value := OrderedCollection new "value" addAll: (children at: 1) value.
  35254.     value addAll: (children at: 2) value! !
  35255.  
  35256. BuildPTNArg subclass: #BuildPTNArgNum
  35257.     instanceVariableNames: ''
  35258.     classVariableNames: ''
  35259.     poolDictionaries: ''
  35260.     category: 'Build-Parsers'!
  35261.  
  35262. !BuildPTNArgNum methodsFor: 'evaluation'!
  35263. doOperation: ignore
  35264.     ^result := self actualValue! !
  35265.  
  35266. !BuildPTNArgNum methodsFor: 'evaluation'!
  35267. handleVisitation: aBuildTFExpr 
  35268.     result := self actualValue.! !
  35269.  
  35270. !BuildPTNArgNum methodsFor: 'access'!
  35271. actualValue
  35272.     ^result := value asNumber! !
  35273.  
  35274. BuildPTNArg subclass: #BuildPTNArgTerm
  35275.     instanceVariableNames: ''
  35276.     classVariableNames: ''
  35277.     poolDictionaries: ''
  35278.     category: 'Build-Parsers'!
  35279.  
  35280. !BuildPTNArgTerm methodsFor: 'access'!
  35281. actualValue
  35282.     ^result := value! !
  35283.  
  35284. !BuildPTNArgTerm methodsFor: 'access'!
  35285. setAttribute: aValue 
  35286.     super setAttribute: aValue! !
  35287.  
  35288. !BuildPTNArgTerm methodsFor: 'evaluation'!
  35289. handleVisitation: aBuildTFExpr 
  35290.     result := self actualValue "inspect"! !
  35291.  
  35292. BuildPTNArg subclass: #BuildPTNAss
  35293.     instanceVariableNames: ''
  35294.     classVariableNames: ''
  35295.     poolDictionaries: ''
  35296.     category: 'Build-Parsers'!
  35297.  
  35298. !BuildPTNAss methodsFor: 'access'!
  35299. addChildrenInitial: anOrderedCollection 
  35300.     super addChildrenInitial: anOrderedCollection.
  35301.     value := OrderedCollection with: (children at: 1) value! !
  35302.  
  35303. !BuildPTNAss methodsFor: 'access'!
  35304. setAttribute: aValue 
  35305.     value := children at: 1! !
  35306.  
  35307. BuildParseTreeNode subclass: #BuildPTNOperators
  35308.     instanceVariableNames: 'value leftValue rightValue '
  35309.     classVariableNames: ''
  35310.     poolDictionaries: ''
  35311.     category: 'Build-Parsers'!
  35312.  
  35313. !BuildPTNOperators methodsFor: 'evaluating'!
  35314. doOperation
  35315.     "SubClass responsibility"! !
  35316.  
  35317. !BuildPTNOperators methodsFor: 'evaluating'!
  35318. doOperation: anExpr
  35319.     "SubClass responsibility"! !
  35320.  
  35321. !BuildPTNOperators methodsFor: 'evaluating'!
  35322. evaluateFromExpr: aBuildTFExpr 
  35323.     rightValue := BuildTFExpr lastResult.
  35324.     aBuildTFExpr lastResult: self doOperation! !
  35325.  
  35326. !BuildPTNOperators methodsFor: 'evaluating'!
  35327. handleVisitation: aBuildTFExpr 
  35328.     leftValue := aBuildTFExpr lastResult.! !
  35329.  
  35330. !BuildPTNOperators methodsFor: 'access'!
  35331. addChildrenFirst: anOrderedCollection 
  35332.     anOrderedCollection do: [:x | children addFirst: x]! !
  35333.  
  35334. !BuildPTNOperators methodsFor: 'access'!
  35335. addChildrenInitial: anOrderedCollection 
  35336.     super addChildrenInitial: anOrderedCollection.! !
  35337.  
  35338. !BuildPTNOperators methodsFor: 'access'!
  35339. addChildrenLast: anOrderedCollection 
  35340.     children notNil
  35341.         ifTrue: [anOrderedCollection do: [:x | children addLast: x]]
  35342.         ifFalse: [children := anOrderedCollection]! !
  35343.  
  35344. !BuildPTNOperators methodsFor: 'access'!
  35345. leftValue
  35346.     ^leftValue! !
  35347.  
  35348. !BuildPTNOperators methodsFor: 'access'!
  35349. rightValue
  35350.     ^rightValue! !
  35351.  
  35352. !BuildPTNOperators methodsFor: 'access'!
  35353. rightValue: aValue 
  35354.     rightValue := aValue! !
  35355.  
  35356. !BuildPTNOperators methodsFor: 'access'!
  35357. setAttribute: aValue 
  35358.     value := aValue! !
  35359.  
  35360. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  35361.  
  35362. BuildPTNOperators class
  35363.     instanceVariableNames: ''!
  35364.  
  35365. !BuildPTNOperators class methodsFor: 'instance creation'!
  35366. new
  35367.     ^super new setAttribute: nil! !
  35368.  
  35369. BuildPTNOperators subclass: #BuildPTNOR
  35370.     instanceVariableNames: ''
  35371.     classVariableNames: ''
  35372.     poolDictionaries: ''
  35373.     category: 'Build-Parsers'!
  35374.  
  35375. !BuildPTNOR methodsFor: 'evaluating'!
  35376. doOperation: ignore
  35377.     ^result := self left result | self right result! !
  35378.  
  35379. BuildPTNOperators subclass: #BuildPTNDiv
  35380.     instanceVariableNames: ''
  35381.     classVariableNames: ''
  35382.     poolDictionaries: ''
  35383.     category: 'Build-Parsers'!
  35384.  
  35385. !BuildPTNDiv methodsFor: 'access'!
  35386. setAttribute: aValue 
  35387.     value := '/'! !
  35388.  
  35389. !BuildPTNDiv methodsFor: 'evaluating'!
  35390. doOperation: ignore
  35391.     ^result := self left result // self right result! !
  35392.  
  35393. BuildPTNOperators subclass: #BuildPTNLT
  35394.     instanceVariableNames: ''
  35395.     classVariableNames: ''
  35396.     poolDictionaries: ''
  35397.     category: 'Build-Parsers'!
  35398.  
  35399. !BuildPTNLT methodsFor: 'evaluating'!
  35400. doOperation: ignore
  35401.     ^result := self left result < self right result! !
  35402.  
  35403. BuildPTNOperators subclass: #BuildPTNLTE
  35404.     instanceVariableNames: ''
  35405.     classVariableNames: ''
  35406.     poolDictionaries: ''
  35407.     category: 'Build-Parsers'!
  35408.  
  35409. !BuildPTNLTE methodsFor: 'evaluating'!
  35410. doOperation: ignore
  35411.     ^result := self left result <= self right result! !
  35412.  
  35413. BuildPTNOperators subclass: #BuildPTNAND
  35414.     instanceVariableNames: ''
  35415.     classVariableNames: ''
  35416.     poolDictionaries: ''
  35417.     category: 'Build-Parsers'!
  35418.  
  35419. !BuildPTNAND methodsFor: 'evaluating'!
  35420. doOperation: ignore
  35421.     ^result := self left result & self right result! !
  35422.  
  35423. BuildPTNOperators subclass: #BuildPTNMod
  35424.     instanceVariableNames: ''
  35425.     classVariableNames: ''
  35426.     poolDictionaries: ''
  35427.     category: 'Build-Parsers'!
  35428.  
  35429. !BuildPTNMod methodsFor: 'access'!
  35430. setAttribute: aValue 
  35431.     value := 'mod'! !
  35432.  
  35433. !BuildPTNMod methodsFor: 'evaluating'!
  35434. doOperation: ignore
  35435.     ^result := self left result \\ self right result! !
  35436.  
  35437. BuildPTNOperators subclass: #BuildPTNAdd
  35438.     instanceVariableNames: ''
  35439.     classVariableNames: ''
  35440.     poolDictionaries: ''
  35441.     category: 'Build-Parsers'!
  35442.  
  35443. !BuildPTNAdd methodsFor: 'access'!
  35444. setAttribute: aValue 
  35445.     value := '+'! !
  35446.  
  35447. !BuildPTNAdd methodsFor: 'evaluating'!
  35448. doOperation
  35449.     ^result := leftValue + rightValue! !
  35450.  
  35451. !BuildPTNAdd methodsFor: 'evaluating'!
  35452. doOperation: ignore
  35453.     ^result := self left result + self right result! !
  35454.  
  35455. BuildPTNOperators subclass: #BuildPTNEQ
  35456.     instanceVariableNames: ''
  35457.     classVariableNames: ''
  35458.     poolDictionaries: ''
  35459.     category: 'Build-Parsers'!
  35460.  
  35461. !BuildPTNEQ methodsFor: 'evaluating'!
  35462. doOperation: ignore 
  35463.     ^result := self left result = self right result! !
  35464.  
  35465. BuildPTNOperators subclass: #BuildPTNSub
  35466.     instanceVariableNames: ''
  35467.     classVariableNames: ''
  35468.     poolDictionaries: ''
  35469.     category: 'Build-Parsers'!
  35470.  
  35471. !BuildPTNSub methodsFor: 'access'!
  35472. setAttribute: aValue 
  35473.     value := '-'! !
  35474.  
  35475. !BuildPTNSub methodsFor: 'evaluating'!
  35476. doOperation
  35477.     ^result := leftValue - rightValue! !
  35478.  
  35479. !BuildPTNSub methodsFor: 'evaluating'!
  35480. doOperation: ignore
  35481.     ^result := self left result - self right result! !
  35482.  
  35483. !BuildPTNSub methodsFor: 'evaluating'!
  35484. handleVisitation: aBuildTFExpr 
  35485.     leftValue := self left value.! !
  35486.  
  35487. BuildPTNSub subclass: #BuildPTNUSub
  35488.     instanceVariableNames: ''
  35489.     classVariableNames: ''
  35490.     poolDictionaries: ''
  35491.     category: 'Build-Parsers'!
  35492.  
  35493. !BuildPTNUSub methodsFor: 'access'!
  35494. left
  35495.     ^nil! !
  35496.  
  35497. !BuildPTNUSub methodsFor: 'access'!
  35498. right
  35499.     ^children at: 1! !
  35500.  
  35501. !BuildPTNUSub methodsFor: 'access'!
  35502. setAttribute: aValue 
  35503.     value := '-'! !
  35504.  
  35505. !BuildPTNUSub methodsFor: 'evaluating'!
  35506. doOperation
  35507.     ^-1 * rightValue! !
  35508.  
  35509. !BuildPTNUSub methodsFor: 'evaluating'!
  35510. doOperation: ignore 
  35511.     ^result := -1 * (children at: 1) result! !
  35512.  
  35513. !BuildPTNUSub methodsFor: 'evaluating'!
  35514. handleVisitation: aBuildTFExpr 
  35515.     leftValue := rightValue := aBuildTFExpr lastResult.
  35516.     aBuildTFExpr push; putValue: self! !
  35517.  
  35518. BuildPTNOperators subclass: #BuildPTNGT
  35519.     instanceVariableNames: ''
  35520.     classVariableNames: ''
  35521.     poolDictionaries: ''
  35522.     category: 'Build-Parsers'!
  35523.  
  35524. !BuildPTNGT methodsFor: 'evaluating'!
  35525. doOperation: ignore
  35526.     ^result := self left result > self right result! !
  35527.  
  35528. BuildPTNOperators subclass: #BuildPTNNEQ
  35529.     instanceVariableNames: ''
  35530.     classVariableNames: ''
  35531.     poolDictionaries: ''
  35532.     category: 'Build-Parsers'!
  35533.  
  35534. !BuildPTNNEQ methodsFor: 'evaluating'!
  35535. doOperation: ignore
  35536.     ^result := self left result ~= self right result! !
  35537.  
  35538. BuildPTNOperators subclass: #BuildPTNMul
  35539.     instanceVariableNames: ''
  35540.     classVariableNames: ''
  35541.     poolDictionaries: ''
  35542.     category: 'Build-Parsers'!
  35543.  
  35544. !BuildPTNMul methodsFor: 'access'!
  35545. setAttribute: aValue 
  35546.     value := '*'! !
  35547.  
  35548. !BuildPTNMul methodsFor: 'evaluating'!
  35549. doOperation
  35550.     ^result := leftValue * rightValue! !
  35551.  
  35552. !BuildPTNMul methodsFor: 'evaluating'!
  35553. doOperation: ignore 
  35554.     ^result := self left result * self right result! !
  35555.  
  35556. BuildPTNOperators subclass: #BuildPTNGTE
  35557.     instanceVariableNames: ''
  35558.     classVariableNames: ''
  35559.     poolDictionaries: ''
  35560.     category: 'Build-Parsers'!
  35561.  
  35562. !BuildPTNGTE methodsFor: 'evaluating'!
  35563. doOperation: ignore
  35564.     ^result := self left result >= self right result! !
  35565.  
  35566. BuildBoolParser initialize!
  35567.  
  35568. BuildAEScanner initialize!
  35569.  
  35570. BuildTFParser initialize!
  35571.  
  35572. BuildBoolScanner initialize!
  35573.  
  35574. BuildTFScanner initialize!
  35575.  
  35576. BuildAEParser initialize!
  35577.  
  35578. Model subclass: #EditingWindow
  35579.     instanceVariableNames: 'currentTTM currentList currentActivity editingView pending sourceNode destinationNode chosenTTM displayedActs exposedActs temporary duplicateOption ttmList '
  35580.     classVariableNames: ''
  35581.     poolDictionaries: ''
  35582.     category: 'Build'!
  35583.  
  35584. !EditingWindow methodsFor: 'initialize-release'!
  35585. initialize: ttm from: list 
  35586.     "initialize instance variables."
  35587.  
  35588.     self ttm: ttm.
  35589.     self mynode: self ttm activitytree getRoot.
  35590.     self mylist: list.
  35591.     self source: nil.
  35592.     self destination: nil.
  35593.     self myview: nil.
  35594.     self waitingFor: nil.
  35595.     displayedActs := OrderedCollection new.
  35596.     exposedActs := OrderedCollection new! !
  35597.  
  35598. !EditingWindow methodsFor: 'testing'!
  35599. visibleAllFor: currentTr 
  35600.  
  35601.      ^(self visibleDestFor: currentTr)
  35602.  
  35603.           & (self visibleSourceFor: currentTr)! !
  35604.  
  35605. !EditingWindow methodsFor: 'testing'!
  35606. visibleDestFor: currentTr 
  35607.  
  35608.      | end |
  35609.  
  35610.      end := currentTr endingAt.
  35611.  
  35612.      ^self displayedActs includes: end! !
  35613.  
  35614. !EditingWindow methodsFor: 'testing'!
  35615. visibleSourceFor: currentTr 
  35616.  
  35617.      | start |
  35618.  
  35619.      start := currentTr startingAt.
  35620.  
  35621.      ^self displayedActs includes: start! !
  35622.  
  35623. !EditingWindow methodsFor: 'updating'!
  35624. oldupdateDisplayedActs
  35625.  
  35626.      "DisplayedActs are those activities currently 
  35627.  
  35628.      displayed in the editing view."
  35629.  
  35630.  
  35631.  
  35632.      | child grandchild notdone |
  35633.  
  35634.      displayedActs := OrderedCollection new.
  35635.  
  35636.      child := self mynode left.
  35637.  
  35638.      child notNil ifTrue: [child myBox notNil
  35639.  
  35640.                ifTrue: [notdone := 1]
  35641.  
  35642.                ifFalse: [notdone := 0]].
  35643.  
  35644.      [child notNil & (notdone = 1)]
  35645.  
  35646.           whileTrue: 
  35647.  
  35648.                [displayedActs add: child.
  35649.  
  35650.                child myBox depth = #hidden
  35651.  
  35652.                     ifFalse: 
  35653.  
  35654.                          [grandchild := child left.
  35655.  
  35656.                          [grandchild notNil]
  35657.  
  35658.                               whileTrue: 
  35659.  
  35660.                                    [displayedActs add:
  35661.  
  35662. grandchild.
  35663.  
  35664.                                    grandchild := grandchild
  35665.  
  35666. right]].
  35667.  
  35668.                child := child right.
  35669.  
  35670.                child notNil ifTrue: [child myBox notNil ifFalse:
  35671.  
  35672. [notdone := 0]]]! !
  35673.  
  35674. !EditingWindow methodsFor: 'updating'!
  35675. oldupdateDisplayedTrs
  35676.     "Updates the start, end, and 
  35677.     
  35678.     mid points, and arc styles for the arcs of 
  35679.     
  35680.     the transitions currently displayed."
  35681.  
  35682.     | count trList currentTr m s e start end points askTTM mate box1 box2 |
  35683.     count := 1.
  35684.     trList := self ttm transitionlist.
  35685.     [count > trList size]
  35686.         whileFalse: 
  35687.             [currentTr := trList at: count.
  35688.             m := currentTr myArc sourceMid copy.
  35689.             s := currentTr myArc sourceStart copy.
  35690.             e := currentTr myArc sourceEnd copy.
  35691.             start := currentTr startingAt.
  35692.             end := currentTr endingAt.
  35693.             askTTM := self ttm activitytree.
  35694.             (self visibleSourceFor: currentTr)
  35695.                 ifTrue: [(self visibleDestFor: currentTr)
  35696.                         ifTrue: 
  35697.                             [currentTr myArc sourceStart: s.
  35698.                             currentTr myArc destStart: s.
  35699.                             currentTr myArc sourceMid: m.
  35700.                             currentTr myArc destMid: m.
  35701.                             currentTr myArc sourceEnd: e.
  35702.                             currentTr myArc destEnd: e.
  35703.                             currentTr myArc sourceArrow: 5.
  35704.                             currentTr myArc destArrow: 5]
  35705.                         ifFalse: [(askTTM is: start above: end)
  35706.                                 ifTrue: 
  35707.                                     [mate := askTTM ancestorOf: end onLevelOf: start.
  35708.                                     mate notNil
  35709.                                         ifTrue: 
  35710.                                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  35711.                                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  35712.                                             points := self myview boxPoints: box1 to: box2.
  35713.                                             s := points at: 1.
  35714.                                             e := points at: 2.
  35715.                                             m := s x + e x / 2 @ (s y + e y / 2).
  35716.                                             currentTr myArc sourceStart: s.
  35717.                                             currentTr myArc sourceMid: m.
  35718.                                             currentTr myArc sourceEnd: e.
  35719.                                             currentTr myArc sourceArrow: 2]]
  35720.                                 ifFalse: 
  35721.                                     [mate := askTTM ancestorOf: start onLevelOf: end.
  35722.                                     mate notNil
  35723.                                         ifTrue: 
  35724.                                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  35725.                                             box2 := end myBox dimensions copy moveBy: end myBox location.
  35726.                                             points := self myview boxPoints: box1 to: box2.
  35727.                                             m := points at: 2.
  35728.                                             e := self myview borderPointFrom: s through: m.
  35729.                                             currentTr myArc sourceStart: s.
  35730.                                             currentTr myArc sourceMid: m.
  35731.                                             currentTr myArc sourceEnd: e.
  35732.                                             currentTr myArc sourceArrow: 2]]]]
  35733.                 ifFalse: [(self visibleDestFor: currentTr)
  35734.                         ifTrue: [(askTTM is: start above: end)
  35735.                                 ifTrue: 
  35736.                                     [mate := askTTM ancestorOf: end onLevelOf: start.
  35737.                                     mate notNil
  35738.                                         ifTrue: 
  35739.                                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  35740.                                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  35741.                                             points := self myview boxPoints: box1 to: box2.
  35742.                                             m := points at: 1.
  35743.                                             s := self myview borderPointFrom: e through: m.
  35744.                                             currentTr myArc destStart: s.
  35745.                                             currentTr myArc destMid: m.
  35746.                                             currentTr myArc destEnd: e.
  35747.                                             currentTr myArc destArrow: 5]]
  35748.                                 ifFalse: 
  35749.                                     [mate := askTTM ancestorOf: start onLevelOf: end.
  35750.                                     mate notNil
  35751.                                         ifTrue: 
  35752.                                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  35753.                                             box2 := end myBox dimensions copy moveBy: end myBox location.
  35754.                                             points := self myview boxPoints: box1 to: box2.
  35755.                                             s := points at: 1.
  35756.                                             e := points at: 2.
  35757.                                             m := s x + e x / 2 @ (s y + e y / 2).
  35758.                                             currentTr myArc destStart: s.
  35759.                                             currentTr myArc destMid: m.
  35760.                                             currentTr myArc destEnd: e.
  35761.                                             currentTr myArc destArrow: 4]]]
  35762.                         ifFalse: []].
  35763.             count := count + 1]! !
  35764.  
  35765. !EditingWindow methodsFor: 'updating'!
  35766. readjustPointsFor: currentTr 
  35767.     "This is generally done after the transition has just 
  35768.     
  35769.     been added to the list. In case the source and dest 
  35770.     
  35771.     are not on the same level, we have to set things 
  35772.     
  35773.     right."
  35774.  
  35775.     | m s e start end askTTM mate box1 box2 points news newe newm |
  35776.     m := currentTr myArc sourceMid copy.
  35777.     s := currentTr myArc sourceStart copy.
  35778.     e := currentTr myArc sourceEnd copy.
  35779.     start := currentTr startingAt.
  35780.     end := currentTr endingAt.
  35781.     askTTM := self ttm activitytree.
  35782.     (self visibleAllFor: currentTr)
  35783.         ifTrue: 
  35784.             [currentTr myArc sourceStart: s.
  35785.             currentTr myArc destStart: s.
  35786.             currentTr myArc sourceMid: m.
  35787.             currentTr myArc destMid: m.
  35788.             currentTr myArc sourceEnd: e.
  35789.             currentTr myArc destEnd: e.
  35790.             currentTr myArc sourceArrow: 5.
  35791.             currentTr myArc destArrow: 5]
  35792.         ifFalse: [(askTTM is: start above: end)
  35793.                 ifTrue: 
  35794.                     [mate := askTTM ancestorOf: end onLevelOf: start.
  35795.                     mate notNil
  35796.                         ifTrue: 
  35797.                             [box1 := start myBox dimensions copy moveBy: start myBox location.
  35798.                             box2 := mate myBox dimensions copy moveBy: mate myBox location.
  35799.                             points := self myview boxPoints: box1 to: box2.
  35800.                             news := points at: 1.
  35801.                             newe := points at: 2.
  35802.                             newm := self myview midPointOf: news and: newe.
  35803.                             currentTr myArc sourceStart: news.
  35804.                             currentTr myArc sourceMid: newm.
  35805.                             currentTr myArc sourceEnd: newe.
  35806.                             currentTr myArc sourceArrow: 2.
  35807.                             points := self myview boxPoints: box1 to: box2.
  35808.                             newm := points at: 1.
  35809.                             newe := e.
  35810.                             news := self myview borderPointFrom: newe through: newm.
  35811.                             currentTr myArc destStart: news.
  35812.                             currentTr myArc destMid: newm.
  35813.                             currentTr myArc destEnd: newe.
  35814.                             currentTr myArc destArrow: 5]
  35815.                         ifFalse: []]
  35816.                 ifFalse: 
  35817.                     [mate := askTTM ancestorOf: start onLevelOf: end.
  35818.                     mate notNil
  35819.                         ifTrue: 
  35820.                             [box1 := mate myBox dimensions copy moveBy: mate myBox location.
  35821.                             box2 := end myBox dimensions copy moveBy: end myBox location.
  35822.                             points := self myview boxPoints: box1 to: box2.
  35823.                             newm := points at: 2.
  35824.                             news := s.
  35825.                             newe := self myview borderPointFrom: news through: newm.
  35826.                             currentTr myArc sourceStart: news.
  35827.                             currentTr myArc sourceMid: newm.
  35828.                             currentTr myArc sourceEnd: newe.
  35829.                             currentTr myArc sourceArrow: 2.
  35830.                             news := points at: 1.
  35831.                             newe := points at: 2.
  35832.                             newm := self myview midPointOf: news and: newe.
  35833.                             currentTr myArc destStart: news.
  35834.                             currentTr myArc destMid: newm.
  35835.                             currentTr myArc destEnd: newe.
  35836.                             currentTr myArc destArrow: 4]
  35837.                         ifFalse: []]]! !
  35838.  
  35839. !EditingWindow methodsFor: 'updating'!
  35840. updateDisplayedActs
  35841.  
  35842.      "DisplayedActs are those activities currently 
  35843.  
  35844.      displayed in the editing view."
  35845.  
  35846.  
  35847.  
  35848.      | child |
  35849.  
  35850.      displayedActs := OrderedCollection new.
  35851.  
  35852.      child := self mynode left.
  35853.  
  35854.      [child notNil]
  35855.  
  35856.           whileTrue: 
  35857.  
  35858.                [displayedActs add: child.
  35859.  
  35860.                child := child right]! !
  35861.  
  35862. !EditingWindow methodsFor: 'accessing'!
  35863. destination
  35864.  
  35865.      ^destinationNode! !
  35866.  
  35867. !EditingWindow methodsFor: 'accessing'!
  35868. destination: newDestination 
  35869.  
  35870.      destinationNode := newDestination! !
  35871.  
  35872. !EditingWindow methodsFor: 'accessing'!
  35873. displayedActs
  35874.  
  35875.      ^displayedActs! !
  35876.  
  35877. !EditingWindow methodsFor: 'accessing'!
  35878. duplicateOption
  35879.  
  35880.      ^duplicateOption! !
  35881.  
  35882. !EditingWindow methodsFor: 'accessing'!
  35883. duplicateOption: newOption
  35884.  
  35885.      duplicateOption := newOption! !
  35886.  
  35887. !EditingWindow methodsFor: 'accessing'!
  35888. exposedActs
  35889.  
  35890.      ^exposedActs! !
  35891.  
  35892. !EditingWindow methodsFor: 'accessing'!
  35893. mylist
  35894.  
  35895.      ^currentList! !
  35896.  
  35897. !EditingWindow methodsFor: 'accessing'!
  35898. mylist: newList 
  35899.  
  35900.      currentList := newList! !
  35901.  
  35902. !EditingWindow methodsFor: 'accessing'!
  35903. mynode
  35904.  
  35905.      ^currentActivity! !
  35906.  
  35907. !EditingWindow methodsFor: 'accessing'!
  35908. mynode: newActivity
  35909.  
  35910.      currentActivity := newActivity! !
  35911.  
  35912. !EditingWindow methodsFor: 'accessing'!
  35913. myview
  35914.  
  35915.      ^editingView! !
  35916.  
  35917. !EditingWindow methodsFor: 'accessing'!
  35918. myview: theView 
  35919.  
  35920.      editingView := theView! !
  35921.  
  35922. !EditingWindow methodsFor: 'accessing'!
  35923. source
  35924.  
  35925.      ^sourceNode! !
  35926.  
  35927. !EditingWindow methodsFor: 'accessing'!
  35928. source: newSource
  35929.  
  35930.      sourceNode := newSource! !
  35931.  
  35932. !EditingWindow methodsFor: 'accessing'!
  35933. ttm
  35934.  
  35935.      ^currentTTM! !
  35936.  
  35937. !EditingWindow methodsFor: 'accessing'!
  35938. ttm: newTTM
  35939.  
  35940.      currentTTM := newTTM! !
  35941.  
  35942. !EditingWindow methodsFor: 'accessing'!
  35943. ttmChosen
  35944.  
  35945.      ^chosenTTM! !
  35946.  
  35947. !EditingWindow methodsFor: 'accessing'!
  35948. ttmChosen: newChoice 
  35949.  
  35950.      chosenTTM := newChoice! !
  35951.  
  35952. !EditingWindow methodsFor: 'accessing'!
  35953. waitingFor
  35954.  
  35955.      ^pending! !
  35956.  
  35957. !EditingWindow methodsFor: 'accessing'!
  35958. waitingFor: newReason 
  35959.  
  35960.      pending := newReason! !
  35961.  
  35962. !EditingWindow methodsFor: 'button access'!
  35963. doCancel
  35964.     self source: nil.
  35965.     self destination: nil.
  35966.     self waitingFor: nil.
  35967.     self myview pending! !
  35968.  
  35969. !EditingWindow methodsFor: 'button access'!
  35970. doChangeDepth: depthType for: objectType 
  35971.     | children count current trs c |
  35972.     objectType = #act
  35973.         ifTrue: 
  35974.             ["TTMList speak: 'This feature is not yet implemented.', (String 
  35975.             with: 
  35976.             
  35977.             Character cr), 'Sorry for the inconvenience.'."
  35978.             children := self ttm activitytree listChildrenOf: self mynode.
  35979.             children removeFirst.
  35980.             count := 1.
  35981.             [count > children size]
  35982.                 whileFalse: 
  35983.                     [(children at: count) myBox depth: depthType.
  35984.                     count := count + 1].
  35985.             self myview displayOn: #dummy].
  35986.     objectType = #tr
  35987.         ifTrue: 
  35988.             [children := self ttm activitytree listChildrenOf: self mynode.
  35989.             children removeFirst.
  35990.             count := 1.
  35991.             [count > children size]
  35992.                 whileFalse: 
  35993.                     [current := children at: count.
  35994.                     trs := self ttm transitionlist TransitionsStartingAt: current.
  35995.                     c := 1.
  35996.                     [c > trs size]
  35997.                         whileFalse: 
  35998.                             [(trs at: c)
  35999.                                 depth: depthType.
  36000.                             c := c + 1].
  36001.                     trs := self ttm transitionlist TransitionsEndingAt: current.
  36002.                     c := 1.
  36003.                     [c > trs size]
  36004.                         whileFalse: 
  36005.                             [(trs at: c)
  36006.                                 depth: depthType.
  36007.                             c := c + 1].
  36008.                     count := count + 1].
  36009.             self myview displayOn: #dummy]! !
  36010.  
  36011. !EditingWindow methodsFor: 'button access'!
  36012. doCompose
  36013.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize temporary2 top2 labels2 |
  36014.     labels := self mylist ttmList.
  36015.     labels remove: self ttm named ifAbsent: [].
  36016.     self waitingFor = nil & (labels size > 0)
  36017.         ifTrue: 
  36018.             [prompt := 'Compose TTMs'.
  36019.             window := ScheduledWindow
  36020.                         model: nil
  36021.                         label: prompt
  36022.                         minimumSize: 300 @ 250.
  36023.             top := DialogView new.
  36024.             top2 := DialogView new.
  36025.             container := CompositePart new.
  36026.             temporary := OrderedCollection new.
  36027.             temporary add: nil; add: (Array with: nil with: nil).
  36028.             labels2 := Array with: 'duplicate variables shared' "with: 'duplicate transitions shared' ".
  36029.             topCorner := 0.1.
  36030.             hsize := 0.2.
  36031.             vsize := 0.15.
  36032.             okButton := PushButton named: 'accept'.
  36033.             okButton model: ((PluggableAdaptor on: self)
  36034.                     getBlock: [:model | false]
  36035.                     putBlock: [:model :value | model doRunCompose]
  36036.                     updateBlock: [:model :value :parameter | false]).
  36037.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  36038.                 borderColor: ColorValue black;
  36039.                 borderWidth: 1.
  36040.             notokButton := PushButton named: 'exit'.
  36041.             notokButton model: ((PluggableAdaptor on: self)
  36042.                     getBlock: [:model | false]
  36043.                     putBlock: [:model :value | ScheduledControllers activeController close]
  36044.                     updateBlock: [:model :value :parameter | false]).
  36045.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  36046.                 borderColor: ColorValue black;
  36047.                 borderWidth: 1.
  36048.             temporary at: 2 put: ((1 to: labels2 size)
  36049.                     collect: [:i | ValueHolder newBoolean]).
  36050.             top2 leftIndent: 70; rightIndent: 300; yPosition: 70;
  36051.                 addColumn: (1 to: (temporary at: 2) size)
  36052.                 fromX: 0
  36053.                 toX: 1
  36054.                 collect: 
  36055.                     [:i | 
  36056.                     | view |
  36057.                     view := LabeledBooleanView model: ((temporary at: 2)
  36058.                                     at: i).
  36059.                     view beRadioButton.
  36060.                     view controller beToggle.
  36061.                     view label: (labels2 at: i).
  36062.                     BorderedWrapper on: view].
  36063.             container add: top2.
  36064.             temporary2 := (1 to: labels size)
  36065.                         collect: [:i | ValueHolder newBoolean].
  36066.             temporary at: 1 put: (ValueHolder with: 1).
  36067.             top leftIndent: 70; rightIndent: 300; yPosition: 120;
  36068.                 addColumn: (1 to: temporary2 size)
  36069.                 fromX: 0
  36070.                 toX: 1
  36071.                 collect: 
  36072.                     [:i | 
  36073.                     | view |
  36074.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 1))
  36075.                                     selectValue: i).
  36076.                     view beSwitch.
  36077.                     view controller beToggle.
  36078.                     view label: (labels at: i).
  36079.                     BorderedWrapper on: view].
  36080.             container add: top.
  36081.             bigSize := top preferredBounds extent copy.
  36082.             bigSize y: bigSize y + 20.
  36083.             window component: container.
  36084.             window openWithExtent: bigSize]! !
  36085.  
  36086. !EditingWindow methodsFor: 'button access'!
  36087. doHierarchy
  36088.     | current aList ancestors selected chosen count |
  36089.     self waitingFor isNil ifFalse: [self waitingFor = #addTransition | (self waitingFor = #changeDestination) ifFalse: [^self]].
  36090.     current := self mynode.
  36091.     aList := OrderedCollection new.
  36092.     ancestors := 0.
  36093.     [current notNil]
  36094.         whileTrue: 
  36095.             [aList addFirst: current myName.
  36096.             ancestors := ancestors + 1.
  36097.             current := self ttm activitytree parentOf: current].
  36098.     selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  36099.     selected = 0
  36100.         ifFalse: 
  36101.             [chosen := ancestors - selected.
  36102.             chosen = 0
  36103.                 ifFalse: 
  36104.                     [count := 0.
  36105.                     current := self mynode.
  36106.                     [count ~= chosen]
  36107.                         whileTrue: 
  36108.                             [current := self ttm activitytree parentOf: current.
  36109.                             count := count + 1].
  36110.                     self mynode: current.
  36111.                     self myview displayOn: #dummy]]! !
  36112.  
  36113. !EditingWindow methodsFor: 'button access'!
  36114. doInsertTTM
  36115.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize temporary2 top2 labels2 top3 labels3 temporary3 |
  36116.     labels := self mylist ttmList.
  36117.     labels remove: self ttm named ifAbsent: [].
  36118.     self waitingFor = nil & (labels size > 0)
  36119.         ifTrue: 
  36120.             [prompt := 'Insert TTMs'.
  36121.             window := ScheduledWindow
  36122.                         model: nil
  36123.                         label: prompt
  36124.                         minimumSize: 300 @ 300.
  36125.             top := DialogView new.
  36126.             top2 := DialogView new.
  36127.             top3 := DialogView new.
  36128.             container := CompositePart new.
  36129.             temporary := OrderedCollection new.
  36130.             temporary add: nil; add: (Array with: nil with: nil); add: nil.
  36131.             labels2 := Array with: 'duplicate variables shared' "with: 'duplicate transitions shared'".
  36132.             labels3 := Array with: 'insert sequentially' with: 'insert concurrently'.
  36133.             topCorner := 0.1.
  36134.             hsize := 0.2.
  36135.             vsize := 0.15.
  36136.             okButton := PushButton named: 'accept'.
  36137.             okButton model: ((PluggableAdaptor on: self)
  36138.                     getBlock: [:model | false]
  36139.                     putBlock: [:model :value | model doRunInsertTTM]
  36140.                     updateBlock: [:model :value :parameter | false]).
  36141.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  36142.                 borderColor: ColorValue black;
  36143.                 borderWidth: 1.
  36144.             notokButton := PushButton named: 'exit'.
  36145.             notokButton model: ((PluggableAdaptor on: self)
  36146.                     getBlock: [:model | false]
  36147.                     putBlock: [:model :value | ScheduledControllers activeController close]
  36148.                     updateBlock: [:model :value :parameter | false]).
  36149.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  36150.                 borderColor: ColorValue black;
  36151.                 borderWidth: 1.
  36152.             temporary at: 2 put: ((1 to: labels2 size)
  36153.                     collect: [:i | ValueHolder newBoolean]).
  36154.             top2 leftIndent: 70; rightIndent: 300; yPosition: 90;
  36155.                 addColumn: (1 to: (temporary at: 2) size)
  36156.                 fromX: 0
  36157.                 toX: 1
  36158.                 collect: 
  36159.                     [:i | 
  36160.                     | view |
  36161.                     view := LabeledBooleanView model: ((temporary at: 2)
  36162.                                     at: i).
  36163.                     view beRadioButton.
  36164.                     view controller beToggle.
  36165.                     view label: (labels2 at: i).
  36166.                     BorderedWrapper on: view].
  36167.             container add: top2.
  36168.             "temporary3 := (1 to: labels3 size)
  36169.                         collect: [:i | ValueHolder newBoolean].
  36170.             temporary at: 3 put: (ValueHolder with: 1).
  36171.             top3 leftIndent: 70; rightIndent: 300; yPosition: 120;
  36172.                 addColumn: (1 to: temporary3 size)
  36173.                 fromX: 0
  36174.                 toX: 1
  36175.                 collect: 
  36176.                     [:i | 
  36177.                     | view |
  36178.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 3))
  36179.                                     selectValue: i).
  36180.                     view beRadioButton.
  36181.                     view controller beToggle.
  36182.                     view label: (labels3 at: i).
  36183.                     BorderedWrapper on: view].
  36184.             container add: top3."
  36185.             temporary2 := (1 to: labels size)
  36186.                         collect: [:i | ValueHolder newBoolean].
  36187.             temporary at: 1 put: (ValueHolder with: 1).
  36188.             top leftIndent: 70; rightIndent: 300; yPosition: 170;
  36189.                 addColumn: (1 to: temporary2 size)
  36190.                 fromX: 0
  36191.                 toX: 1
  36192.                 collect: 
  36193.                     [:i | 
  36194.                     | view |
  36195.                     view := LabeledBooleanView model: ((PluggableAdaptor on: (temporary at: 1))
  36196.                                     selectValue: i).
  36197.                     view beSwitch.
  36198.                     view controller beToggle.
  36199.                     view label: (labels at: i).
  36200.                     BorderedWrapper on: view].
  36201.             container add: top.
  36202.             bigSize := top preferredBounds extent copy.
  36203.             bigSize y: bigSize y + 20.
  36204.             window component: container.
  36205.             window openWithExtent: bigSize]! !
  36206.  
  36207. !EditingWindow methodsFor: 'button access'!
  36208. doWaitForUser: waitType check: checkType 
  36209.     "checkType = 1 means we cant be waiting for anything already. 
  36210.     checkType = 2 
  36211.     
  36212.     means above and there must be an activity at this level."
  36213.  
  36214.     | valid |
  36215.     valid := false.
  36216.     checkType = 1 ifTrue: [valid := self waitingFor = nil].
  36217.     checkType = 2 ifTrue: [valid := self waitingFor = nil & self mynode left notNil].
  36218.     valid = true
  36219.         ifTrue: 
  36220.             [self waitingFor: waitType.
  36221.             self myview pending]! !
  36222.  
  36223. !EditingWindow methodsFor: 'button access'!
  36224. doZoomout
  36225.     "Zoom out i.e. move up the activity tree."
  36226.  
  36227.     | father |
  36228.     self waitingFor isNil ifFalse: [self waitingFor = #addTransition | (self waitingFor = #changeDestination | (self waitingFor = #addTransition1)) ifFalse: [^nil]].
  36229.     (self ttm activitytree isRoot: currentActivity)
  36230.         ifTrue: []
  36231.         ifFalse: 
  36232.             [father := self ttm activitytree parentOf: currentActivity.
  36233.             father isNil
  36234.                 ifTrue: []
  36235.                 ifFalse: 
  36236.                     [self mynode: father.
  36237.                     self myview notNil ifTrue: [self myview displayOn: #dummy]]]! !
  36238.  
  36239. !EditingWindow methodsFor: 'composition'!
  36240. doRunCompose
  36241.     | count listOfTTMs listOfNames index choice restrict ttmIndex userOption |
  36242.     ttmIndex := (temporary at: 1) value.
  36243.     ttmIndex isNil
  36244.         ifTrue: 
  36245.             [self ttmChosen: nil.
  36246.             ^nil].
  36247.     userOption := OrderedCollection new.
  36248.     ((temporary at: 2)
  36249.         at: 1) value = true
  36250.         ifTrue: [userOption add: #ALL]
  36251.         ifFalse: [userOption add: #NONE].
  36252.     "((temporary at: 2)
  36253.         at: 2) value = true
  36254.         ifTrue: [userOption add: #ALL]
  36255.         ifFalse: [userOption add: #NONE]."
  36256.     self duplicateOption: userOption.
  36257.     listOfTTMs := self mylist realTTMList.
  36258.     listOfNames := self mylist ttmList.
  36259.     listOfNames remove: self ttm named ifAbsent: [].
  36260.     count := 1.
  36261.     [count > listOfTTMs size]
  36262.         whileFalse: 
  36263.             [(listOfNames at: ttmIndex)
  36264.                 = (listOfTTMs at: count) named
  36265.                 ifTrue: 
  36266.                     [choice := listOfTTMs at: count.
  36267.                     count := listOfTTMs size].
  36268.             count := count + 1].
  36269.     (Delay forSeconds: 0.1) wait.
  36270.     choice activitytree listOfActivities do: [:x | x exposedAncestor: nil].    "*************"
  36271.     choice saveNecessarySelfReferences: currentList.
  36272.     self ttmChosen: choice aCopy.
  36273.     choice restoreNecessarySelfReferences: currentList.    "Need to reassess behaviour of following code"
  36274.     "restrict := 1. self mynode collectionType ~= #cluster ifTrue: [index := 1] 
  36275.     ifFalse: 
  36276.     
  36277.     [self mynode left isNil ifTrue: [restrict := 2] ifFalse: [self mynode left right 
  36278.     notNil 
  36279.     
  36280.     ifTrue: [restrict := 2]]. restrict = 2 ifTrue: [index := 2] ifFalse: [index := 1]]."
  36281.     index := 1.
  36282.     index = 1
  36283.         ifTrue: 
  36284.             [self waitingFor: #inConcurrently.
  36285.             self myview pending].
  36286.     index = 2
  36287.         ifTrue: 
  36288.             [self waitingFor: #inSerially.
  36289.             self myview pending]! !
  36290.  
  36291. !EditingWindow methodsFor: 'composition'!
  36292. doRunInsertTTM
  36293.     | listOfTTMs index listOfNames count choice restrict ttmIndex userOption insertType |
  36294.     ttmIndex := (temporary at: 1) value.
  36295.     ttmIndex isNil
  36296.         ifTrue: 
  36297.             [self ttmChosen: nil.
  36298.             ^nil].
  36299.     userOption := OrderedCollection new.
  36300.     ((temporary at: 2)
  36301.         at: 1) value = true
  36302.         ifTrue: [userOption add: #ALL]
  36303.         ifFalse: [userOption add: #NONE].
  36304.       userOption add: #ALL.
  36305.     "((temporary at: 2)
  36306.         at: 2) value = true
  36307.         ifTrue: [userOption add: #ALL]
  36308.         ifFalse: [userOption add: #NONE]."
  36309.     self duplicateOption: userOption.
  36310.     insertType := 1.
  36311.     insertType isNil
  36312.         ifTrue: 
  36313.             [self ttmChosen: nil.
  36314.             ^nil].
  36315.     listOfTTMs := self mylist realTTMList.
  36316.     listOfNames := self mylist ttmList.
  36317.     listOfNames remove: self ttm named ifAbsent: [].
  36318.     count := 1.
  36319.     [count > listOfTTMs size]
  36320.         whileFalse: 
  36321.             [(listOfNames at: ttmIndex)
  36322.                 = (listOfTTMs at: count) named
  36323.                 ifTrue: 
  36324.                     [choice := listOfTTMs at: count.
  36325.                     count := listOfTTMs size].
  36326.             count := count + 1].
  36327.     (Delay forSeconds: 0.1) wait.
  36328.     choice activitytree listOfActivities do: [:x | x exposedAncestor: nil].
  36329.     self ttmChosen: choice aCopy.
  36330.     restrict := 1.
  36331.     self mynode collectionType ~= #cluster
  36332.         ifTrue: [insertType = 1
  36333.                 ifTrue: [index := 3]
  36334.                 ifFalse: [index := 2]]
  36335.         ifFalse: 
  36336.             [self mynode left isNil
  36337.                 ifTrue: [restrict := 2]
  36338.                 ifFalse: [self mynode left right notNil ifTrue: [restrict := 2]].
  36339.             restrict = 2
  36340.                 ifTrue: [insertType = 2
  36341.                         ifTrue: [index := 3]
  36342.                         ifFalse: [index := 1]]
  36343.                 ifFalse: [index := insertType]].
  36344.     index = 2
  36345.         ifTrue: 
  36346.             [self waitingFor: #inConcurrently.
  36347.             self myview pending].
  36348.     index = 1
  36349.         ifTrue: 
  36350.             [self waitingFor: #inSerially.
  36351.             self myview pending].
  36352.     index = 3 ifTrue: [self ttmChosen: nil]! !
  36353.  
  36354. !EditingWindow methodsFor: 'closing'!
  36355. removeDependent: aDependent 
  36356.  
  36357.     currentTTM openWindows at: 2 put: 0.
  36358.  
  36359.     super removeDependent: aDependent! !
  36360.  
  36361. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  36362.  
  36363. EditingWindow class
  36364.     instanceVariableNames: ''!
  36365.  
  36366. !EditingWindow class methodsFor: 'instance creation'!
  36367. new: ttm from: list 
  36368.     "Create a TTMWindow and initialize it."
  36369.  
  36370.     ^super new initialize: ttm from: list! !
  36371.  
  36372. !EditingWindow class methodsFor: 'instance creation'!
  36373. open: currentTTM from: list 
  36374.     "Create a new TTMWindow and open a view on it."
  36375.     "TTMWindow open: currentTTM"
  36376.  
  36377.     self open: (self new: currentTTM from: list)
  36378.         with: currentTTM! !
  36379.  
  36380. !EditingWindow class methodsFor: 'instance creation'!
  36381. open: aTTMWindow with: currentTTM 
  36382.     "Create an instance of a TTM editing window for the 
  36383.     
  36384.     current TTM."
  36385.  
  36386.     | window container zoButton addAButton hButton ttmView inButton windowLabel down up left size heButton buttonColor boardColor hspace vspace ziButton addTButton caButton defButton qButton expAButton expTButton hidAButton hidTButton comButton |
  36387.     up := 0.
  36388.     down := 0.04.
  36389.     left := 0.
  36390.     size := 0.2.
  36391.     hspace := 0.2.
  36392.     vspace := 0.04.
  36393.     window := ScheduledWindow new.
  36394.     windowLabel := 'Editing TTM: ' , currentTTM named.
  36395.     window label: windowLabel.
  36396.     window minimumSize: 500 @ 500.
  36397.     window insideColor: ColorValue lightGray.
  36398.     buttonColor := ColorValue white.
  36399.     boardColor := ColorValue lightGray.
  36400.     container := CompositePart new.    "Button for zooming in -- going down the tree"
  36401.     ziButton := PushButton named: 'Zoom In'.
  36402.     ziButton model: ((PluggableAdaptor on: aTTMWindow)
  36403.             getBlock: [:model | false]
  36404.             putBlock: [:model :value | model doWaitForUser: #zoomin check: 2]
  36405.             updateBlock: [:model :value :parameter | false]).
  36406.     (container add: ziButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36407.         insideColor: buttonColor.
  36408.     left := left + hspace.    "Button for add Activity"
  36409.     addAButton := PushButton named: 'Add Activity'.
  36410.     addAButton model: ((PluggableAdaptor on: aTTMWindow)
  36411.             getBlock: [:model | false]
  36412.             putBlock: [:model :value | model doWaitForUser: #addActivity check: 1]
  36413.             updateBlock: [:model :value :parameter | false]).
  36414.     (container add: addAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36415.         insideColor: buttonColor.
  36416.     left := left + hspace.    "Button for add Transition"
  36417.     addTButton := PushButton named: 'Add Transition'.
  36418.     addTButton model: ((PluggableAdaptor on: aTTMWindow)
  36419.             getBlock: [:model | false]
  36420.             putBlock: [:model :value | model doWaitForUser: #addTransition1 check: 1]
  36421.             updateBlock: [:model :value :parameter | false]).
  36422.     (container add: addTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36423.         insideColor: buttonColor.
  36424.     left := left + hspace.    "Button for insert a TTM as an Activity"
  36425.     inButton := PushButton named: 'XOR TTMs'.
  36426.     inButton model: ((PluggableAdaptor on: aTTMWindow)
  36427.             getBlock: [:model | false]
  36428.             putBlock: [:model :value | model doInsertTTM]
  36429.             updateBlock: [:model :value :parameter | false]).
  36430.     (container add: inButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36431.         insideColor: buttonColor.
  36432.     left := left + hspace.    "Button for cancelling selected option"
  36433.     caButton := PushButton named: 'Cancel'.
  36434.     caButton model: ((PluggableAdaptor on: aTTMWindow)
  36435.             getBlock: [:model | false]
  36436.             putBlock: [:model :value | model doCancel]
  36437.             updateBlock: [:model :value :parameter | false]).
  36438.     (container add: caButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36439.         insideColor: buttonColor.
  36440.     left := 0.
  36441.     up := up + vspace.
  36442.     down := down + vspace.    "Button for zooming out -- going up the tree"
  36443.     zoButton := PushButton named: 'Zoom Out'.
  36444.     zoButton model: ((PluggableAdaptor on: aTTMWindow)
  36445.             getBlock: [:model | false]
  36446.             putBlock: [:model :value | model doZoomout]
  36447.             updateBlock: [:model :value :parameter | false]).
  36448.     (container add: zoButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36449.         insideColor: buttonColor.
  36450.     left := left + hspace.    "Button for exposing all activities"
  36451.     expAButton := PushButton named: 'Expose Acts.'.
  36452.     expAButton model: ((PluggableAdaptor on: aTTMWindow)
  36453.             getBlock: [:model | false]
  36454.             putBlock: [:model :value | model doChangeDepth: #exposed for: #act]
  36455.             updateBlock: [:model :value :parameter | false]).
  36456.     (container add: expAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36457.         insideColor: buttonColor.
  36458.     left := left + hspace.    "Button for exposing all Transitions"
  36459.     expTButton := PushButton named: 'Expose Trans.'.
  36460.     expTButton model: ((PluggableAdaptor on: aTTMWindow)
  36461.             getBlock: [:model | false]
  36462.             putBlock: [:model :value | model doChangeDepth: #exposed for: #tr]
  36463.             updateBlock: [:model :value :parameter | false]).
  36464.     (container add: expTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36465.         insideColor: buttonColor.
  36466.     left := left + hspace.    "Button for composing TTMs - a subset of insertion"
  36467.     comButton := PushButton named: 'AND TTMs'.
  36468.     comButton model: ((PluggableAdaptor on: aTTMWindow)
  36469.             getBlock: [:model | false]
  36470.             putBlock: [:model :value | model doCompose]
  36471.             updateBlock: [:model :value :parameter | false]).
  36472.     (container add: comButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36473.         insideColor: buttonColor.
  36474.     left := left + hspace.    "Button for getting help on this editing window stuff"
  36475.     heButton := PushButton named: 'Help' asText allBold.
  36476.     heButton model: ((PluggableAdaptor on: aTTMWindow)
  36477.             getBlock: [:model | false]
  36478.             putBlock: [:model :value | HelpScreens openHelp: 'editing']
  36479.             updateBlock: [:model :value :parameter | false]).
  36480.     (container add: heButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36481.         insideColor: buttonColor.
  36482.     left := 0.
  36483.     up := up + vspace.
  36484.     down := down + vspace.    "Button for showing hierarchy of current TTM"
  36485.     hButton := PushButton named: 'Hierarchy'.
  36486.     hButton model: ((PluggableAdaptor on: aTTMWindow)
  36487.             getBlock: [:model | false]
  36488.             putBlock: [:model :value | model doHierarchy]
  36489.             updateBlock: [:model :value :parameter | false]).
  36490.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36491.         insideColor: buttonColor.
  36492.     left := left + hspace.    "Button for hiding all Activities"
  36493.     hidAButton := PushButton named: 'Hide Acts.'.
  36494.     hidAButton model: ((PluggableAdaptor on: aTTMWindow)
  36495.             getBlock: [:model | false]
  36496.             putBlock: [:model :value | model doChangeDepth: #hidden for: #act]
  36497.             updateBlock: [:model :value :parameter | false]).
  36498.     (container add: hidAButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36499.         insideColor: buttonColor.
  36500.     left := left + hspace.    "Button for hiding all Transitions"
  36501.     hidTButton := PushButton named: 'Hide Trans.'.
  36502.     hidTButton model: ((PluggableAdaptor on: aTTMWindow)
  36503.             getBlock: [:model | false]
  36504.             putBlock: [:model :value | model doChangeDepth: #hidden for: #tr]
  36505.             updateBlock: [:model :value :parameter | false]).
  36506.     (container add: hidTButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36507.         insideColor: buttonColor.
  36508.     left := left + hspace.    "Button for setting default for this activity"
  36509.     defButton := PushButton named: 'Reset Default'.
  36510.     defButton model: ((PluggableAdaptor on: aTTMWindow)
  36511.             getBlock: [:model | false]
  36512.             putBlock: [:model :value | model doWaitForUser: #setDefault check: 2]
  36513.             updateBlock: [:model :value :parameter | false]).
  36514.     (container add: defButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36515.         insideColor: buttonColor.
  36516.     left := left + hspace.    "Button for quitting"
  36517.     qButton := PushButton named: 'Exit'.
  36518.     qButton model: ((PluggableAdaptor on: aTTMWindow)
  36519.             getBlock: [:model | false]
  36520.             putBlock: [:model :value | TTMList closeWindow: 2 in: currentTTM]
  36521.             updateBlock: [:model :value :parameter | false]).
  36522.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + size; bottomFraction: down))
  36523.         insideColor: buttonColor.
  36524.     left := left + hspace.    "Drawing Board for TTM"
  36525.     ttmView := EditingView model: aTTMWindow.
  36526.     ttmView aspect: #currentTTM.
  36527. (ttmView controller) ttmList: aTTMWindow mylist.
  36528.     (ttmView controller) currentTTM: currentTTM.
  36529.     (container add: ttmView borderedIn: (0 @ 0.12 extent: 1.0 @ 0.88))
  36530.         insideColor: boardColor.
  36531.     window component: container.
  36532.     window open! !
  36533.  
  36534. Object subclass: #Incrementer
  36535.     instanceVariableNames: 'position maximumSize aString '
  36536.     classVariableNames: ''
  36537.     poolDictionaries: ''
  36538.     category: 'Build'!
  36539.  
  36540. !Incrementer methodsFor: 'accessing'!
  36541. currentLetter
  36542.  
  36543.      position > maximumSize
  36544.  
  36545.           ifTrue: [^$@]
  36546.  
  36547.           ifFalse: [^aString at: position]! !
  36548.  
  36549. !Incrementer methodsFor: 'accessing'!
  36550. currentPosition
  36551.  
  36552.      ^position! !
  36553.  
  36554. !Incrementer methodsFor: 'accessing'!
  36555. newPosition: value
  36556.  
  36557.      position := value! !
  36558.  
  36559. !Incrementer methodsFor: 'accessing'!
  36560. nextLetter
  36561.  
  36562.      position := position + 1.
  36563.  
  36564.      position > maximumSize
  36565.  
  36566.           ifTrue: [^$@]
  36567.  
  36568.           ifFalse: [^aString at: position]! !
  36569.  
  36570. !Incrementer methodsFor: 'initialize'!
  36571. startWith: whatever 
  36572.  
  36573.      aString := whatever.
  36574.  
  36575.      maximumSize := aString size.
  36576.  
  36577.      position := 1! !
  36578.  
  36579. FileBrowser subclass: #FileList
  36580.     instanceVariableNames: 'currentDirectory filenameObject aTTMList '
  36581.     classVariableNames: 'FileMenuFL TextMenuFL '
  36582.     poolDictionaries: ''
  36583.     category: 'Build'!
  36584.  
  36585. !FileList methodsFor: 'variable access'!
  36586. aTTMList: tL 
  36587.     aTTMList := tL! !
  36588.  
  36589. !FileList methodsFor: 'variable access'!
  36590. currentDirectory
  36591.     ^currentDirectory! !
  36592.  
  36593. !FileList methodsFor: 'variable access'!
  36594. currentDirectory: aDirectory 
  36595.     currentDirectory := aDirectory! !
  36596.  
  36597. !FileList methodsFor: 'file name list'!
  36598. addFile! !
  36599.  
  36600. !FileList methodsFor: 'file name list'!
  36601. addSubDir! !
  36602.  
  36603. !FileList methodsFor: 'file name list'!
  36604. directoryPattern
  36605.     "Set the pattern to be the path to the selected directory."
  36606.  
  36607.     | newPattern |
  36608.     newPattern := fileName.
  36609.     newPattern == nil 
  36610.         ifFalse: [self pattern: (newPattern asFilename constructString: '*') asString.
  36611.                 self changed: #pattern.
  36612.                 self acceptPattern: self pattern asText from: nil]! !
  36613.  
  36614. !FileList methodsFor: 'file name list'!
  36615. fileListMenu
  36616.  
  36617.      "Answer the menu."
  36618.  
  36619.  
  36620.  
  36621.      "Evaluate this when you change this method:
  36622.  
  36623.           FileBrowser flushMenus"
  36624.  
  36625.       "^nil"
  36626.  
  36627.      "fileName == nil
  36628.  
  36629.           ifTrue: [^PopUpMenu
  36630.  
  36631.                          labels: 'make directory' withCRs
  36632.  
  36633.                          lines: #()
  36634.  
  36635.                          values: #(makeDir)]."
  36636.  
  36637.  
  36638.  
  36639.      "If fileName exists and is a directory, return a special
  36640.  
  36641. menu"
  36642.  
  36643.      selectionState = #directory
  36644.  
  36645.           ifTrue: [^PopUpMenu
  36646.  
  36647.                          labels: 'new pattern' withCRs
  36648.  
  36649.                          
  36650.  
  36651.                          values: #(directoryPattern)  ].
  36652.  
  36653.      ^nil
  36654.  
  36655.      "If fileName does not exist or is not a directory return the
  36656.  
  36657. standard menu"
  36658.  
  36659.      "fileName == nil ifTrue: [^nil]."
  36660.  
  36661.       
  36662.  
  36663.      "FileMenuFL == nil ifTrue:
  36664.  
  36665.           [FileMenuFL :=
  36666.  
  36667.                PopUpMenu
  36668.  
  36669.                     labels: 'load' withCRs
  36670.  
  36671.                     
  36672.  
  36673.                     values: #(load )]."
  36674.  
  36675.      
  36676.  
  36677.      "^FileMenuFL"! !
  36678.  
  36679. !FileList methodsFor: 'file name list'!
  36680. fileListMenuX
  36681.  
  36682.      "Answer the menu."
  36683.  
  36684.  
  36685.  
  36686.      "Evaluate this when you change this method:
  36687.  
  36688.           FileBrowser flushMenus"
  36689.  
  36690.       "^nil"
  36691.  
  36692.      "fileName == nil
  36693.  
  36694.           ifTrue: [^PopUpMenu
  36695.  
  36696.                          labels: 'make directory' withCRs
  36697.  
  36698.                          lines: #()
  36699.  
  36700.                          values: #(makeDir)]."
  36701.  
  36702.  
  36703.  
  36704.      "If fileName exists and is a directory, return a special
  36705.  
  36706. menu"
  36707.  
  36708.      selectionState = #directory
  36709.  
  36710.           ifTrue: [^PopUpMenu
  36711.  
  36712.                          labels: 'new pattern' withCRs
  36713.  
  36714.                          
  36715.  
  36716.                          values: #(directoryPattern)  ].
  36717.  
  36718.      ^nil
  36719.  
  36720.      "If fileName does not exist or is not a directory return the
  36721.  
  36722. standard menu"
  36723.  
  36724.      "fileName == nil ifTrue: [^nil]."
  36725.  
  36726.       
  36727.  
  36728.      "FileMenuFL == nil ifTrue:
  36729.  
  36730.           [FileMenuFL :=
  36731.  
  36732.                PopUpMenu
  36733.  
  36734.                     labels: 'load' withCRs
  36735.  
  36736.                     
  36737.  
  36738.                     values: #(load )]."
  36739.  
  36740.      
  36741.  
  36742.      "^FileMenuFL"! !
  36743.  
  36744. !FileList methodsFor: 'file name list'!
  36745. fileLoad: aTTMList1 
  36746.     aTTMList1 fileSelection: fileName.
  36747.     aTTMList1 fileLoad! !
  36748.  
  36749. !FileList methodsFor: 'file name list'!
  36750. fileName: selection 
  36751.     "If selection is not nil, it is either the name of a file to be viewed, or a 
  36752.     directory"
  36753.  
  36754.     | file |
  36755.     fileName = selection ifTrue: [^self].
  36756.     file := nil.
  36757.     lastModified := nil.
  36758.     selection == nil
  36759.         ifTrue: [selectionState := nil]
  36760.         ifFalse: 
  36761.             [file := selection.
  36762.             selectionState := #fileInfo.
  36763.             Filename errorReporter errorSignal handle: [:ex | ex return]
  36764.                 do: 
  36765.                     [| fn |
  36766.                     fn := file asFilename.
  36767.                     fn isDirectory
  36768.                         ifTrue: [selectionState := #directory]
  36769.                         ifFalse: [selectionState := #fileInfo]]].
  36770.     (fileName := selection) notNil
  36771.         ifTrue: 
  36772.             [filenameObject := Filename named: selection.
  36773.             "filenameObject isDirectory ifFalse: [currentDirectory := filenameObject head]
  36774.                 ifTrue: [currentDirectory := filenameObject].
  36775.             aTTMList currentDirectory: currentDirectory."
  36776.             self changed: #pattern.    "Reset the pattern, in case it has changed"
  36777.             self changed: #text]! !
  36778.  
  36779. !FileList methodsFor: 'file name list'!
  36780. fileSave: aTTMList 
  36781.  
  36782.     aTTMList fileSave notNil ifTrue: [self acceptPattern: self pattern asText from: nil]! !
  36783.  
  36784. !FileList methodsFor: 'pattern'!
  36785. acceptPattern: aText from: aController 
  36786.     (super acceptPattern: aText from: aController)
  36787.         = true
  36788.         ifTrue: 
  36789.             [filenameObject := Filename named: aText string.
  36790.             (filenameObject isDirectoryErrInto: BuildDummy new)
  36791.                 = true ifFalse: [currentDirectory := filenameObject head]
  36792.                 ifTrue: [currentDirectory := filenameObject].
  36793.             aTTMList currentDirectory: currentDirectory.
  36794.             TTMList currentDirectory: currentDirectory.
  36795.             ^true]
  36796.         ifFalse: [^false]! !
  36797.  
  36798. !FileList methodsFor: 'pattern'!
  36799. patternMenuX
  36800.     "Answer a Menu of operations on the file name pattern that 
  36801.     
  36802.     is to be displayed 
  36803.     
  36804.     when the operate menu button is pressed."
  36805.     "FileBrowser flushMenus."
  36806.  
  36807.     PatternMenu == nil ifTrue: [PatternMenu := PopUpMenu labels: 'volumes' withCRs values: #(#chooseVolume:from: )].
  36808.     ^PatternMenu! !
  36809.  
  36810. !FileList methodsFor: 'pattern'!
  36811. patternX: aString 
  36812.     "Set a new pattern for the receiver. Inform any dependents 
  36813.     
  36814.     so that the labels 
  36815.     
  36816.     for the receiver's views can be updated."
  36817.  
  36818.     myPattern := aString asText.
  36819.     self changed: #fileNameList.
  36820.     self changed: #windowLabel with: 'File Access on ' , aString! !
  36821.  
  36822. !FileList methodsFor: 'private'!
  36823. changedX: pat 
  36824.     pat = #pattern ifTrue: [true inspect].
  36825.     super changed: pat! !
  36826.  
  36827. !FileList methodsFor: 'private'!
  36828. listX: aList 
  36829.     "Set my list of files."
  36830.  
  36831.     aList add: '..'.
  36832.     super list: aList! !
  36833.  
  36834. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  36835.  
  36836. FileList class
  36837.     instanceVariableNames: ''!
  36838.  
  36839. !FileList class methodsFor: 'instance creation'!
  36840. flushMenus
  36841.     "Cause all menus to be newly created (so changes appear)."
  36842.     "FileBrowser flushMenus."
  36843.  
  36844.     TextMenuFL := nil.
  36845.     PatternMenu := nil.
  36846.     FileMenuFL := nil! !
  36847.  
  36848. !FileList class methodsFor: 'instance creation'!
  36849. openOnPattern: aPattern for: aTTMList 
  36850.     "Create and schedule a view of a new instance of the 
  36851.     
  36852.     receiver 
  36853.     
  36854.     using the pattern aPattern. For example, evaluate 
  36855.     
  36856.     FileList openOnPattern: '*.mdl'"
  36857.  
  36858.     | topView aFileList patternView label topWindow patternHeight qButton ldButton sButton left top hsize vsize path |
  36859.     patternHeight := [LookPreferences menuBarHeight + TextAttributes defaultLineGrid + 6].
  36860.     aFileList := self new.
  36861.     aFileList aTTMList: aTTMList.
  36862.     path := (Filename named: (TTMList currentDirectory)) constructString: aPattern.
  36863.     aPattern = ''
  36864.         ifFalse: 
  36865.             [Cursor read showWhile: [aFileList list: (SortedCollection new addAll: (aFileList filesMatching: path))].
  36866.             label := 'File Access on ' , aPattern asString]
  36867.         ifTrue: [label := 'File Access'].
  36868.     aFileList pattern: path.
  36869.     topWindow := ScheduledWindow
  36870.                 model: aFileList
  36871.                 label: label
  36872.                 minimumSize: 200 @ 200.
  36873.     topView := CompositePart new.
  36874.     topWindow component: topView.
  36875.     patternView := TextView
  36876.                 on: aFileList
  36877.                 aspect: #pattern
  36878.                 change: #acceptPattern:from:
  36879.                 menu: #patternMenu
  36880.                 initialSelection: nil.
  36881.     patternView controller dispatchOn: Character cr to: #alwaysAcceptKey:.
  36882.     patternView controller dispatchOn: #Enter to: #alwaysAcceptKey:.
  36883.     patternView := LookPreferences edgeDecorator on: patternView.
  36884.     patternView noVerticalScrollBar.
  36885.     left := 0.02.
  36886.     hsize := 0.3.
  36887.     top := 0.9.
  36888.     vsize := 0.09.
  36889.     topView add: patternView in: ((LayoutFrame new) leftOffset: 0; topOffset: 0; rightFraction: 1; bottomOffset: patternHeight).
  36890.     topView add: (LookPreferences edgeDecorator on: (SelectionInListView
  36891.                 on: aFileList
  36892.                 aspect: #fileNameList
  36893.                 change: #fileName:
  36894.                 list: #fileNameList
  36895.                 menu: #fileListMenu
  36896.                 initialSelection: #fileName))
  36897.         in: ((LayoutFrame new) leftOffset: 0; topOffset: patternHeight; rightFraction: 1; bottomFraction: 0.89).
  36898.     sButton := PushButton named: 'Save'.
  36899.     sButton model: ((PluggableAdaptor on: self)
  36900.             getBlock: [:model | false]
  36901.             putBlock: [:model :value | aFileList fileSave: aTTMList]
  36902.             updateBlock: [:model :value :parameter | false]).
  36903.     (topView add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  36904.         insideColor: ColorValue white.
  36905.     left := left + 0.3.
  36906.     ldButton := PushButton named: 'Load'.
  36907.     ldButton model: ((PluggableAdaptor on: self)
  36908.             getBlock: [:model | false]
  36909.             putBlock: [:model :value | aFileList fileLoad: aTTMList]
  36910.             updateBlock: [:model :value :parameter | false]).
  36911.     (topView add: ldButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  36912.         insideColor: ColorValue white.
  36913.     left := left + 0.3.
  36914.     qButton := PushButton named: 'Exit'.
  36915.     qButton model: ((PluggableAdaptor on: self)
  36916.             getBlock: [:model | false]
  36917.             putBlock: [:model :value | ScheduledControllers activeController close]
  36918.             updateBlock: [:model :value :parameter | false]).
  36919.     (topView add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  36920.         insideColor: ColorValue white.
  36921.     topWindow icon: (Icon constantNamed: #file).
  36922.     topWindow openWithExtent: 300 @ 350! !
  36923.  
  36924. DialogView subclass: #ExtendedDialogView
  36925.     instanceVariableNames: ''
  36926.     classVariableNames: ''
  36927.     poolDictionaries: ''
  36928.     category: 'Build'!
  36929.  
  36930. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  36931.  
  36932. ExtendedDialogView class
  36933.     instanceVariableNames: ''!
  36934.  
  36935. !ExtendedDialogView class methodsFor: 'instance creation'!
  36936. request: messageString1 and: messageString2 withInitial: one and: two
  36937.     " Request two strings from the user. "
  36938.     "ExtendedDialogView request: 'First name' and: 'last name' withInitial: 'dumb' and: 'butt'"
  36939.  
  36940.     | theModel |
  36941.     theModel := ValueHolder with: (Array with: '' with: '').
  36942.     (self model: theModel)
  36943.         addVerticalSpace: 3;
  36944.         addTextLabel: messageString1;
  36945.         addTextFieldOn: ((PluggableAdaptor on: theModel) collectionIndex: 1)
  36946.             initially: one;
  36947.         addVerticalSpace: 3;
  36948.         addTextLabel: messageString2;
  36949.         addTextFieldOn: ((PluggableAdaptor on: theModel) collectionIndex: 2)
  36950.             initially: two;
  36951.         addVerticalSpace: 3;
  36952.         open.
  36953.     ^theModel value! !
  36954.  
  36955. !ExtendedDialogView class methodsFor: 'instance creation'!
  36956. request: messageString1 and: messageString2 withInitial: one and: two onCancel: aBlockOrNil 
  36957.     "Request two strings from the user."
  36958.     "ExtendedDialogView request: 'First name' and: 'last name' 
  36959.     withInitial: 'dumb' and: 'butt' onCancel: [1+ 3]"
  36960.  
  36961.     | theModel acceptView aDV cancelView wasCanceled yp |
  36962.     theModel := ValueHolder with: (Array with: '' with: '').
  36963.     aDV := self model: theModel.
  36964.     wasCanceled := false.
  36965.     aDV addVerticalSpace: 3; addTextLabel: messageString1; addTextFieldOn: ((PluggableAdaptor on: theModel)
  36966.             collectionIndex: 1)
  36967.         initially: one; addVerticalSpace: 3; addTextLabel: messageString2; addTextFieldOn: ((PluggableAdaptor on: theModel)
  36968.             collectionIndex: 2)
  36969.         initially: two; addVerticalSpace: 4.
  36970.     aBlockOrNil == nil
  36971.         ifFalse: 
  36972.             [acceptView := (Button trigger) beDefault; model: ((PluggableAdaptor on: theModel)
  36973.                             getBlock: [:m | false]
  36974.                             putBlock: [:m :v | aDV controller accept]
  36975.                             updateBlock: [:m :a :v | false]); label: 'accept'.
  36976.             cancelView := (Button trigger) model: ((PluggableAdaptor on: theModel)
  36977.                             getBlock: [:m | false]
  36978.                             putBlock: 
  36979.                                 [:m :v | 
  36980.                                 m value: m value.
  36981.                                 wasCanceled := true]
  36982.                             updateBlock: [:m :a :v | false]); label: 'cancel'.
  36983.             yp := aDV yPosition.
  36984.             aDV addWrapper: (BoundedWrapper on: acceptView)
  36985.                 atX: 0.25; yPosition: yp; addWrapper: (BoundedWrapper on: cancelView)
  36986.                 atX: 0.75; addVerticalSpace: 4].
  36987.     aDV open.
  36988.     ^wasCanceled
  36989.         ifTrue: [aBlockOrNil value]
  36990.         ifFalse: [theModel value]! !
  36991.  
  36992. TextList subclass: #AlteredTextList
  36993.     instanceVariableNames: ''
  36994.     classVariableNames: ''
  36995.     poolDictionaries: ''
  36996.     category: 'Build'!
  36997.  
  36998. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  36999.  
  37000. AlteredTextList class
  37001.     instanceVariableNames: ''!
  37002.  
  37003. !AlteredTextList class methodsFor: 'instance creation'!
  37004. onList: aListArray 
  37005.  
  37006.     "Altered method of class TextList. 
  37007.  
  37008.     Changed so that the text style is fixed which allows 
  37009.  
  37010.     for column formatting of the display."
  37011.  
  37012.  
  37013.  
  37014.     ^self new list: aListArray style: (TextAttributes styleNamed: #fixed)! !
  37015.  
  37016. Object subclass: #ParseElement
  37017.     instanceVariableNames: 'leftChild rightChild value '
  37018.     classVariableNames: ''
  37019.     poolDictionaries: ''
  37020.     category: 'Build'!
  37021.  
  37022. !ParseElement methodsFor: 'accessing'!
  37023. contents
  37024.  
  37025.      ^value! !
  37026.  
  37027. !ParseElement methodsFor: 'accessing'!
  37028. contents: newContents 
  37029.  
  37030.      value := newContents! !
  37031.  
  37032. !ParseElement methodsFor: 'accessing'!
  37033. left
  37034.  
  37035.      ^leftChild! !
  37036.  
  37037. !ParseElement methodsFor: 'accessing'!
  37038. left: newLeft 
  37039.  
  37040.      leftChild := newLeft! !
  37041.  
  37042. !ParseElement methodsFor: 'accessing'!
  37043. right
  37044.  
  37045.      ^rightChild! !
  37046.  
  37047. !ParseElement methodsFor: 'accessing'!
  37048. right: newRight
  37049.  
  37050.      rightChild := newRight! !
  37051.  
  37052. !ParseElement methodsFor: 'testing'!
  37053. isAtom
  37054.     "Return true if self is an atom and not a connector."
  37055.  
  37056.     value = 'LEFT' | (value = 'AND' | (value = 'OR' | (value = 'ROOT')))
  37057.         ifTrue: [^false]
  37058.         ifFalse: [^true]! !
  37059.  
  37060. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  37061.  
  37062. ParseElement class
  37063.     instanceVariableNames: ''!
  37064.  
  37065. !ParseElement class methodsFor: 'instance creation'!
  37066. contents: newContents left: newLeft right: newRight 
  37067.     "Create an instance of a parse element"
  37068.  
  37069.     | newElement |
  37070.     newElement := self new.
  37071.     newElement contents: newContents.
  37072.     newElement left: newLeft.
  37073.     newElement right: newRight.
  37074.     ^newElement! !
  37075.  
  37076. ControllerWithMenu subclass: #EditingController
  37077.     instanceVariableNames: 'pointedTransition pointedActivity currentTransition oldCursorPt tempResult tempIndent detailDictionary ttmList currentTTM '
  37078.     classVariableNames: ''
  37079.     poolDictionaries: ''
  37080.     category: 'Build'!
  37081.  
  37082. !EditingController methodsFor: 'ac menu options'!
  37083. doAddTransition
  37084.     model waitingFor isNil
  37085.         ifTrue: 
  37086.             [model waitingFor: #addTransition.
  37087.             model source: pointedActivity.
  37088.             view pending]! !
  37089.  
  37090. !EditingController methodsFor: 'ac menu options'!
  37091. doEditActivity
  37092.     model waitingFor isNil
  37093.         ifTrue: 
  37094.             [pointedActivity myBox depth = #hidden
  37095.                 ifTrue: [pointedActivity myBox depth: #exposed]
  37096.                 ifFalse: [pointedActivity myBox depth: #hidden].
  37097.             model updateDisplayedActs.
  37098.             view displayOn: #dummy]! !
  37099.  
  37100. !EditingController methodsFor: 'ac menu options'!
  37101. doMoveActivity
  37102.     model waitingFor isNil
  37103.         ifTrue: 
  37104.             [model source: pointedActivity.
  37105.             model waitingFor: #moveActivity.
  37106.             view pending]! !
  37107.  
  37108. !EditingController methodsFor: 'ac menu options'!
  37109. doRemoveActivity
  37110.     | isDefault parent child |
  37111.     model waitingFor isNil
  37112.         ifTrue: 
  37113.             [child := pointedActivity left.
  37114.             child notNil ifTrue: [model ttm transitionlist removeSubtreeTrsFrom: child].
  37115.             model ttm transitionlist removeMyTransitions: pointedActivity.
  37116.             model ttm transitionlist reassessDefaultsForDeletedActivity: pointedActivity.
  37117.             isDefault := pointedActivity default.
  37118.             parent := model mynode.
  37119.             child notNil ifTrue: [(model ttm activitytree listOnlyChildrenOf: pointedActivity)
  37120.                     do: 
  37121.                         [:x | 
  37122.                         model ttm removeActivityVariableNamed: (x av at: 1).
  37123.                         x selfAV notNil = true ifTrue: [model ttm removeActivityVariableNamed: (x selfAV at: 1)]]].
  37124.             pointedActivity selfAV notNil = true ifTrue: [model ttm removeActivityVariableNamed: (pointedActivity selfAV at: 1)].
  37125.             model ttm activitytree removeActivity: pointedActivity.
  37126.             isDefault = true & parent left notNil ifTrue: [parent left default: true].
  37127.             parent left isNil ifTrue: [parent collectionType: #cluster].    "model ttm checkAllAVsStillUsed."
  37128.             ttmList changed: #avTransaction.
  37129.             ttmList changed: #curSFList.
  37130.             view displayOn: #dummy]! !
  37131.  
  37132. !EditingController methodsFor: 'ac menu options'!
  37133. doRenameActivity
  37134.     | newname hsize old reject |
  37135.     reject := true.
  37136.     model waitingFor isNil & pointedActivity notNil
  37137.         ifTrue: 
  37138.             [old := pointedActivity myName.
  37139.             [reject = false]
  37140.                 whileFalse: 
  37141.                     [newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  37142.                     newname isEmpty ifTrue: [^self].
  37143.                     (TTMList aUsefulActLabel: newname)
  37144.                         ifFalse: [reject := true]
  37145.                         ifTrue: [(model ttm name: newname isChildOfClusterActivity: model mynode)
  37146.                                 ifTrue: 
  37147.                                     [reject := true.
  37148.                                     TTMList speak: 'activity name already in use.']
  37149.                                 ifFalse: [reject := false]]].
  37150.             reject = false
  37151.                 ifTrue: 
  37152.                     [hsize := (newname size * 7.5) ceiling + 5.
  37153.                     hsize + pointedActivity myBox location x < view boundary right
  37154.                         ifTrue: 
  37155.                             [pointedActivity myName: newname.
  37156.                             hsize > pointedActivity myBox dimensions right
  37157.                                 ifTrue: 
  37158.                                     [pointedActivity myBox dimensions right: hsize.
  37159.                                     self reAssessTransitionsAll.
  37160.                                     view displayOn: #dummy]]
  37161.                         ifFalse: [TTMList speak: 'name too large to fit on view']]]! !
  37162.  
  37163. !EditingController methodsFor: 'ac menu options'!
  37164. doRenameActivityNew
  37165.     | newname hsize old reject |
  37166.     reject := true.
  37167.     model waitingFor isNil & pointedActivity notNil
  37168.         ifTrue: 
  37169.             [old := pointedActivity myName.
  37170.             [reject = false]
  37171.                 whileFalse: 
  37172.                     [newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  37173.                     newname isEmpty ifTrue: [^self].
  37174.                     (TTMList aUsefulActLabel: newname)
  37175.                         ifFalse: [reject := true]
  37176.                         ifTrue: [(model ttm name: newname isChildOfClusterActivity: model mynode)
  37177.                                 ifTrue: 
  37178.                                     [reject := true.
  37179.                                     TTMList speak: 'activity name already in use.']
  37180.                                 ifFalse: [reject := false]]].
  37181.             reject = false
  37182.                 ifTrue: 
  37183.                     [hsize := (newname size * 7.5) ceiling + 5.
  37184.                     hsize + pointedActivity myBox location x < view boundary right
  37185.                         ifTrue: 
  37186.                             [pointedActivity myName: newname.
  37187.                             hsize > pointedActivity myBox dimensions right
  37188.                                 ifTrue: 
  37189.                                     [pointedActivity myBox dimensions right: hsize.
  37190.                                     self reAssessTransitionsAll.
  37191.                                     view displayOn: #dummy]]
  37192.                         ifFalse: [TTMList speak: 'name too large to fit on view']]]! !
  37193.  
  37194. !EditingController methodsFor: 'ac menu options'!
  37195. doRenameActivityOld
  37196.     | newname hsize old |
  37197.     model waitingFor isNil & pointedActivity notNil
  37198.         ifTrue: 
  37199.             [old := pointedActivity myName.
  37200.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for activity?' initialAnswer: old.
  37201.             newname isEmpty ifTrue: [^self].
  37202.             (TTMList aUsefulActLabel: newname)
  37203.                 ifTrue: 
  37204.                     [newname := model ttm
  37205.                                 check: newname
  37206.                                 asNewActivityNameFor: model mynode av
  37207.                                 canBe: old.
  37208.                     hsize := (newname size * 7.5) ceiling + 5.
  37209.                     hsize + pointedActivity myBox location x < view boundary right
  37210.                         ifTrue: 
  37211.                             [pointedActivity myName: newname.
  37212.                             hsize > pointedActivity myBox dimensions right
  37213.                                 ifTrue: 
  37214.                                     [pointedActivity myBox dimensions right: hsize.
  37215.                                     self reAssessTransitionsAll.
  37216.                                     view displayOn: #dummy]]
  37217.                         ifFalse: [TTMList speak: 'name too large to fit on view']]
  37218.                 ifFalse: [TTMList speak: 'syntax error in name']]! !
  37219.  
  37220. !EditingController methodsFor: 'ac menu options'!
  37221. doResizeActivity
  37222.     model waitingFor isNil
  37223.         ifTrue: 
  37224.             [model source: pointedActivity.
  37225.             model waitingFor: #resizeActivity.
  37226.             view pending]! !
  37227.  
  37228. !EditingController methodsFor: 'ac menu options'!
  37229. doZoomin
  37230.     model waitingFor isNil
  37231.         ifTrue: 
  37232.             [model mynode: pointedActivity.
  37233.             view displayOn: #dummy]
  37234.         ifFalse: [model waitingFor = #addTransition | (model waitingFor = #changeDestination)
  37235.                 ifTrue: 
  37236.                     [model mynode: pointedActivity.
  37237.                     view displayOn: #dummy]]! !
  37238.  
  37239. !EditingController methodsFor: 'testing'!
  37240. isInActivity: aPoint 
  37241.     "Return activity if the cursor is in one of the 
  37242.     
  37243.     existing activities. Else return nil."
  37244.  
  37245.     | contained child siblingBox current |
  37246.     contained := false.
  37247.     child := model mynode left.
  37248.     current := nil.
  37249.     [child notNil & (contained = false)]
  37250.         whileTrue: 
  37251.             [child myBox notNil
  37252.                 ifTrue: 
  37253.                     [current := child.
  37254.                     siblingBox := child myBox dimensions copy moveBy: child myBox location.
  37255.                     contained := siblingBox containsPoint: aPoint].
  37256.             child := child right].
  37257.     contained
  37258.         ifTrue: [^current]
  37259.         ifFalse: [^nil]! !
  37260.  
  37261. !EditingController methodsFor: 'testing'!
  37262. isInTransition: aPoint 
  37263.     "Return transition if the cursor is in one of the 
  37264.     
  37265.     existing labels. Else return nil."
  37266.  
  37267.     | contained trList currentTr currentLabel trCount m |
  37268.     contained := false.
  37269.     trList := model ttm transitionlist.
  37270.     trCount := 1.
  37271.     [trCount <= trList size & (contained = false)]
  37272.         whileTrue: 
  37273.             [currentTr := trList at: trCount.
  37274.             (model displayedActs includes: (trList at: trCount) startingAt)
  37275.                 | (model displayedActs includes: (trList at: trCount) endingAt)
  37276.                 ifTrue: 
  37277.                     [(model visibleSourceFor: currentTr)
  37278.                         ifTrue: [m := currentTr myArc sourceMid]
  37279.                         ifFalse: [m := currentTr myArc destMid].
  37280.                     currentLabel := currentTr myArc dimensions copy moveBy: m.
  37281.                     contained := currentLabel containsPoint: aPoint].
  37282.             contained = false ifTrue: [trCount := trCount + 1]].
  37283.     contained
  37284.         ifTrue: [^currentTr]
  37285.         ifFalse: [^nil]! !
  37286.  
  37287. !EditingController methodsFor: 'mouse buttons'!
  37288. menu
  37289.     "This is the middle button menu. When the middle 
  37290.     
  37291.     mouse button is clicked, this is called."
  37292.  
  37293.     pointedTransition := self isInTransition: self sensor cursorPoint.
  37294.     pointedTransition isNil ifFalse: [^self menuForTransition]
  37295.         ifTrue: 
  37296.             [pointedActivity := self isInActivity: self sensor cursorPoint.
  37297.             pointedActivity isNil ifFalse: [^self menuForActivity]
  37298.                 ifTrue: [^nil]]! !
  37299.  
  37300. !EditingController methodsFor: 'mouse buttons'!
  37301. menuForActivity
  37302.     | menuValues labelValues1 labelValues2 |
  37303.     menuValues := #(#doZoomin #doMoveActivity #doResizeActivity #doRenameActivity #doEditActivity #doRemoveActivity #doAddTransition ).
  37304.     labelValues1 := #(#(#'zoom in' ) #(#move #resize #rename #expose #remove ) #(#'add tr.' ) ).
  37305.     labelValues2 := #(#(#'zoom in' ) #(#move #resize #rename #hide #remove ) #(#'add tr.' ) ).
  37306.     pointedActivity myBox depth = #hidden
  37307.         ifTrue: [^PopUpMenu labelList: labelValues1 values: menuValues]
  37308.         ifFalse: [^PopUpMenu labelList: labelValues2 values: menuValues]! !
  37309.  
  37310. !EditingController methodsFor: 'mouse buttons'!
  37311. menuForTransition
  37312.     | menuValues labelValues1 labelValues2 |
  37313.     menuValues := #(#doRenameTransition #doLowerTransition #doUpperTransition #doGuardTransition #doFunctionTransition #doEditTransition #doMoveTransition #doChangeTrDestination #doRemoveTransition #doSharedTransition #doDetail ).
  37314.     labelValues1 := #(#(#rename #'lower b.' #'upper b.' #guard #function ) #(#expose #move #'dest.' #remove #shared #detail ) ).
  37315.     labelValues2 := #(#(#rename #'lower b.' #'upper b.' #guard #function ) #(#hide #move #'dest.' #remove #shared #detail ) ).
  37316.     pointedTransition depth = #hidden
  37317.         ifTrue: [^PopUpMenu labelList: labelValues1 values: menuValues]
  37318.         ifFalse: [^PopUpMenu labelList: labelValues2 values: menuValues]! !
  37319.  
  37320. !EditingController methodsFor: 'mouse buttons'!
  37321. redButtonActivity
  37322.     "This is the left mouse button monitor. When it 
  37323.     
  37324.     is clicked this method is activated."
  37325.  
  37326.     | wait |
  37327.     wait := model waitingFor.
  37328.     wait = #addActivity
  37329.         ifTrue: [self performAddActivity]
  37330.         ifFalse: [wait = #addTransition
  37331.                 ifTrue: [self performAddTransition]
  37332.                 ifFalse: [wait = #moveActivity
  37333.                         ifTrue: [self performMoveActivity]
  37334.                         ifFalse: [wait = #moveTransition
  37335.                                 ifTrue: [self performMoveTransition]
  37336.                                 ifFalse: [wait = #resizeActivity
  37337.                                         ifTrue: [self performResizeActivity]
  37338.                                         ifFalse: [wait = #zoomin
  37339.                                                 ifTrue: [self performZoomin]
  37340.                                                 ifFalse: [wait = #addTransition1
  37341.                                                         ifTrue: [self performAddTrSource]
  37342.                                                         ifFalse: [wait = #setDefault
  37343.                                                                 ifTrue: [self performSetDefault]
  37344.                                                                 ifFalse: [wait = #inConcurrently
  37345.                                                                         ifTrue: [self performInsertConcurrently]
  37346.                                                                         ifFalse: [wait = #inSerially
  37347.                                                                                 ifTrue: [self performInsertSerially]
  37348.                                                                                 ifFalse: [wait = #selfloop
  37349.                                                                                         ifTrue: [self performSelfLoop]
  37350.                                                                                         ifFalse: [wait = #changeDestination
  37351.                                                                                                 ifTrue: [self performChangeDest]
  37352.                                                                                                 ifFalse: [wait = #changeselfloop
  37353.                                                                                                         ifTrue: [self performChangeToSelfLoop]
  37354.                                                                                                         ifFalse: []]]]]]]]]]]]]! !
  37355.  
  37356. !EditingController methodsFor: 'tr menu options'!
  37357. compressString: s 
  37358.     | r |
  37359.     r := ''.
  37360.     s do: [:x | x ~= $  ifTrue: [r := r , x asString]].
  37361.     ^r! !
  37362.  
  37363. !EditingController methodsFor: 'tr menu options'!
  37364. doChangeTrDestination
  37365.     model waitingFor isNil
  37366.         ifTrue: 
  37367.             [model waitingFor: #changeDestination.
  37368.             model source: pointedTransition.
  37369.             view pending]! !
  37370.  
  37371. !EditingController methodsFor: 'tr menu options'!
  37372. doDetail
  37373.     model waitingFor isNil ifTrue: [DetailWindow new: pointedTransition from: self]! !
  37374.  
  37375. !EditingController methodsFor: 'tr menu options'!
  37376. doEditTransition
  37377.     model waitingFor isNil
  37378.         ifTrue: 
  37379.             [pointedTransition depth = #hidden
  37380.                 ifTrue: [pointedTransition depth: #exposed]
  37381.                 ifFalse: [pointedTransition depth: #hidden].
  37382.             view displayOn: #dummy]! !
  37383.  
  37384. !EditingController methodsFor: 'tr menu options'!
  37385. doFunctionTransition
  37386.     | oldValue newValue accept ast undefined |
  37387.     accept := false.
  37388.     model waitingFor isNil
  37389.         ifTrue: 
  37390.             [oldValue := pointedTransition myAction.
  37391.             newValue := DialogView request: 'new action for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  37392.             newValue := self compressString: newValue.
  37393.             newValue isEmpty ifTrue: [newValue := 'nil'].
  37394.             newValue = oldValue
  37395.                 ifFalse: 
  37396.                     [newValue asString = 'nil'
  37397.                         ifTrue: [pointedTransition myAction: newValue]
  37398.                         ifFalse: 
  37399.                             [accept := true.
  37400.                             ast := BuildTFParser new parseForAST: newValue
  37401.                                         ifFail: 
  37402.                                             [TTMList speak: newValue , ' : Invalid function for transition'.
  37403.                                             accept := false]].
  37404.                     accept = false ifFalse: [ast rhsVars do: [:x | (model ttm anExistingAV2: x)
  37405.                                 = false & ((model ttm anExistingDV2: x)
  37406.                                     = false)
  37407.                                 ifTrue: 
  37408.                                     [undefined isNil ifTrue: [undefined := ''].
  37409.                                     undefined := undefined , '  ' , x]]].
  37410.                     accept = false | undefined notNil = true
  37411.                         ifTrue: [undefined notNil ifTrue: [TTMList speak: (newValue , ' : Invalid function for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs]]
  37412.                         ifFalse: 
  37413.                             [pointedTransition myAction: newValue.
  37414.                             view displayOn: #dummy]]]! !
  37415.  
  37416. !EditingController methodsFor: 'tr menu options'!
  37417. doFunctionTransitionOld
  37418.     | oldValue newValue accept |
  37419.     accept := false.
  37420.     model waitingFor isNil
  37421.         ifTrue: 
  37422.             [oldValue := pointedTransition myAction.
  37423.             newValue := DialogView request: 'new action for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  37424.             newValue isEmpty ifTrue: [newValue := 'nil'].
  37425.             newValue = oldValue
  37426.                 ifFalse: 
  37427.                     [newValue asString = 'nil'
  37428.                         ifTrue: [accept := true]
  37429.                         ifFalse: [(ParseTree functionSyntaxCheck: newValue from: model ttm)
  37430.                                 ifFalse: [accept := true]].
  37431.                     accept = false
  37432.                         ifTrue: [TTMList speak: 'illegal function for transition']
  37433.                         ifFalse: [pointedTransition myAction: newValue]]]! !
  37434.  
  37435. !EditingController methodsFor: 'tr menu options'!
  37436. doGuardTransition
  37437.     | oldValue newValue accept ast undefined |
  37438.     accept := false.
  37439.     model waitingFor isNil
  37440.         ifTrue: 
  37441.             [oldValue := pointedTransition myGuard.
  37442.             newValue := DialogView request: 'new guard for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  37443.             newValue := self compressString: newValue.
  37444.             newValue isEmpty ifTrue: [newValue := 'nil'].
  37445.             newValue = oldValue
  37446.                 ifFalse: 
  37447.                     [newValue asString = 'nil'
  37448.                         ifTrue: [pointedTransition myGuard: newValue]
  37449.                         ifFalse: 
  37450.                             [accept := true.
  37451.                             ast := BuildBoolParser new parseForAST: newValue
  37452.                                         ifFail: 
  37453.                                             [TTMList speak: newValue , ' : Invalid guard for transition'.
  37454.                                             accept := false]].
  37455.                     accept = false ifFalse: [ast rhsVars do: [:x | (model ttm anExistingAV: x)
  37456.                                 = false & ((model ttm anExistingDV: x)
  37457.                                     = false)
  37458.                                 ifTrue: 
  37459.                                     [undefined isNil ifTrue: [undefined := ''].
  37460.                                     undefined := undefined , '  ' , x]]].
  37461.                     accept = false | undefined notNil = true
  37462.                         ifTrue: [undefined notNil ifTrue: [TTMList speak: (newValue , ' : Invalid guard for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs]]
  37463.                         ifFalse: 
  37464.                             [pointedTransition myGuard: newValue.
  37465.                             view displayOn: #dummy]]]! !
  37466.  
  37467. !EditingController methodsFor: 'tr menu options'!
  37468. doGuardTransitionOld
  37469.     | oldValue newValue accept |
  37470.     accept := false.
  37471.     model waitingFor isNil
  37472.         ifTrue: 
  37473.             [oldValue := pointedTransition myGuard.
  37474.             newValue := DialogView request: 'new guard for ' , pointedTransition myName , '?' initialAnswer: oldValue.
  37475.             newValue isEmpty ifTrue: [newValue := 'nil'].
  37476.             newValue = oldValue
  37477.                 ifFalse: 
  37478.                     [newValue asString = 'nil'
  37479.                         ifTrue: [accept := true]
  37480.                         ifFalse: [(ParseTree guardSyntaxCheck: newValue from: model ttm)
  37481.                                 ifFalse: [accept := true]].
  37482.                     accept = false
  37483.                         ifTrue: [TTMList speak: 'illegal guard for transition']
  37484.                         ifFalse: [pointedTransition myGuard: newValue]]]! !
  37485.  
  37486. !EditingController methodsFor: 'tr menu options'!
  37487. doHideTransition
  37488.     model waitingFor isNil ifTrue: [pointedTransition depth = #hidden
  37489.             ifTrue: [pointedTransition depth: #exposed]
  37490.             ifFalse: [pointedTransition depth: #hidden]]! !
  37491.  
  37492. !EditingController methodsFor: 'tr menu options'!
  37493. doLowerTransition
  37494.     | oldValue newValue |
  37495.     model waitingFor isNil
  37496.         ifTrue: 
  37497.             [oldValue := pointedTransition boundLower.
  37498.             newValue := DialogView request: 'new lower bound?' initialAnswer: oldValue.
  37499.             newValue isEmpty | (newValue = oldValue) ifFalse: [(TTMList aValidNumber: newValue)
  37500.                     & (newValue ~= 'infinity')
  37501.                     ifTrue: 
  37502.                         [pointedTransition boundLower: newValue.
  37503.                         view displayOn: #dummy]
  37504.                     ifFalse: [TTMList speak: 'invalid lower bound']]]! !
  37505.  
  37506. !EditingController methodsFor: 'tr menu options'!
  37507. doMoveTransition
  37508.     model waitingFor isNil
  37509.         ifTrue: 
  37510.             [model source: pointedTransition.
  37511.             model waitingFor: #moveTransition.
  37512.             view pending]! !
  37513.  
  37514. !EditingController methodsFor: 'tr menu options'!
  37515. doRemoveTransition
  37516.     model waitingFor isNil
  37517.         ifTrue: 
  37518.             [model ttm transitionlist remove: pointedTransition.
  37519.             view displayOn: #dummy]! !
  37520.  
  37521. !EditingController methodsFor: 'tr menu options'!
  37522. doRenameTransition
  37523.     | oldName newName hsize ans m |
  37524.     model waitingFor isNil
  37525.         ifTrue: 
  37526.             [oldName := pointedTransition myName.
  37527.             newName := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New name for transition?' initialAnswer: oldName.
  37528.             newName isEmpty | (oldName = newName)
  37529.                 ifFalse: 
  37530.                     [(model ttm transitionlist TransitionsNamed: newName) size = 0
  37531.                         ifFalse: 
  37532.                             [ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  37533.                             ans = false ifTrue: [^nil]].
  37534.                     hsize := (newName size * 7.5) ceiling + 5.
  37535.                     (model visibleSourceFor: pointedTransition)
  37536.                         ifTrue: [m := pointedTransition myArc sourceMid]
  37537.                         ifFalse: [m := pointedTransition myArc destMid].
  37538.                     hsize + m x < view boundary right
  37539.                         ifTrue: 
  37540.                             [pointedTransition myName: newName.
  37541.                             pointedTransition myArc dimensions right: hsize.
  37542.                             view displayOn: #dummy]
  37543.                         ifFalse: [TTMList speak: 'name to large to fit on view']]]! !
  37544.  
  37545. !EditingController methodsFor: 'tr menu options'!
  37546. doSharedTransition
  37547.     | default |
  37548.     model waitingFor isNil
  37549.         ifTrue: 
  37550.             [default := pointedTransition shared = true.
  37551.             default := DialogView
  37552.                         choose: 'Set  Transition To:'
  37553.                         labels: #('Shared' 'not Shared' )
  37554.                         values: #(true false )
  37555.                         default: default.
  37556.             pointedTransition shared: default.
  37557.             view displayOn: #dummy]! !
  37558.  
  37559. !EditingController methodsFor: 'tr menu options'!
  37560. doUpperTransition
  37561.     | oldValue newValue |
  37562.     model waitingFor isNil
  37563.         ifTrue: 
  37564.             [oldValue := pointedTransition boundUpper.
  37565.             newValue := DialogView request: 'new upper bound?' initialAnswer: oldValue.
  37566.             newValue isEmpty | (newValue = oldValue) ifFalse: [(TTMList aValidNumber: newValue)
  37567.                     ifTrue: 
  37568.                         [pointedTransition boundUpper: newValue.
  37569.                         view displayOn: #dummy]
  37570.                     ifFalse: [TTMList speak: 'invalid upper bound']]]! !
  37571.  
  37572. !EditingController methodsFor: 'DetailWindow access'!
  37573. getSubStructureFor: anActivity 
  37574.     tempResult := OrderedCollection new.
  37575.     self findAV: anActivity withIndent: 1.
  37576.     ^tempResult! !
  37577.  
  37578. !EditingController methodsFor: 'performing'!
  37579. findAV: anActivity 
  37580.     "TTMList show: 'Entering findAV for ',anActivity myName."
  37581.  
  37582.     | anAV def temp |
  37583.     anActivity collectionType = #parallel
  37584.         ifTrue: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37585.                 do: [:act2 | self findAV: act2]]
  37586.         ifFalse: 
  37587.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37588.                 do: [:x | "TTMList show: x myName."
  37589.                     x default ifTrue: ["TTMList show: 'default for ' , anActivity myName 
  37590.                         , ' is ' , 
  37591.                         
  37592.                         def myName"
  37593.                         def := x]].
  37594.             def isNil
  37595.                 ifTrue: ["TTMList show: 'no default for ' , anActivity myName."
  37596.                     ^self]
  37597.                 ifFalse: 
  37598.                     [anAV := def av at: 1.
  37599.                     temp := Array new: 2.
  37600.                     temp at: 1 put: anAV.
  37601.                     temp at: 2 put: def myName.
  37602.                     tempResult add: temp.
  37603.                     def left isNil ifFalse: [self findAV: def]]]! !
  37604.  
  37605. !EditingController methodsFor: 'performing'!
  37606. findAV: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  37607.     tempResult := OrderedCollection new.
  37608.     detailDictionary := aNewDictionary.
  37609.     self
  37610.         findAV: anActivity
  37611.         withIndent: 1
  37612.         withDefault: aDictionary.
  37613.     ^tempResult! !
  37614.  
  37615. !EditingController methodsFor: 'performing'!
  37616. findAV: anActivity withIndent: anInteger 
  37617.     | def temp |
  37618.     "TTMList show: anActivity myName , '   ' , anActivity collectionType asString."
  37619.     (((model ttm activitytree) parentOf: anActivity) collectionType)
  37620.         = #cluster
  37621.         ifTrue: 
  37622.             [temp := Array new: 2.
  37623.             temp at: 1 put: anActivity.
  37624.             temp at: 2 put: anInteger.
  37625.             tempResult add: temp.
  37626.             TTMList show: 'The above line is in tempResult'].
  37627.     anActivity collectionType = #cluster
  37628.         ifTrue: 
  37629.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37630.                 do: [:x | x default ifTrue: [def := x]].
  37631.             def isNil
  37632.                 ifTrue: [^self]
  37633.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]
  37634.         ifFalse: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37635.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]! !
  37636.  
  37637. !EditingController methodsFor: 'performing'!
  37638. findAV: anActivity withIndent: anInteger withDefault: aDictionary 
  37639.     | def temp defAct children ass |
  37640.     (((model ttm activitytree) parentOf: anActivity) collectionType)
  37641.         = #cluster
  37642.         ifTrue: 
  37643.             [temp := Array new: 2.
  37644.     temp at: 1 put: anActivity.
  37645.     temp at: 2 put: anInteger.
  37646.     tempResult add: temp.].
  37647.     children := model ttm activitytree allImmediateChildrenOf: anActivity.
  37648.     anActivity collectionType = #parallel
  37649.         ifTrue: [children do: [:act2 | self
  37650.                     findAV: act2
  37651.                     withIndent: anInteger + 1
  37652.                     withDefault: aDictionary]]
  37653.         ifFalse: [children isEmpty
  37654.                 ifFalse: 
  37655.                     [(defAct := aDictionary at: ((children at: 1) av at: 1)
  37656.                                 ifAbsent: []) isNil
  37657.                         ifTrue: [children do: [:x | x default ifTrue: [def := x]]]
  37658.                         ifFalse: 
  37659.                             [def := defAct.
  37660.                             ass := Association new.
  37661.                             ass key: (def av at: 1)
  37662.                                 value: def.
  37663.                             detailDictionary add: ass].
  37664.                     def isNil
  37665.                         ifTrue: [^nil]
  37666.                         ifFalse: [self
  37667.                                 findAV: def
  37668.                                 withIndent: anInteger + 1
  37669.                                 withDefault: aDictionary]]]! !
  37670.  
  37671. !EditingController methodsFor: 'performing'!
  37672. findAVsafe: anActivity withIndent: anInteger 
  37673.     | def temp |
  37674.     temp := Array new: 2.
  37675.     temp at: 1 put: anActivity.
  37676.     temp at: 2 put: anInteger.
  37677.     tempResult add: temp.
  37678.     TTMList show: anActivity myName.
  37679.     anActivity collectionType = #parallel
  37680.         ifTrue: [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37681.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]
  37682.         ifFalse: 
  37683.             [(model ttm activitytree allImmediateChildrenOf: anActivity)
  37684.                 do: [:x | x default ifTrue: [def := x]].
  37685.             def isNil
  37686.                 ifTrue: [^self]
  37687.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]! !
  37688.  
  37689. !EditingController methodsFor: 'performing'!
  37690. findAVSource2: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  37691.     tempResult := OrderedCollection new.
  37692.     detailDictionary := aNewDictionary.
  37693.     self
  37694.         findAVSource: anActivity
  37695.         withIndent: 1
  37696.         withDefault: aDictionary.
  37697.     ^tempResult! !
  37698.  
  37699. !EditingController methodsFor: 'performing'!
  37700. findAVSource: anActivity withDefault: aDictionary newDictionary: aNewDictionary 
  37701.     tempResult := OrderedCollection new.
  37702.     detailDictionary := aNewDictionary.
  37703.     self
  37704.         findAVSource: anActivity
  37705.         withIndent: 0
  37706.         withDefault: aDictionary.
  37707.     ^tempResult! !
  37708.  
  37709. !EditingController methodsFor: 'performing'!
  37710. findAVSource: anActivity withIndent: anInteger withDefault: aDictionary 
  37711.     | temp defAct children p flag ass |
  37712.     p := model ttm activitytree parentOf: anActivity.
  37713.     p notNil
  37714.         ifTrue: [flag := p collectionType = #cluster]
  37715.         ifFalse: [flag := true].
  37716.     flag = true
  37717.         ifTrue: 
  37718.             [temp := Array new: 2.
  37719.             temp at: 1 put: anActivity.
  37720.             temp at: 2 put: anInteger.
  37721.             tempResult add: temp].
  37722.     anActivity collectionType = #cluster
  37723.         ifTrue: [(defAct := aDictionary at: (anActivity selfAV at: 1)
  37724.                         ifAbsent: [^nil]) isNil
  37725.                 ifFalse: 
  37726.                     [ass := Association new.
  37727.                     ass key: (defAct av at: 1)
  37728.                         value: defAct.
  37729.                     detailDictionary add: ass.
  37730.                     self
  37731.                         findAVSource: defAct
  37732.                         withIndent: anInteger + 1
  37733.                         withDefault: aDictionary]]
  37734.         ifFalse: 
  37735.             [children := model ttm activitytree allImmediateChildrenOf: anActivity.
  37736.             children do: [:act2 | self
  37737.                     findAVSource: act2
  37738.                     withIndent: anInteger + 1
  37739.                     withDefault: aDictionary]]! !
  37740.  
  37741. !EditingController methodsFor: 'performing'!
  37742. getActivityTranformationsFor: anActivity 
  37743.     |  |
  37744.     tempResult := OrderedCollection new.
  37745.     self findAV: anActivity withIndent: 1.
  37746.     ^tempResult! !
  37747.  
  37748. !EditingController methodsFor: 'performing'!
  37749. performAddActivity
  37750.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber typeResponse |
  37751.     reject := false.
  37752.     typeResponse := nil.
  37753.     cursorPosition := self sensor cursorPoint.
  37754.     avList := model ttm typeForAV: model mynode selfAV.
  37755.     avList size = 1
  37756.         ifTrue: [totalNumber := 0]
  37757.         ifFalse: [totalNumber := avList size].
  37758.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode selfAV]
  37759.         whileTrue: [totalNumber := totalNumber + 1].
  37760.     model mynode left isNil
  37761.         ifTrue: 
  37762.             [typeResponse := DialogView
  37763.                         choose: 'Choose type for TTM : ' , model mynode myName
  37764.                         labels: #('XOR' 'AND' )
  37765.                         values: #(true false )
  37766.                         default: true.
  37767.             typeResponse = true
  37768.                 ifTrue: [model mynode collectionType: #cluster]
  37769.                 ifFalse: [model mynode collectionType: #parallel]].
  37770.     aLabel := DialogView
  37771.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  37772.                 initialAnswer: totalNumber printString
  37773.                 onCancel: [^nil].
  37774.     aLabel isNil
  37775.         ifTrue: [reject := true]
  37776.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  37777.                 ifFalse: [reject := true]
  37778.                 ifTrue: [(model ttm name: aLabel isChildOfClusterActivity: model mynode)
  37779.                         ifTrue: 
  37780.                             [reject := true.
  37781.                             TTMList speak: 'activity name already in use.']]].
  37782.     reject = false
  37783.         ifTrue: 
  37784.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  37785.             activityDim isNil
  37786.                 ifFalse: 
  37787.                     [newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  37788.                     oldCursorPt := self sensor cursorPoint.
  37789.                     model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  37790.                         ifTrue: 
  37791.                             [avName := '1'.
  37792.                             [(model ttm aValidVariableName: avName)
  37793.                                 = false | ((model ttm anExistingAV: avName)
  37794.                                     = true) | ((model ttm anExistingDV: avName)
  37795.                                     = true)]
  37796.                                 whileTrue: 
  37797.                                     [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  37798.                                     self sensor cursorPoint: oldCursorPt.
  37799.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  37800.                                     avName isEmpty ifTrue: [avName := '1']].
  37801.                             avType := Array with: avName with: 'True'.
  37802.                             model ttm activityvariable: (avType at: 1)
  37803.                                 initial: (avType at: 2).
  37804.                             model mynode selfAV: avType.
  37805.                             model mynode hasAV: true].
  37806.                     newNode av: model mynode selfAV.
  37807.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  37808.                     model doCancel]]
  37809.         ifFalse: 
  37810.             [TTMList speak: 'illegal activity name given'.
  37811.             model doCancel].
  37812.     model mynode collectionType = #parallel & model mynode selfAV notNil
  37813.         ifTrue: 
  37814.             [model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  37815.             model mynode hasAV: false].
  37816.     ttmList changed: #avTransaction.
  37817.     ttmList changed: #curSFList.
  37818.     view displayOn: #dummy! !
  37819.  
  37820. !EditingController methodsFor: 'performing'!
  37821. performAddActivity1
  37822.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber newAVNeeded |
  37823.     reject := false.
  37824.     cursorPosition := self sensor cursorPoint.
  37825.     avList := model ttm typeForAV: model mynode av.
  37826.     avList size = 1
  37827.         ifTrue: [totalNumber := 0]
  37828.         ifFalse: [totalNumber := avList size].
  37829.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode av]
  37830.         whileTrue: [totalNumber := totalNumber + 1].
  37831.     aLabel := DialogView
  37832.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  37833.                 initialAnswer: totalNumber printString
  37834.                 onCancel: [^nil].
  37835.     aLabel isNil
  37836.         ifTrue: [reject := true]
  37837.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  37838.                 ifFalse: [reject := true]
  37839.                 ifTrue: [(model ttm name: aLabel alreadyExistsFor: model mynode av)
  37840.                         ifTrue: 
  37841.                             [reject := true.
  37842.                             TTMList speak: 'activity name already in use.']]].
  37843.     reject = false
  37844.         ifTrue: 
  37845.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  37846.             activityDim isNil
  37847.                 ifFalse: 
  37848.                     [newAVNeeded := (model ttm activitytree parentOf: model mynode)
  37849.                                 ~= nil & (model mynode left = nil).
  37850.                     newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  37851.                     model mynode collectionType = #cluster & (newAVNeeded = false)
  37852.                         ifTrue: [avType := model mynode selfAV]
  37853.                         ifFalse: 
  37854.                             [oldCursorPt := self sensor cursorPoint.
  37855.                             avName := model mynode av at: 1.
  37856.                             [(model ttm aValidVariableName: avName)
  37857.                                 & (avName ~= (model mynode av at: 1))]
  37858.                                 whileFalse: 
  37859.                                     [aRequest := 'Please supply a unique activity variable for ' , newNode myName , ':'.
  37860.                                     self sensor cursorPoint: oldCursorPt.
  37861.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  37862.                                     avName isEmpty ifTrue: [avName := model mynode av at: 1]].
  37863.                             avType := Array with: avName with: 'True'.
  37864.                             model ttm activityvariable: (avType at: 1)
  37865.                                 initial: (avType at: 2)].
  37866.                     model mynode selfAV: avType.
  37867.                     newNode av: avType.
  37868.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  37869.                     model doCancel]]
  37870.         ifFalse: 
  37871.             [TTMList speak: 'illegal activity name given'.
  37872.             model doCancel].
  37873.     view displayOn: #dummy! !
  37874.  
  37875. !EditingController methodsFor: 'performing'!
  37876. performAddActivityLast
  37877.     | aLabel cursorPosition activityDim newNode reject avType avName aRequest avList totalNumber typeResponse c t x |
  37878.     reject := false.
  37879.     typeResponse := nil.
  37880.     cursorPosition := self sensor cursorPoint.
  37881.     avList := model ttm typeForAV: model mynode selfAV.
  37882.     avList size = 1
  37883.         ifTrue: [totalNumber := 0]
  37884.         ifFalse: [totalNumber := avList size].
  37885.     [model ttm name: totalNumber printString alreadyExistsFor: model mynode selfAV]
  37886.         whileTrue: [totalNumber := totalNumber + 1].
  37887.     model mynode left isNil
  37888.         ifTrue: 
  37889.             [typeResponse := DialogView
  37890.                         choose: 'Choose type for TTM : ' , model mynode myName
  37891.                         labels: #('XOR' 'AND' )
  37892.                         values: #(true false )
  37893.                         default: true.
  37894.             typeResponse = true
  37895.                 ifTrue: [model mynode collectionType: #cluster]
  37896.                 ifFalse: [model mynode collectionType: #parallel]].
  37897.     aLabel := DialogView
  37898.                 request: '(First letter must be lower case)' , (String with: Character cr) , 'name of new activity?'
  37899.                 initialAnswer: totalNumber printString
  37900.                 onCancel: [^nil].
  37901.     aLabel isNil
  37902.         ifTrue: [reject := true]
  37903.         ifFalse: [(TTMList aUsefulActLabel: aLabel)
  37904.                 ifFalse: [reject := true]
  37905.                 ifTrue: 
  37906.                     [c := 1.
  37907.                     t := model ttm activitytree allImmediateChildrenOf: model mynode.
  37908.                     [reject = false & (c < t size)]
  37909.                         whileTrue: 
  37910.                             [x := t at: c.
  37911.                             x myName = aLabel
  37912.                                 ifTrue: 
  37913.                                     [reject := true.
  37914.                                     TTMList speak: 'activity name already in use.'].
  37915.                             c := c + 1]]].
  37916.     reject = false
  37917.         ifTrue: 
  37918.             [activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  37919.             activityDim isNil
  37920.                 ifFalse: 
  37921.                     [newNode := model ttm activitytree addChildTo: model mynode withName: aLabel.
  37922.                     oldCursorPt := self sensor cursorPoint.
  37923.                     model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  37924.                         ifTrue: 
  37925.                             [avName := '1'.
  37926.                             [(model ttm aValidVariableName: avName)
  37927.                                 = false | ((model ttm anExistingAV: avName)
  37928.                                     = true) | ((model ttm anExistingDV: avName)
  37929.                                     = true)]
  37930.                                 whileTrue: 
  37931.                                     [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  37932.                                     self sensor cursorPoint: oldCursorPt.
  37933.                                     avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  37934.                                     avName isEmpty ifTrue: [avName := '1']].
  37935.                             avType := Array with: avName with: 'True'.
  37936.                             model ttm activityvariable: (avType at: 1)
  37937.                                 initial: (avType at: 2).
  37938.                             model mynode selfAV: avType.
  37939.                             model mynode hasAV: true].
  37940.                     newNode av: model mynode selfAV.
  37941.                     newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  37942.                     model doCancel]]
  37943.         ifFalse: 
  37944.             [TTMList speak: 'illegal activity name given'.
  37945.             model doCancel].
  37946.     model mynode collectionType = #parallel & model mynode selfAV notNil
  37947.         ifTrue: 
  37948.             [model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  37949.             model mynode hasAV: false].
  37950.     ttmList changed: #avTransaction.
  37951.     ttmList changed: #curSFList.
  37952.     view displayOn: #dummy! !
  37953.  
  37954. !EditingController methodsFor: 'performing'!
  37955. performAddTransition
  37956.     | newTransition newArc box1 box2 points newname ans existingDest t |
  37957.     model mynode collectionType = #parallel
  37958.         ifTrue: 
  37959.             [DialogView warn: 'Cannot add transition between concurrent events'.
  37960.             model doCancel.
  37961.             ^nil].
  37962.     pointedActivity := self isInActivity: self sensor cursorPoint.
  37963.     pointedActivity isNil
  37964.         ifFalse: 
  37965.             [
  37966.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New transition name?'.
  37967.             newname isEmpty ifTrue: [^nil].
  37968.             (TTMList aUsefulTrLabel: newname)
  37969.                 ifTrue: [(model ttm transitionlist TransitionsNamed: newname) size = 0
  37970.                         ifFalse: 
  37971.                             ["existingDest := ((model ttm 
  37972.                             
  37973.                             transitionlist TransitionsNamed: newname) 
  37974.                             
  37975.                             at: 1) 
  37976.                             
  37977.                             endingAt. 
  37978.                             
  37979.                             pointedActivity ~= 
  37980.                             
  37981.                             existingDest ifTrue: [(model ttm activitytree 
  37982.                             is: 
  37983.                             
  37984.                             pointedActivity 
  37985.                             
  37986.                             concurrentWith: existingDest) 
  37987.                             
  37988.                             ifFalse: 
  37989.                             
  37990.                             [TTMList speak: 
  37991.                             
  37992.                             'not a permissible destination', (String with: 
  37993.                             
  37994.                             Character cr), 
  37995.                             
  37996.                             'for a branch or shared transition.'. 
  37997.                             
  37998.                             ^nil]]."
  37999.                             ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  38000.                             ans = false ifTrue: [^nil]]]
  38001.                 ifFalse: 
  38002.                     [TTMList speak: 'invalid transition name'.
  38003.                     ^nil].
  38004.             model source = pointedActivity
  38005.                 ifTrue: 
  38006.                     [model waitingFor: #selfloop.
  38007.                     model source: (Array with: model source with: newname).
  38008.                     view pending.
  38009.                     ^self].    "*****************"
  38010.             t := self getActivityTranformationsFor: pointedActivity.
  38011.             newTransition := model ttm transitionlist
  38012.                         addTransitionFrom: model source
  38013.                         to: pointedActivity
  38014.                         withName: newname.
  38015.             box1 := model source myBox dimensions copy moveBy: model source myBox location.
  38016.             box2 := pointedActivity myBox dimensions copy moveBy: pointedActivity myBox location.
  38017.             points := view boxPoints: box1 to: box2.
  38018.             newArc := Arc2
  38019.                         start: (points at: 1)
  38020.                         end: (points at: 2)
  38021.                         mid: (view midPointOf: (points at: 1)
  38022.                                 and: (points at: 2)).
  38023.             newArc dimensions: (Rectangle
  38024.                     left: 0
  38025.                     right: (newTransition myName size * 7.5) ceiling + 5
  38026.                     top: 0
  38027.                     bottom: 20).
  38028.             newTransition myArc: newArc.
  38029.             model readjustPointsFor: newTransition.
  38030.             model doCancel].
  38031.     view displayOn: #dummy! !
  38032.  
  38033. !EditingController methodsFor: 'performing'!
  38034. performAddTransitionOld
  38035.     | newTransition newArc box1 box2 points newname ans existingDest |
  38036.     pointedActivity := self isInActivity: self sensor cursorPoint.
  38037.     pointedActivity isNil
  38038.         ifFalse: 
  38039.             [(model ttm activitytree is: pointedActivity concurrentWith: model source)
  38040.                 ifTrue: 
  38041.                     [model doCancel.
  38042.                     TTMList speak: 'activities cannot be concurrent'.
  38043.                     ^nil].
  38044.             newname := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New transition name?'.
  38045.             newname isEmpty ifTrue: [^nil].
  38046.             (TTMList aUsefulTrLabel: newname)
  38047.                 ifTrue: [(model ttm transitionlist TransitionsNamed: newname) size = 0
  38048.                         ifFalse: 
  38049.                             [existingDest := ((model ttm transitionlist TransitionsNamed: newname)
  38050.                                         at: 1) endingAt.
  38051.                             pointedActivity ~= existingDest ifTrue: [(model ttm activitytree is: pointedActivity concurrentWith: existingDest)
  38052.                                     ifFalse: 
  38053.                                         [TTMList speak: 'not a permissible destination' , (String with: Character cr) , 'for a branch or shared transition.'.
  38054.                                         ^nil]].
  38055.                             ans := DialogView confirm: 'Transition name already in use' , (String with: Character cr) , 'Do you still want to use it?'.
  38056.                             ans = false ifTrue: [^nil]]]
  38057.                 ifFalse: 
  38058.                     [TTMList speak: 'invalid transition name'.
  38059.                     ^nil].
  38060.             model source = pointedActivity
  38061.                 ifTrue: 
  38062.                     [model waitingFor: #selfloop.
  38063.                     model source: (Array with: model source with: newname).
  38064.                     view pending.
  38065.                     ^self].
  38066.             newTransition := model ttm transitionlist
  38067.                         addTransitionFrom: model source
  38068.                         to: pointedActivity
  38069.                         withName: newname.
  38070.             box1 := model source myBox dimensions copy moveBy: model source myBox location.
  38071.             box2 := pointedActivity myBox dimensions copy moveBy: pointedActivity myBox location.
  38072.             points := view boxPoints: box1 to: box2.
  38073.             newArc := Arc2
  38074.                         start: (points at: 1)
  38075.                         end: (points at: 2)
  38076.                         mid: (view midPointOf: (points at: 1)
  38077.                                 and: (points at: 2)).
  38078.             newArc dimensions: (Rectangle
  38079.                     left: 0
  38080.                     right: (newTransition myName size * 7.5) ceiling + 5
  38081.                     top: 0
  38082.                     bottom: 20).
  38083.             newTransition myArc: newArc.
  38084.             model readjustPointsFor: newTransition.
  38085.             model doCancel].
  38086.     view displayOn: #dummy! !
  38087.  
  38088. !EditingController methodsFor: 'performing'!
  38089. performAddTrSource
  38090.  
  38091.      pointedActivity := self isInActivity: self sensor
  38092.  
  38093. cursorPoint.
  38094.  
  38095.      pointedActivity isNil
  38096.  
  38097.           ifFalse: 
  38098.  
  38099.                [model waitingFor: #addTransition.
  38100.  
  38101.                model source: pointedActivity.
  38102.  
  38103.                view pending.
  38104.  
  38105.                (Delay forSeconds: 1) wait]! !
  38106.  
  38107. !EditingController methodsFor: 'performing'!
  38108. performChangeDest
  38109.     | newTransition box1 box2 points newArc |
  38110.     pointedActivity := self isInActivity: self sensor cursorPoint.
  38111.     pointedActivity isNil
  38112.         ifFalse: 
  38113.             [newTransition := model source.
  38114.             newTransition endingAt: pointedActivity.
  38115.             newTransition startingAt = newTransition endingAt
  38116.                 ifTrue: 
  38117.                     [model source: newTransition.
  38118.                     (Delay forSeconds: 1) wait.
  38119.                     model waitingFor: #changeselfloop.
  38120.                     view pending.
  38121.                     ^self].
  38122.             box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  38123.             box2 := newTransition endingAt myBox dimensions copy moveBy: newTransition endingAt myBox location.
  38124.             points := view boxPoints: box1 to: box2.
  38125.             newArc := Arc2
  38126.                         start: (points at: 1)
  38127.                         end: (points at: 2)
  38128.                         mid: (view midPointOf: (points at: 1)
  38129.                                 and: (points at: 2)).
  38130.             newArc dimensions: (Rectangle
  38131.                     left: 0
  38132.                     right: (newTransition myName size * 7.5) ceiling + 5
  38133.                     top: 0
  38134.                     bottom: 20).
  38135.             newTransition myArc: newArc.
  38136.             model readjustPointsFor: newTransition.
  38137.             model doCancel.
  38138.             view displayOn: #dummy]! !
  38139.  
  38140. !EditingController methodsFor: 'performing'!
  38141. performChangeToSelfLoop
  38142.     "This is the case where the new destination for an existing transition is its 
  38143.     source. I.E. it becomes a self-loop."
  38144.  
  38145.     | box1 points newArc newTransition myMidpt endingPt startingPt |
  38146.     myMidpt := self sensor cursorPoint.
  38147.     newTransition := model source.
  38148.     box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  38149.     points := view
  38150.                 boxPoints: box1
  38151.                 to: box1
  38152.                 via: myMidpt.
  38153.     endingPt := points at: 2.
  38154.     startingPt := self selfLoopStartingPtFor: endingPt with: box1.
  38155.     newArc := Arc2
  38156.                 start: startingPt
  38157.                 end: endingPt
  38158.                 mid: myMidpt.
  38159.     newArc dimensions: (Rectangle
  38160.             left: 0
  38161.             right: (newTransition myName size * 7.5) ceiling + 5
  38162.             top: 0
  38163.             bottom: 20).
  38164.     newTransition myArc: newArc.
  38165.     model readjustPointsFor: newTransition.
  38166.     model doCancel.
  38167.     view displayOn: #dummy! !
  38168.  
  38169. !EditingController methodsFor: 'performing'!
  38170. performInsertConcurrently
  38171.     "Insert ttmChosen into the current TTM concurrently."
  38172.     "MUST CHANGE AVs OF NEW SIBLING TOO!!"
  38173.  
  38174.     | aLabel cursorPosition activityDim newNode mySibling oldSiblingAV newSiblingAV choice |
  38175.     model mynode collectionType = #cluster & (model mynode left ~= nil)
  38176.         ifTrue: 
  38177.             [DialogView warn: 'Cannot perform parallel insertion into a seriel TTM'.
  38178.             model doCancel.
  38179.             ^nil].
  38180.     aLabel := model ttmChosen activitytree getRoot myName.
  38181.     cursorPosition := self sensor cursorPoint.
  38182.     activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  38183.     activityDim isNil
  38184.         ifFalse: 
  38185.             [oldCursorPt := self sensor cursorPoint.
  38186.             self addingOfAVsInParallel.
  38187.             self addingOfDVs: (model duplicateOption at: 1).
  38188.             self addingOfChannels.
  38189.             self combineStateFormulas.
  38190.             self combineInitialConditions.
  38191.             newNode := self addingActivitiesInParallel.
  38192.             self addingTransitionsInParallel: nil.
  38193.             mySibling := self model mynode left.
  38194.             oldSiblingAV := mySibling av.
  38195.             newSiblingAV := mySibling av copy.
  38196.             newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  38197.             self model mynode collectionType: #parallel.
  38198.             model ttm removeActivityVariableNamed: (model mynode selfAV at: 1).
  38199.             model mynode hasAV: false.
  38200.             model ttm updateSpecificIC.
  38201.                  "model ttm checkAllAVsStillUsed."
  38202.             ttmList changed: #avTransaction.
  38203.             ttmList changed: #curSFList.
  38204.             model doCancel.
  38205.             model doCancel.
  38206.             view displayOn: #dummy].
  38207.     model mynode selfAV isNil ifFalse: [newNode av: model mynode selfAV]! !
  38208.  
  38209. !EditingController methodsFor: 'performing'!
  38210. performInsertSerially
  38211.     "Insert ttmChosen into the current TTM sequentially. 
  38212.     
  38213.     Rename root 
  38214.     activity if necessary, get display box, 
  38215.     
  38216.     then add the AVs, DVs, 
  38217.     activities, and finally the 
  38218.     
  38219.     transitions. Then add the root activity as a 
  38220.     child of 
  38221.     
  38222.     the current activity being displayed."
  38223.  
  38224.     | aLabel cursorPosition activityDim newNode avName aRequest avType |
  38225.     model mynode collectionType = #parallel & (model mynode left ~= nil)
  38226.         ifTrue: 
  38227.             [DialogView warn: 'Cannot perform serial insertion into a parallel TTM'.
  38228.             model doCancel.
  38229.             ^nil].
  38230.     aLabel := model ttmChosen activitytree getRoot myName.
  38231.     aLabel := model ttm
  38232.                 check: aLabel
  38233.                 asNewActivityNameFor: model mynode av
  38234.                 canBe: nil.
  38235.     model ttmChosen activitytree getRoot myName: aLabel.
  38236.     cursorPosition := self sensor cursorPoint.
  38237.     activityDim := view boxForNewActivity: aLabel at: cursorPosition.
  38238.     activityDim isNil
  38239.         ifFalse: 
  38240.             [oldCursorPt := self sensor cursorPoint.
  38241.             self addingOfAVsInSerial.
  38242.             self addingOfDVs: (model duplicateOption at: 1).
  38243.             self addingOfChannels.
  38244.             self combineStateFormulas.
  38245.             self combineInitialConditions.
  38246.             newNode := self addingActivitiesInSerial.
  38247.             self addingTransitionsInSerial.
  38248.             model mynode hasAV = false & (model mynode collectionType ~= #parallel)
  38249.                 ifTrue: 
  38250.                     [avName := '1'.
  38251.                     [(model ttm aValidVariableName: avName)
  38252.                         = false | ((model ttm anExistingAV: avName)
  38253.                             = true)]
  38254.                         whileTrue: 
  38255.                             [aRequest := 'Please supply a unique activity variable for ' , model mynode myName , ':'.
  38256.                             self sensor cursorPoint: oldCursorPt.
  38257.                             avName := DialogView request: aRequest initialAnswer: 'X_' , model mynode myName.
  38258.                             avName isEmpty ifTrue: [avName := '1']].
  38259.                     avType := Array with: avName with: 'True'.
  38260.                     model ttm activityvariable: (avType at: 1)
  38261.                         initial: (avType at: 2).
  38262.                     model mynode selfAV: avType.
  38263.                     model mynode hasAV: true].
  38264.             newNode av: model mynode selfAV.
  38265.             newNode myBox: (Box point: cursorPosition rectangle: activityDim).
  38266.             model ttm updateSpecificIC.    "model ttm checkAllAVsStillUsed."
  38267.             ttmList changed: #avTransaction.
  38268.             ttmList changed: #curSFList.
  38269.             model doCancel.
  38270.             view displayOn: #dummy]! !
  38271.  
  38272. !EditingController methodsFor: 'performing'!
  38273. performMoveActivity
  38274.     | cursorPosition hsize vsize maxRight maxBottom intersection locationBox child siblingBox |
  38275.     cursorPosition := self sensor cursorPoint.
  38276.     hsize := model source myBox dimensions right.
  38277.     vsize := model source myBox dimensions bottom.
  38278.     maxRight := view boundary right.
  38279.     maxBottom := view boundary bottom.
  38280.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  38281.         ifTrue: 
  38282.             [intersection := false.
  38283.             locationBox := model source myBox dimensions copy moveBy: cursorPosition.
  38284.             child := model mynode left.
  38285.             [child notNil & (intersection = false)]
  38286.                 whileTrue: 
  38287.                     [child myBox notNil ifTrue: [child ~~ model source
  38288.                             ifTrue: 
  38289.                                 [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  38290.                                 intersection := locationBox intersects: siblingBox]].
  38291.                     child := child right].
  38292.             intersection
  38293.                 ifFalse: 
  38294.                     [model source myBox location: cursorPosition.
  38295.                     self reAssessTransitionsAll.
  38296.                     model doCancel.
  38297.                     view displayOn: #dummy]]! !
  38298.  
  38299. !EditingController methodsFor: 'performing'!
  38300. performMoveTransition
  38301.     | cursorPosition hsize vsize maxRight maxBottom box1 box2 points startingPt askTTM trSource trDest |
  38302.     cursorPosition := self sensor cursorPoint.
  38303.     hsize := model source myArc dimensions right.
  38304.     vsize := model source myArc dimensions bottom.
  38305.     askTTM := model ttm activitytree.
  38306.     maxRight := view boundary right.
  38307.     maxBottom := view boundary bottom.
  38308.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  38309.         ifTrue: 
  38310.             [(model visibleSourceFor: model source)
  38311.                 ifTrue: 
  38312.                     [trSource := model source startingAt.
  38313.                     model source myArc sourceMid: cursorPosition.
  38314.                     (model visibleDestFor: model source)
  38315.                         ifFalse: [(askTTM is: model source startingAt above: model source endingAt)
  38316.                                 ifTrue: [trDest := askTTM ancestorOf: model source endingAt onLevelOf: trSource]
  38317.                                 ifFalse: [trDest := nil]]].
  38318.             (model visibleDestFor: model source)
  38319.                 ifTrue: 
  38320.                     [trDest := model source endingAt.
  38321.                     model source myArc destMid: cursorPosition.
  38322.                     (model visibleSourceFor: model source)
  38323.                         ifFalse: [(askTTM is: model source endingAt above: model source startingAt)
  38324.                                 ifTrue: [trSource := askTTM ancestorOf: model source startingAt onLevelOf: trDest]
  38325.                                 ifFalse: [trSource := nil]]].
  38326.             trSource notNil & trDest notNil
  38327.                 ifTrue: 
  38328.                     [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  38329.                     trSource = trDest
  38330.                         ifTrue: [box2 := box1]
  38331.                         ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  38332.                     points := view
  38333.                                 boxPoints: box1
  38334.                                 to: box2
  38335.                                 via: cursorPosition.
  38336.                     trSource = trDest
  38337.                         ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  38338.                                         with: box1]
  38339.                         ifFalse: [startingPt := points at: 1].
  38340.                     (model visibleSourceFor: model source)
  38341.                         ifTrue: 
  38342.                             [model source myArc sourceStart: startingPt.
  38343.                             model source myArc sourceEnd: (points at: 2)].
  38344.                     (model visibleDestFor: model source)
  38345.                         ifTrue: 
  38346.                             [model source myArc destStart: startingPt.
  38347.                             model source myArc destEnd: (points at: 2)]]
  38348.                 ifFalse: [].
  38349.             model doCancel.
  38350.             view displayOn: #noUpdate]! !
  38351.  
  38352. !EditingController methodsFor: 'performing'!
  38353. performResizeActivity
  38354.     | cursorPosition current hmax vmax hmin vmin right bottom smallestPoint largestPoint intersection aBox locationBox child siblingBox |
  38355.     cursorPosition := self sensor cursorPoint.
  38356.     current := model source.
  38357.     hmax := view boundary right - current myBox location x.
  38358.     vmax := view boundary bottom - current myBox location y.
  38359.     hmin := (current myName size * 7.5) ceiling + 5.
  38360.     vmin := 20.
  38361.     smallestPoint := current myBox location x + hmin @ (current myBox location y + vmin).
  38362.     largestPoint := current myBox location x + hmax @ (current myBox location y + vmax).
  38363.     cursorPosition > smallestPoint & (cursorPosition < largestPoint)
  38364.         ifTrue: 
  38365.             [intersection := false.
  38366.             right := cursorPosition x - current myBox location x.
  38367.             bottom := cursorPosition y - current myBox location y.
  38368.             aBox := Rectangle
  38369.                         left: current myBox dimensions left
  38370.                         right: right
  38371.                         top: current myBox dimensions top
  38372.                         bottom: bottom.
  38373.             locationBox := aBox copy moveBy: current myBox location.
  38374.             child := model mynode left.
  38375.             [child notNil & (intersection = false)]
  38376.                 whileTrue: 
  38377.                     [child myBox notNil ifTrue: [child ~~ current
  38378.                             ifTrue: 
  38379.                                 [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  38380.                                 intersection := locationBox intersects: siblingBox]].
  38381.                     child := child right].
  38382.             intersection
  38383.                 ifFalse: 
  38384.                     [current myBox dimensions: aBox.
  38385.                     self reAssessTransitionsAll.
  38386.                     model doCancel.
  38387.                     view displayOn: #dummy]]! !
  38388.  
  38389. !EditingController methodsFor: 'performing'!
  38390. performSelfLoop
  38391.     | box1 points newArc newTransition myMidpt endingPt startingPt |
  38392.     myMidpt := self sensor cursorPoint.
  38393.     newTransition := model ttm transitionlist
  38394.                 addTransitionFrom: (model source at: 1)
  38395.                 to: (model source at: 1)
  38396.                 withName: (model source at: 2).
  38397.     box1 := newTransition startingAt myBox dimensions copy moveBy: newTransition startingAt myBox location.
  38398.     points := view
  38399.                 boxPoints: box1
  38400.                 to: box1
  38401.                 via: myMidpt.
  38402.     endingPt := points at: 2.
  38403.     startingPt := self selfLoopStartingPtFor: endingPt with: box1.
  38404.     newArc := Arc2
  38405.                 start: startingPt
  38406.                 end: endingPt
  38407.                 mid: myMidpt.
  38408.     newArc dimensions: (Rectangle
  38409.             left: 0
  38410.             right: (newTransition myName size * 7.5) ceiling + 5
  38411.             top: 0
  38412.             bottom: 20).
  38413.     newTransition myArc: newArc.
  38414.     model doCancel.    "view drawTransitionArcFor: newTransition"
  38415.     view displayOn: #dummy! !
  38416.  
  38417. !EditingController methodsFor: 'performing'!
  38418. performSetDefault
  38419.     | parent oldDefault |
  38420.     pointedActivity := self isInActivity: self sensor cursorPoint.
  38421.     pointedActivity isNil
  38422.         ifFalse: 
  38423.             [parent := model ttm activitytree parentOf: pointedActivity.
  38424.             parent collectionType ~= #cluster
  38425.                 ifTrue: 
  38426.                     [model doCancel.
  38427.                     ^nil].
  38428.             oldDefault := model ttm activitytree currentDefaultOf: parent.
  38429.             oldDefault default: false.
  38430.             pointedActivity default: true.
  38431.             model ttm changeDefaultForAV: (parent selfAV at: 1)
  38432.                 to: pointedActivity.
  38433.             view
  38434.                 drawActivity: oldDefault myBox dimensions
  38435.                 at: oldDefault myBox location
  38436.                 withLabel: oldDefault myName
  38437.                 isDefault: oldDefault default
  38438.                 collect: model mynode collectionType.
  38439.             view
  38440.                 drawActivity: pointedActivity myBox dimensions
  38441.                 at: pointedActivity myBox location
  38442.                 withLabel: pointedActivity myName
  38443.                 isDefault: pointedActivity default
  38444.                 collect: model mynode collectionType.
  38445.             model doCancel]! !
  38446.  
  38447. !EditingController methodsFor: 'performing'!
  38448. performZoomin
  38449.  
  38450.     pointedActivity := self isInActivity: self sensor cursorPoint.
  38451.  
  38452.     pointedActivity isNil
  38453.  
  38454.         ifFalse: 
  38455.  
  38456.             [model mynode: pointedActivity.
  38457.  
  38458.             model doCancel.
  38459.  
  38460.             view displayOn: #dummy]! !
  38461.  
  38462. !EditingController methodsFor: 'insertion of ttms'!
  38463. addingActivitiesInParallel
  38464.     "I just tack the root on to the current node of the 
  38465.     
  38466.     ttm we are editing. Should 
  38467.     
  38468.     be performed only AFTER ADDINGOFAVS"
  38469.  
  38470.     | myroot |
  38471.     myroot := model ttmChosen activitytree getRoot.
  38472.     ^model ttm activitytree addCreatedNode: myroot to: model mynode! !
  38473.  
  38474. !EditingController methodsFor: 'insertion of ttms'!
  38475. addingActivitiesInSerial
  38476.     "I just tack the root on to the current node of the      
  38477.     ttm we are editing. But first check whether there      
  38478.     will result any duplicate labelled activities. Should      
  38479.     be performed only AFTER ADDINGOFAVS"
  38480.  
  38481.     | myroot mykids count currentKid choice hsize newAVNeeded newNode avName aRequest avType |
  38482.     myroot := model ttmChosen activitytree getRoot.
  38483.     mykids := model ttmChosen activitytree listChildrenOf: myroot.
  38484.     count := 2.
  38485.     [count > mykids size]
  38486.         whileFalse: 
  38487.             [currentKid := mykids at: count.
  38488.             currentKid av = myroot av
  38489.                 ifTrue: 
  38490.                     [choice := model ttm
  38491.                                 check: currentKid myName
  38492.                                 asNewActivityNameFor: myroot av
  38493.                                 canBe: nil.
  38494.                     currentKid myName: choice.
  38495.                     hsize := (choice size * 7.5) ceiling + 5.
  38496.                     hsize > currentKid myBox dimensions right
  38497.                         ifTrue: 
  38498.                             [currentKid myBox dimensions right: hsize.
  38499.                             self reAssessTransitionsFor: currentKid from: model ttmChosen]].
  38500.             count := count + 1].
  38501.     newAVNeeded := (model ttm activitytree parentOf: model mynode)
  38502.                 ~= nil & (model mynode left = nil).
  38503.     newNode := model ttm activitytree addCreatedNode: myroot to: model mynode.
  38504.     model mynode selfAV isNil ifFalse: [newNode av: model mynode selfAV].
  38505.     "newAVNeeded = true
  38506.         ifTrue: 
  38507.             [avName := model mynode av at: 1.
  38508.             [(model ttm aValidVariableName: avName)
  38509.                 & (avName ~= (model mynode av at: 1))]
  38510.                 whileFalse: 
  38511.                     [aRequest := 'Please supply a unique activity variable for ' , newNode myName , ':'.
  38512.                     self sensor cursorPoint: oldCursorPt.
  38513.                     avName := DialogView request: aRequest initialAnswer: 'X_', model mynode myName.
  38514.                     avName isEmpty ifTrue: [avName := model mynode av at: 1]].
  38515.             avType := Array with: avName with: 'True'.
  38516.             model ttm activityvariable: (avType at: 1)
  38517.                 initial: (avType at: 2).
  38518.             model mynode selfAV: avType.
  38519.             newNode av: avType]."
  38520.     ^newNode! !
  38521.  
  38522. !EditingController methodsFor: 'insertion of ttms'!
  38523. addingOfAVsInParallel
  38524.     "Rename duplicate AVs before adding them."
  38525.  
  38526.     | ttm myAVs |
  38527.     ttm := model ttmChosen.
  38528.     myAVs := ttm activityvariable.
  38529.     self changeAVsInSet: myAVs! !
  38530.  
  38531. !EditingController methodsFor: 'insertion of ttms'!
  38532. addingOfAVsInSerial
  38533.     "First, I change the root AV to this ttm's new 
  38534.     parent's AV. Then process remaining AVs."
  38535.  
  38536.     | ttm newrootAV oldrootAV myAVs |
  38537.     ttm := model ttmChosen.
  38538.     newrootAV := model mynode av.
  38539.     oldrootAV := ttm activitytree getRoot av.
  38540.     ttm renameVariable: oldrootAV to: newrootAV.
  38541.     ttm activitytree getRoot av: newrootAV.
  38542.     myAVs := ttm activityvariable.
  38543.     self changeAVsInSet: myAVs! !
  38544.  
  38545. !EditingController methodsFor: 'insertion of ttms'!
  38546. addingOfChannels
  38547.     "For those channels that are duplicated, I give 
  38548.     
  38549.     the user the option to rename them."
  38550.  
  38551.     | ttm myChannels count currentCh aRequest response continue choice |
  38552.     ttm := model ttmChosen.
  38553.     myChannels := ttm commchannel.
  38554.     count := 1.
  38555.     [count > myChannels size]
  38556.         whileFalse: 
  38557.             [currentCh := myChannels at: count.
  38558.             (model ttm anExistingCh: (currentCh at: 1) asString)
  38559.                 ifTrue: 
  38560.                     [aRequest := 'A communication channel ' , (currentCh at: 1) asString , ' already exists.' , (String with: Character cr) , 'Do you wish to rename it?'.
  38561.                     self sensor cursorPoint: oldCursorPt.
  38562.                     response := DialogView confirm: aRequest.
  38563.                     response = true
  38564.                         ifTrue: 
  38565.                             [continue := false.
  38566.                             [continue = false]
  38567.                                 whileTrue: 
  38568.                                     [aRequest := 'Please supply a new name:'.
  38569.                                     self sensor cursorPoint: oldCursorPt.
  38570.                                     choice := DialogView request: aRequest.
  38571.                                     choice isEmpty ifFalse: [continue := (model ttm anExistingCh: choice) not]].
  38572.                             ttm renameVariable: (currentCh at: 1)
  38573.                                 to: choice.
  38574.                             model ttm commchannel: choice]]
  38575.                 ifFalse: [model ttm commchannel: (currentCh at: 1) copy].
  38576.             count := count + 1]! !
  38577.  
  38578. !EditingController methodsFor: 'insertion of ttms'!
  38579. addingOfDVs: userOption 
  38580.     "For those DVs that are duplicated, I give 
  38581.     
  38582.     the user the option to rename them."
  38583.  
  38584.     | ttm myDVs count currentDV aRequest response continue choice |
  38585.     ttm := model ttmChosen.
  38586.     myDVs := ttm datavariable.
  38587.     count := 1.
  38588.     [count > myDVs size]
  38589.         whileFalse: 
  38590.             [currentDV := myDVs at: count.
  38591.             (model ttm anExistingDV: (currentDV at: 1) asString)
  38592.                 ifTrue: 
  38593.                     [userOption = #ALL
  38594.                         ifTrue: [response := false]
  38595.                         ifFalse: 
  38596.                             [aRequest := 'A data variable ' , (currentDV at: 1) asString , ' already exists.' , (String with: Character cr) , 'Do you wish to rename it?'.
  38597.                             self sensor cursorPoint: oldCursorPt.
  38598.                             response := DialogView confirm: aRequest].
  38599.                     response = true
  38600.                         ifTrue: 
  38601.                             [continue := false.
  38602.                             [continue = false]
  38603.                                 whileTrue: 
  38604.                                     [aRequest := 'Please supply a new name:'.
  38605.                                     self sensor cursorPoint: oldCursorPt.
  38606.                                     choice := DialogView request: aRequest.
  38607.                                     choice isEmpty ifFalse: [continue := (model ttm anExistingDV: choice) not]].
  38608.                             ttm renameVariable: (currentDV at: 1)
  38609.                                 to: choice.
  38610.                             model ttm
  38611.                                 datavariable: choice
  38612.                                 lrange: (currentDV at: 2) copy
  38613.                                 hrange: (currentDV at: 3) copy
  38614.                                 initial: (currentDV at: 4) copy]]
  38615.                 ifFalse: [model ttm
  38616.                         datavariable: (currentDV at: 1) copy
  38617.                         lrange: (currentDV at: 2) copy
  38618.                         hrange: (currentDV at: 3) copy
  38619.                         initial: (currentDV at: 4) copy].
  38620.             count := count + 1]! !
  38621.  
  38622. !EditingController methodsFor: 'insertion of ttms'!
  38623. addingTransitionsInParallel: userOption 
  38624.     "MUST DEAL WITH COMMUNICATION!!"
  38625.     "call me AFTER ADDINGACTIVITIES"
  38626.     "Communication pairs should be taken 
  38627.     
  38628.     care of. Also, should prompt to see that 
  38629.     
  38630.     duplicates SHOULD be shared transitions 
  38631.     
  38632.     ore renamed. Other than that - nothing needs to 
  38633.     
  38634.     be done."
  38635.  
  38636.     | myTrList |
  38637.     myTrList := model ttmChosen transitionlist.
  38638.     myTrList do: [:currentTr | (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0 ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  38639.                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  38640.                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]].
  38641.     myTrList do: [:currentTr | model ttm transitionlist add: currentTr]! !
  38642.  
  38643. !EditingController methodsFor: 'insertion of ttms'!
  38644. addingTransitionsInParallelNew: userOption 
  38645.     "MUST DEAL WITH COMMUNICATION!!"
  38646.     "call me AFTER ADDINGACTIVITIES"
  38647.     "Communication pairs should be taken 
  38648.     
  38649.     care of. Also, should prompt to see that 
  38650.     
  38651.     duplicates SHOULD be shared transitions 
  38652.     
  38653.     ore renamed. Other than that - nothing needs to 
  38654.     
  38655.     be done."
  38656.  
  38657.     | myTrList |
  38658.     myTrList := model ttmChosen transitionlist.
  38659.     myTrList do: [:currentTr | (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0 ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  38660.                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  38661.                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]].
  38662.     myTrList do: [:currentTr | model ttm transitionlist add: currentTr]! !
  38663.  
  38664. !EditingController methodsFor: 'insertion of ttms'!
  38665. addingTransitionsInParallelOld: userOption 
  38666.     "MUST DEAL WITH COMMUNICATION!!"
  38667.     "call me AFTER ADDINGACTIVITIES"
  38668.     "Communication pairs should be taken 
  38669.     
  38670.     care of. Also, should prompt to see that 
  38671.     
  38672.     duplicates SHOULD be shared transitions 
  38673.     
  38674.     ore renamed. Other than that - nothing needs to 
  38675.     
  38676.     be done."
  38677.  
  38678.     | count myTrList currentTr aRequest response newname |
  38679.     count := 1.
  38680.     myTrList := model ttmChosen transitionlist.
  38681.     [count > myTrList size]
  38682.         whileFalse: 
  38683.             [currentTr := myTrList at: count.
  38684.             (model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0
  38685.                 ifTrue: 
  38686.                     [userOption = #ALL
  38687.                         ifTrue: [response := true]
  38688.                         ifFalse: 
  38689.                             [aRequest := 'A transition named ' , currentTr myName , ' already exists.' , (String with: Character cr) , 'Make it shared transition?'.
  38690.                             self sensor cursorPoint: oldCursorPt.
  38691.                             response := DialogView confirm: aRequest].
  38692.                     response = true
  38693.                         ifTrue: [(currentTr myAction findString: '?' startingAt: 1)
  38694.                                 ~= 0 | ((currentTr myAction findString: '!!' startingAt: 1)
  38695.                                     ~= 0) ifTrue: [currentTr myAction: (self performCommunicationOn: currentTr)]]
  38696.                         ifFalse: [[(model ttm transitionlist TransitionsNamed: currentTr myName) size ~= 0]
  38697.                                 whileTrue: 
  38698.                                     [aRequest := 'Please supply new transition name:'.
  38699.                                     self sensor cursorPoint: oldCursorPt.
  38700.                                     newname := DialogView request: aRequest.
  38701.                                     newname isEmpty | (TTMList aUsefulTrLabel: newname) not ifFalse: [currentTr myName: newname]]]].
  38702.             count := count + 1].
  38703.     count := 1.
  38704.     [count > myTrList size]
  38705.         whileFalse: 
  38706.             [currentTr := myTrList at: count.
  38707.             model ttm transitionlist add: currentTr.
  38708.             count := count + 1]! !
  38709.  
  38710. !EditingController methodsFor: 'insertion of ttms'!
  38711. addingTransitionsInSerial
  38712.     "I just tack all the transitions on to the 
  38713.     
  38714.     transitionlist of the ttm we are editing . 
  38715.     
  38716.     There should be NO duplicate transition labels. 
  38717.     
  38718.     Should be called AFTER ADDINGACTIVITIES"
  38719.  
  38720.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  38721.     count := 1.
  38722.     myTrList := model ttmChosen transitionlist.
  38723.     [count > myTrList size]
  38724.         whileFalse: 
  38725.             [currentTr := myTrList at: count.
  38726.             ""
  38727.             model ttm transitionlist add: currentTr.
  38728.             count := count + 1]! !
  38729.  
  38730. !EditingController methodsFor: 'insertion of ttms'!
  38731. addingTransitionsInSerialNew
  38732.     "I just tack all the transitions on to the 
  38733.     
  38734.     transitionlist of the ttm we are editing . 
  38735.     
  38736.     There should be NO duplicate transition labels. 
  38737.     
  38738.     Should be called AFTER ADDINGACTIVITIES"
  38739.  
  38740.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  38741.     count := 1.
  38742.     myTrList := model ttmChosen transitionlist.
  38743.     [count > myTrList size]
  38744.         whileFalse: 
  38745.             [currentTr := myTrList at: count.
  38746.             "(model ttm transitionlist TransitionsNamed: currentTr myName) size = 0
  38747.                 ifFalse: 
  38748.                     [checkCount := 1.
  38749.                     duplicate := false.
  38750.                     [checkCount > myTrList size]
  38751.                         whileFalse: 
  38752.                             [count ~= checkCount ifTrue: [(myTrList at: checkCount) myName = currentTr myName ifTrue: [duplicate := true]].
  38753.                             checkCount := checkCount + 1].
  38754.                     duplicate = false
  38755.                         ifTrue: 
  38756.                             [continue := false.
  38757.                             errorname := currentTr myName.
  38758.                             [continue = false]
  38759.                                 whileTrue: 
  38760.                                     [aRequest := 'A transition named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  38761.                                     self sensor cursorPoint: oldCursorPt.
  38762.                                     choice := DialogView request: aRequest.
  38763.                                     choice isEmpty ifFalse: [(TTMList aUsefulTrLabel: choice asString)
  38764.                                             ifTrue: 
  38765.                                                 [continue := (model ttm transitionlist TransitionsNamed: choice) size = 0.
  38766.                                                 continue = false ifTrue: [errorname := choice]]]].
  38767.                             currentTr myName: choice]]."
  38768.             model ttm transitionlist add: currentTr.
  38769.             count := count + 1]! !
  38770.  
  38771. !EditingController methodsFor: 'insertion of ttms'!
  38772. addingTransitionsInSerialOld
  38773.     "I just tack all the transitions on to the 
  38774.     
  38775.     transitionlist of the ttm we are editing . 
  38776.     
  38777.     There should be NO duplicate transition labels. 
  38778.     
  38779.     Should be called AFTER ADDINGACTIVITIES"
  38780.  
  38781.     | count myTrList currentTr continue aRequest choice errorname checkCount duplicate |
  38782.     count := 1.
  38783.     myTrList := model ttmChosen transitionlist.
  38784.     [count > myTrList size]
  38785.         whileFalse: 
  38786.             [currentTr := myTrList at: count.
  38787.             (model ttm transitionlist TransitionsNamed: currentTr myName) size = 0
  38788.                 ifFalse: 
  38789.                     [checkCount := 1.
  38790.                     duplicate := false.
  38791.                     [checkCount > myTrList size]
  38792.                         whileFalse: 
  38793.                             [count ~= checkCount ifTrue: [(myTrList at: checkCount) myName = currentTr myName ifTrue: [duplicate := true]].
  38794.                             checkCount := checkCount + 1].
  38795.                     duplicate = false
  38796.                         ifTrue: 
  38797.                             [continue := false.
  38798.                             errorname := currentTr myName.
  38799.                             [continue = false]
  38800.                                 whileTrue: 
  38801.                                     [aRequest := 'A transition named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  38802.                                     self sensor cursorPoint: oldCursorPt.
  38803.                                     choice := DialogView request: aRequest.
  38804.                                     choice isEmpty ifFalse: [(TTMList aUsefulTrLabel: choice asString)
  38805.                                             ifTrue: 
  38806.                                                 [continue := (model ttm transitionlist TransitionsNamed: choice) size = 0.
  38807.                                                 continue = false ifTrue: [errorname := choice]]]].
  38808.                             currentTr myName: choice]].
  38809.             model ttm transitionlist add: currentTr.
  38810.             count := count + 1]! !
  38811.  
  38812. !EditingController methodsFor: 'insertion of ttms'!
  38813. changeAVsInSet: myAVs 
  38814.     "Go through myAvs. If they are duplicated, 
  38815.     
  38816.     then demand a new name for them before 
  38817.     
  38818.     adding them."
  38819.  
  38820.     | ttm count currentAV continue aRequest choice |
  38821.     ttm := model ttmChosen.
  38822.     count := 1.
  38823.     [count > myAVs size]
  38824.         whileFalse: 
  38825.             [currentAV := myAVs at: count.
  38826.             (model ttm anExistingAV: (currentAV at: 1) asString)
  38827.                 ifTrue: 
  38828.                     [continue := false.
  38829.                     [continue = false]
  38830.                         whileTrue: 
  38831.                             [aRequest := 'An activity variable ' , (currentAV at: 1) asString , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  38832.                             self sensor cursorPoint: oldCursorPt.
  38833.                             choice := DialogView request: aRequest.
  38834.                             choice isEmpty ifFalse: [continue := model ttm aValidVariableName: choice]].
  38835.                     ttm renameActivityVariable: (currentAV at: 1)
  38836.                         to: choice.
  38837.                     ttm renameVariable: (currentAV at: 1)
  38838.                         to: choice.
  38839.                     currentAV at: 1 put: choice].
  38840.             model ttm activityvariable: (currentAV at: 1)
  38841.                 initial: (currentAV at: 2).
  38842.             count := count + 1]! !
  38843.  
  38844. !EditingController methodsFor: 'insertion of ttms'!
  38845. combineInitialConditions
  38846.     | chosenIC chosenSIC count number contents |
  38847.     chosenIC := model ttmChosen initialcondition copy.
  38848.     chosenIC = 'nil'
  38849.         ifFalse: 
  38850.             [model ttm initialcondition = 'nil' ifFalse: [chosenIC := model ttm initialcondition copy , (String with: Character cr) , ',(' , chosenIC , ')'].
  38851.             model ttm initialcondition: chosenIC].
  38852.     chosenSIC := model ttmChosen specificIC.
  38853.     count := 1.
  38854.     [count > chosenSIC size]
  38855.         whileFalse: 
  38856.             [number := ((chosenSIC at: count)
  38857.                         at: 1) copy.
  38858.             contents := ((chosenSIC at: count)
  38859.                         at: 2) copy.
  38860.             model ttm specificIC add: (Array with: number with: contents).
  38861.             count := count + 1]! !
  38862.  
  38863. !EditingController methodsFor: 'insertion of ttms'!
  38864. combineStateFormulas
  38865.     | chosenSF count number contents continue ans c current |
  38866.     chosenSF := model ttmChosen stateFormulas.
  38867.     count := 1.
  38868.     [count > chosenSF size]
  38869.         whileFalse: 
  38870.             [number := ((chosenSF at: count)
  38871.                         at: 1) copy.
  38872.             contents := ((chosenSF at: count)
  38873.                         at: 2) copy.
  38874.             continue := 0.
  38875.             [continue = 0]
  38876.                 whileTrue: [(TTMList aUsefulActLabel: number)
  38877.                         ifTrue: [continue := 2]
  38878.                         ifFalse: 
  38879.                             [ans := DialogView confirm: 'SF number ' , number , ' is already in use' , (String with: Character cr) , 'combine the SFs?'.
  38880.                             ans = true
  38881.                                 ifTrue: 
  38882.                                     [c := 1.
  38883.                                     [c > model ttm stateFormulas size]
  38884.                                         whileFalse: 
  38885.                                             [current := model ttm stateFormulas at: c.
  38886.                                             number = (current at: 1) & (contents ~= 'nil')
  38887.                                                 ifTrue: 
  38888.                                                     [(current at: 2)
  38889.                                                         ~= 'nil' ifTrue: [contents := (current at: 2)
  38890.                                                                     , (String with: Character cr) , ',(' , contents , ')'].
  38891.                                                     current at: 2 put: contents.
  38892.                                                     model ttm stateFormulas at: c put: current].
  38893.                                             c := c + 1].
  38894.                                     continue := 1]
  38895.                                 ifFalse: 
  38896.                                     [ans := DialogView request: 'Please provide a new number for the SF:'.
  38897.                                     ans isEmpty not & (TTMList aUsefulActLabel: ans)
  38898.                                         ifTrue: 
  38899.                                             [number := ans.
  38900.                                             continue := 2]]]].
  38901.             continue = 2 ifTrue: [model ttm stateFormulas add: (Array with: number with: contents)].
  38902.             count := count + 1]! !
  38903.  
  38904. !EditingController methodsFor: 'insertion of ttms'!
  38905. performCommunicationOn: currentTr 
  38906.     "Given a transition that has a ? or !! in its 
  38907.     
  38908.     action & there exists a shared transition, 
  38909.     
  38910.     we want to replace a pair of 'C?X C!!Y' 
  38911.     
  38912.     with 'X:Y'. We change the shared transition 
  38913.     
  38914.     action and return the modified currentTr 
  38915.     
  38916.     action. We might need to do this SEVERAL 
  38917.     
  38918.     times for the same currentTr"
  38919.  
  38920.     | type action location trlist match count c channel exit pattern s e matchAction e1 segment1 segment2 replacement |
  38921.     action := TTMList removeAllBlanksFrom: currentTr myAction.
  38922.     exit := (action findString: '?' startingAt: 1)
  38923.                 = 0 & ((action findString: '!!' startingAt: 1)
  38924.                     = 0).
  38925.     [exit = false]
  38926.         whileTrue: 
  38927.             [trlist := model ttm transitionlist TransitionsNamed: currentTr myName.
  38928.             location := action findString: '?' startingAt: 1.
  38929.             location = 0
  38930.                 ifTrue: 
  38931.                     [type := #send.
  38932.                     location := action findString: '!!' startingAt: 1]
  38933.                 ifFalse: [type := #receive].
  38934.             c := location - 1.
  38935.             [c > 1 & ((action at: c) isAlphaNumeric | ((action at: c)
  38936.                         = $_))]
  38937.                 whileTrue: [c := c - 1].
  38938.             c = 1 ifFalse: [c := c + 1].
  38939.             channel := action copyFrom: c to: location - 1.
  38940.             e1 := location + 1.
  38941.             [e1 < action size & ((action at: e1) isAlphaNumeric | ((action at: e1)
  38942.                         = $_))]
  38943.                 whileTrue: [e1 := e1 + 1].
  38944.             e1 = action size ifFalse: [e1 := e1 - 1].
  38945.             segment1 := action copyFrom: location + 1 to: e1.
  38946.             match := nil.
  38947.             type = #receive
  38948.                 ifTrue: [pattern := channel , '!!']
  38949.                 ifFalse: [pattern := channel , '?'].
  38950.             count := 1.
  38951.             [count > trlist size | match notNil]
  38952.                 whileFalse: 
  38953.                     [((trlist at: count) myAction findString: pattern startingAt: 1)
  38954.                         ~= 0 ifTrue: [match := trlist at: count].
  38955.                     count := count + 1].
  38956.             match notNil
  38957.                 ifTrue: 
  38958.                     [matchAction := TTMList removeAllBlanksFrom: match myAction copy.
  38959.                     s := matchAction findString: pattern startingAt: 1.
  38960.                     e := s + pattern size.
  38961.                     [e < matchAction size & (matchAction at: e) isAlphaNumeric]
  38962.                         whileTrue: [e := e + 1].
  38963.                     e = matchAction size ifFalse: [e := e - 1].
  38964.                     segment2 := matchAction copyFrom: s + pattern size to: e.
  38965.                     s = 1 ifFalse: [s := s - 1]
  38966.                         ifTrue: [e = matchAction size ifFalse: [e := e + 1]].
  38967.                     match myAction: (matchAction
  38968.                             changeFrom: s
  38969.                             to: e
  38970.                             with: '').
  38971.                     match myAction isEmpty ifTrue: [match myAction: 'nil'].
  38972.                     type = #receive
  38973.                         ifTrue: [replacement := segment1 , ':' , segment2]
  38974.                         ifFalse: [replacement := segment2 , ':' , segment1].
  38975.                     action := action
  38976.                                 changeFrom: c
  38977.                                 to: e1
  38978.                                 with: replacement].
  38979.             match isNil
  38980.                 ifTrue: [exit := true]
  38981.                 ifFalse: [exit := (action findString: '?' startingAt: 1)
  38982.                                 = 0 & ((action findString: '!!' startingAt: 1)
  38983.                                     = 0)]].
  38984.     ^action! !
  38985.  
  38986. !EditingController methodsFor: 'private performing'!
  38987. reAssessTransitionsAll
  38988.     "Once an activity is moved or resized, the 
  38989.     
  38990.     Transition arcs may have to be repositioned."
  38991.  
  38992.     | trList supplement count currentTr trSource trDest box1 box2 points startingPt m askTTM anActivity |
  38993.     askTTM := model ttm activitytree.
  38994.     anActivity := model mynode left.
  38995.     [anActivity notNil]
  38996.         whileTrue: 
  38997.             [trList := model ttm transitionlist TransitionsStartingAt: anActivity.
  38998.             supplement := model ttm transitionlist TransitionsEndingAt: anActivity.
  38999.             count := 1.
  39000.             [count > supplement size]
  39001.                 whileFalse: 
  39002.                     [(trList includes: (supplement at: count))
  39003.                         ifFalse: [trList add: (supplement at: count)].
  39004.                     count := count + 1].
  39005.             count := 1.
  39006.             [count > trList size]
  39007.                 whileFalse: 
  39008.                     [currentTr := trList at: count.
  39009.                     (model visibleSourceFor: currentTr)
  39010.                         ifTrue: 
  39011.                             [trSource := currentTr startingAt.
  39012.                             m := currentTr myArc sourceMid.
  39013.                             (model visibleDestFor: currentTr)
  39014.                                 ifFalse: [(askTTM is: currentTr startingAt above: currentTr endingAt)
  39015.                                         ifTrue: [trDest := askTTM ancestorOf: currentTr endingAt onLevelOf: trSource]
  39016.                                         ifFalse: [trDest := nil]]].
  39017.                     (model visibleDestFor: currentTr)
  39018.                         ifTrue: 
  39019.                             [trDest := currentTr endingAt.
  39020.                             m := currentTr myArc destMid.
  39021.                             (model visibleSourceFor: currentTr)
  39022.                                 ifFalse: [(askTTM is: currentTr endingAt above: currentTr startingAt)
  39023.                                         ifTrue: [trSource := askTTM ancestorOf: currentTr startingAt onLevelOf: trDest]
  39024.                                         ifFalse: [trSource := nil]]].
  39025.                     trSource notNil & trDest notNil
  39026.                         ifTrue: 
  39027.                             [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  39028.                             trSource = trDest
  39029.                                 ifTrue: [box2 := box1]
  39030.                                 ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  39031.                             points := view
  39032.                                         boxPoints: box1
  39033.                                         to: box2
  39034.                                         via: m.
  39035.                             trSource = trDest
  39036.                                 ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  39037.                                                 with: box1]
  39038.                                 ifFalse: [startingPt := points at: 1].
  39039.                             (model visibleSourceFor: currentTr)
  39040.                                 ifTrue: 
  39041.                                     [currentTr myArc sourceStart: startingPt.
  39042.                                     currentTr myArc sourceEnd: (points at: 2)].
  39043.                             (model visibleDestFor: currentTr)
  39044.                                 ifTrue: 
  39045.                                     [currentTr myArc destStart: startingPt.
  39046.                                     currentTr myArc destEnd: (points at: 2)]]
  39047.                         ifFalse: [trSource isNil & trDest isNil
  39048.                                 ifTrue: []
  39049.                                 ifFalse: [trSource isNil
  39050.                                         ifTrue: 
  39051.                                             [box2 := trDest myBox dimensions copy moveBy: trDest myBox location.
  39052.                                             points := view
  39053.                                                         boxPointsPoint: currentTr myArc destStart
  39054.                                                         to: box2
  39055.                                                         via: m.
  39056.                                             currentTr myArc destEnd: (points at: 2)]
  39057.                                         ifFalse: 
  39058.                                             [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  39059.                                             points := view
  39060.                                                         boxPoints: box1
  39061.                                                         toPoint: currentTr myArc sourceEnd
  39062.                                                         via: m.
  39063.                                             currentTr myArc sourceStart: (points at: 1)]]].
  39064.                     count := count + 1].
  39065.             anActivity := anActivity right]! !
  39066.  
  39067. !EditingController methodsFor: 'private performing'!
  39068. reAssessTransitionsFor: anActivity from: ttm 
  39069.     "Once an activity is moved or resized, the 
  39070.     
  39071.     Transition arcs may have to be repositioned."
  39072.  
  39073.     | trList supplement count currentTr trSource trDest box1 box2 points startingPt m askTTM |
  39074.     askTTM := ttm activitytree.
  39075.     trList := ttm transitionlist TransitionsStartingAt: anActivity.
  39076.     supplement := ttm transitionlist TransitionsEndingAt: anActivity.
  39077.     count := 1.
  39078.     [count > supplement size]
  39079.         whileFalse: 
  39080.             [(trList includes: (supplement at: count))
  39081.                 ifFalse: [trList add: (supplement at: count)].
  39082.             count := count + 1].
  39083.     count := 1.
  39084.     [count > trList size]
  39085.         whileFalse: 
  39086.             [currentTr := trList at: count.
  39087.             (model visibleSourceFor: currentTr)
  39088.                 ifTrue: 
  39089.                     [trSource := currentTr startingAt.
  39090.                     m := currentTr myArc sourceMid.
  39091.                     (model visibleDestFor: currentTr)
  39092.                         ifFalse: [(askTTM is: currentTr startingAt above: currentTr endingAt)
  39093.                                 ifTrue: [trDest := askTTM ancestorOf: currentTr endingAt onLevelOf: trSource]
  39094.                                 ifFalse: [trDest := nil]]].
  39095.             (model visibleDestFor: currentTr)
  39096.                 ifTrue: 
  39097.                     [trDest := currentTr endingAt.
  39098.                     m := currentTr myArc destMid.
  39099.                     (model visibleSourceFor: currentTr)
  39100.                         ifFalse: [(askTTM is: currentTr endingAt above: currentTr startingAt)
  39101.                                 ifTrue: [trSource := askTTM ancestorOf: currentTr startingAt onLevelOf: trDest]
  39102.                                 ifFalse: [trSource := nil]]].
  39103.             trSource notNil & trDest notNil
  39104.                 ifTrue: 
  39105.                     [box1 := trSource myBox dimensions copy moveBy: trSource myBox location.
  39106.                     trSource = trDest
  39107.                         ifTrue: [box2 := box1]
  39108.                         ifFalse: [box2 := trDest myBox dimensions copy moveBy: trDest myBox location].
  39109.                     points := view
  39110.                                 boxPoints: box1
  39111.                                 to: box2
  39112.                                 via: m.
  39113.                     trSource = trDest
  39114.                         ifTrue: [startingPt := self selfLoopStartingPtFor: (points at: 2)
  39115.                                         with: box1]
  39116.                         ifFalse: [startingPt := points at: 1].
  39117.                     (model visibleSourceFor: currentTr)
  39118.                         ifTrue: 
  39119.                             [currentTr myArc sourceStart: startingPt.
  39120.                             currentTr myArc sourceEnd: (points at: 2)].
  39121.                     (model visibleDestFor: currentTr)
  39122.                         ifTrue: 
  39123.                             [currentTr myArc destStart: startingPt.
  39124.                             currentTr myArc destEnd: (points at: 2)]]
  39125.                 ifFalse: [].
  39126.             count := count + 1]! !
  39127.  
  39128. !EditingController methodsFor: 'private performing'!
  39129. selfLoopStartingPtFor: endingPt with: box1 
  39130.     | startingPt |
  39131.     endingPt x = box1 topLeft x | (endingPt y = box1 topLeft y)
  39132.         ifTrue: [startingPt := box1 topLeft]
  39133.         ifFalse: [startingPt := box1 bottomRight].
  39134.     ^startingPt! !
  39135.  
  39136. !EditingController methodsFor: 'variable access'!
  39137. currentTTM: aTTM 
  39138.     currentTTM := aTTM! !
  39139.  
  39140. !EditingController methodsFor: 'variable access'!
  39141. ttmList: aTTMList 
  39142.     ttmList := aTTMList! !
  39143.  
  39144. Object subclass: #BuildDummy
  39145.     instanceVariableNames: ''
  39146.     classVariableNames: ''
  39147.     poolDictionaries: ''
  39148.     category: 'Build'!
  39149.  
  39150. !BuildDummy methodsFor: 'ignored'!
  39151. reportFor: ignore! !
  39152.  
  39153. Object subclass: #Arc2
  39154.     instanceVariableNames: 'dimensions sourceStart destStart sourceEnd destEnd sourceMid destMid sourceArrow destArrow '
  39155.     classVariableNames: ''
  39156.     poolDictionaries: ''
  39157.     category: 'Build'!
  39158.  
  39159. !Arc2 methodsFor: 'dest accessing'!
  39160. destArrow
  39161.  
  39162.      ^destArrow! !
  39163.  
  39164. !Arc2 methodsFor: 'dest accessing'!
  39165. destArrow: newArrow 
  39166.  
  39167.      destArrow := newArrow! !
  39168.  
  39169. !Arc2 methodsFor: 'dest accessing'!
  39170. destEnd
  39171.  
  39172.      ^destEnd! !
  39173.  
  39174. !Arc2 methodsFor: 'dest accessing'!
  39175. destEnd: newEnd
  39176.  
  39177.      destEnd := newEnd! !
  39178.  
  39179. !Arc2 methodsFor: 'dest accessing'!
  39180. destMid
  39181.  
  39182.      ^destMid! !
  39183.  
  39184. !Arc2 methodsFor: 'dest accessing'!
  39185. destMid: newMid
  39186.  
  39187.      destMid := newMid! !
  39188.  
  39189. !Arc2 methodsFor: 'dest accessing'!
  39190. destStart
  39191.  
  39192.      ^destStart! !
  39193.  
  39194. !Arc2 methodsFor: 'dest accessing'!
  39195. destStart: newStart
  39196.  
  39197.      destStart := newStart! !
  39198.  
  39199. !Arc2 methodsFor: 'source accessing'!
  39200. sourceArrow
  39201.  
  39202. ^sourceArrow! !
  39203.  
  39204. !Arc2 methodsFor: 'source accessing'!
  39205. sourceArrow: newArrow 
  39206.  
  39207.      sourceArrow := newArrow! !
  39208.  
  39209. !Arc2 methodsFor: 'source accessing'!
  39210. sourceEnd
  39211.  
  39212.      ^sourceEnd! !
  39213.  
  39214. !Arc2 methodsFor: 'source accessing'!
  39215. sourceEnd: newend
  39216.  
  39217.      sourceEnd := newend! !
  39218.  
  39219. !Arc2 methodsFor: 'source accessing'!
  39220. sourceMid
  39221.  
  39222.      ^sourceMid! !
  39223.  
  39224. !Arc2 methodsFor: 'source accessing'!
  39225. sourceMid: newmid
  39226.  
  39227.      sourceMid := newmid! !
  39228.  
  39229. !Arc2 methodsFor: 'source accessing'!
  39230. sourceStart
  39231.  
  39232.      ^sourceStart! !
  39233.  
  39234. !Arc2 methodsFor: 'source accessing'!
  39235. sourceStart: newstart
  39236.  
  39237.      sourceStart := newstart! !
  39238.  
  39239. !Arc2 methodsFor: 'accessing'!
  39240. assignFrom: startPt through: midPt to: endPt
  39241.  
  39242.      self sourceStart: startPt.
  39243.  
  39244.       self destStart: startPt.
  39245.  
  39246.      self sourceEnd: endPt.
  39247.  
  39248.       self destEnd: endPt.
  39249.  
  39250.      self sourceMid: midPt.
  39251.  
  39252.       self destMid: midPt.
  39253.  
  39254.       self sourceArrow: 5.
  39255.  
  39256.       self destArrow: 5.! !
  39257.  
  39258. !Arc2 methodsFor: 'accessing'!
  39259. dimensions
  39260.  
  39261.      ^dimensions! !
  39262.  
  39263. !Arc2 methodsFor: 'accessing'!
  39264. dimensions: newDimensions 
  39265.  
  39266.      dimensions := newDimensions! !
  39267.  
  39268. !Arc2 methodsFor: 'copying'!
  39269. makeCopy
  39270.     | temp |
  39271.     temp := self copy.
  39272.     temp sourceArrow: self sourceArrow copy.
  39273.     temp sourceEnd: self sourceEnd copy.
  39274.     temp sourceStart: self sourceStart copy.
  39275.     temp sourceMid: self sourceMid copy.
  39276.     ^temp! !
  39277.  
  39278. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  39279.  
  39280. Arc2 class
  39281.     instanceVariableNames: ''!
  39282.  
  39283. !Arc2 class methodsFor: 'instance creation'!
  39284. start: startingPt end: endingPt mid: midPt 
  39285.     "default values for shade, depth and insides 
  39286.     
  39287.     are supplied automatically."
  39288.  
  39289.     | aBox |
  39290.     aBox := self new.
  39291.     aBox dimensions: nil.
  39292.     aBox
  39293.         assignFrom: startingPt
  39294.         through: midPt
  39295.         to: endingPt.
  39296.     ^aBox! !
  39297.  
  39298. LabeledBooleanView subclass: #PushButton
  39299.     instanceVariableNames: ''
  39300.     classVariableNames: ''
  39301.     poolDictionaries: ''
  39302.     category: 'Build'!
  39303.  
  39304. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  39305.  
  39306. PushButton class
  39307.     instanceVariableNames: ''!
  39308.  
  39309. !PushButton class methodsFor: 'instance creation'!
  39310. named: buttonName 
  39311.     | button |
  39312.     button := LabeledBooleanView new.
  39313.     button beTrigger.
  39314.     button controller beTriggerOnUp.
  39315.     button beVisual: buttonName asComposedText.
  39316.     ^button! !
  39317.  
  39318. Model subclass: #TTMList
  39319.     instanceVariableNames: 'variableSet models selection dvSelection avSelection icSelection chSelection sfSelection fileSelection currentDir dirContents temporary editedtrlist enumerateActivities temporaryTTM activityStack tempStack currentDirectory '
  39320.     classVariableNames: ''
  39321.     poolDictionaries: ''
  39322.     category: 'Build'!
  39323. TTMList comment:
  39324. 'This is the root class for the Model Builder Program.
  39325.  
  39326. To run the program select: "TTMList open" and doit.
  39327.  
  39328.  
  39329.  
  39330. models -- contains the list of TTMs. Each one is an element
  39331.  
  39332.                   of the class TTM.
  39333.  
  39334. -----------------------------------------------
  39335.  
  39336. In the class section of TTMList are sets of general functions.
  39337.  
  39338. They were put here for easy access even though they really have
  39339.  
  39340. nothing to do with the TTMList class itself. These sections are:
  39341.  
  39342.  
  39343.  
  39344. type conversions -- routines for converting from one object to
  39345.  
  39346.                                 another.
  39347.  
  39348.  
  39349.  
  39350. dialog windows  -- routines used in manipulating windows.
  39351.  
  39352.  
  39353.  
  39354. strings                -- routines for manipulating string
  39355.  
  39356. objects.
  39357.  
  39358.                                And for testing string objects.
  39359.  
  39360.               '!
  39361.  
  39362. TTMList comment:
  39363. 'This is the root class for the Model Builder Program.
  39364.  
  39365. To run the program select: "TTMList open" and doit.
  39366.  
  39367.  
  39368.  
  39369. models -- contains the list of TTMs. Each one is an element
  39370.  
  39371.                   of the class TTM.
  39372.  
  39373. -----------------------------------------------
  39374.  
  39375. In the class section of TTMList are sets of general functions.
  39376.  
  39377. They were put here for easy access even though they really have
  39378.  
  39379. nothing to do with the TTMList class itself. These sections are:
  39380.  
  39381.  
  39382.  
  39383. type conversions -- routines for converting from one object to
  39384.  
  39385.                                 another.
  39386.  
  39387.  
  39388.  
  39389. dialog windows  -- routines used in manipulating windows.
  39390.  
  39391.  
  39392.  
  39393. strings                -- routines for manipulating string
  39394.  
  39395. objects.
  39396.  
  39397.                                And for testing string objects.
  39398.  
  39399.               '!
  39400.  
  39401. !TTMList methodsFor: 'initialize-release'!
  39402. initialize
  39403.     models := OrderedCollection new.
  39404.     selection := nil.
  39405.     enumerateActivities := 0! !
  39406.  
  39407. !TTMList methodsFor: 'code output'!
  39408. codeAsProlog3
  39409.     "output code in the prolog3 format"
  39410.  
  39411.     | aStream ending |
  39412.     aStream := self openFileFor: #prolog3 as: #code.
  39413.     aStream = nil
  39414.         ifFalse: 
  39415.             [self variablesInitialize.
  39416.             self enumerationCommentOn: aStream.
  39417.             selection fileHeading: 'Mapping and Types:' on: aStream.
  39418.             selection fileThis: self makeMapForP3 on: aStream.
  39419.             selection fileThis: (self makeTypesFor: #prolog3)
  39420.                 on: aStream.
  39421.             selection fileHeading: 'Initial Condition:' on: aStream.
  39422.             selection fileThis: (self makeInitialConditionFor: #prolog3)
  39423.                 on: aStream.
  39424.             selection fileHeading: 'Enabling Conditions:' on: aStream.
  39425.             selection fileThis: (self makeGuardsFor: #prolog3)
  39426.                 on: aStream.
  39427.             selection fileHeading: 'Transformation Functions:' on: aStream.
  39428.             selection fileThis: (self makeFunctionsFor: #prolog3)
  39429.                 on: aStream.
  39430.             selection fileHeading: 'Lower and Upper Bounds:' on: aStream.
  39431.             selection fileThis: (self makeLohisFor: #prolog3)
  39432.                 on: aStream.
  39433.             selection fileHeading: 'Negations of Enabling Conditions:' on: aStream.
  39434.             selection fileThis: self makeNegations on: aStream.
  39435.             ending := OrderedCollection new.
  39436.             ending add: '. '.
  39437.             selection fileThis: ending on: aStream.
  39438.             aStream close]! !
  39439.  
  39440. !TTMList methodsFor: 'code output'!
  39441. codeAsQuintus
  39442.     "output code in the quintus prolog format"
  39443.  
  39444.     | aStream |
  39445.     aStream := self openFileFor: #quintus as: #code.
  39446.     aStream = nil
  39447.         ifFalse: 
  39448.             [self variablesInitialize.
  39449.             selection fileHeading: 'Multifile and Dynamic declarations:' on: aStream.
  39450.             selection fileLine: ':- multifile map/3, type/3, initialcondition/2, en/3, h/4, lohi/4.' on: aStream.
  39451.             selection fileLine: ':- dynamic map/3, type/3, initialcondition/2, en/3, h/4, lohi/4.' on: aStream.
  39452.             self enumerationCommentOn: aStream.
  39453.             selection fileHeading: 'Mapping and Types:' on: aStream.
  39454.             selection fileThis: self makeMapForQP on: aStream.
  39455.             selection fileThis: (self makeTypesFor: #quintus)
  39456.                 on: aStream.
  39457.             selection fileHeading: 'Initial Condition:' on: aStream.
  39458.             selection fileThis: (self makeInitialConditionFor: #quintus)
  39459.                 on: aStream.
  39460.             selection fileHeading: 'Enabling Conditions:' on: aStream.
  39461.             selection fileThis: (self makeGuardsFor: #quintus)
  39462.                 on: aStream.
  39463.             selection fileHeading: 'Transformation Functions:' on: aStream.
  39464.             selection fileThis: (self makeFunctionsFor: #quintus)
  39465.                 on: aStream.
  39466.             selection fileHeading: 'Lower and Upper Bounds:' on: aStream.
  39467.             selection fileThis: (self makeLohisFor: #quintus)
  39468.                 on: aStream.
  39469.             aStream close]! !
  39470.  
  39471. !TTMList methodsFor: 'code output'!
  39472. doRunGenerate
  39473.     | count newValues |
  39474.     newValues := OrderedCollection new.
  39475.     count := 1.
  39476.     [count > temporary size]
  39477.         whileFalse: 
  39478.             [(temporary at: count) value = true
  39479.                 ifTrue: [newValues add: true]
  39480.                 ifFalse: [newValues add: false].
  39481.             count := count + 1].
  39482.     (newValues at: 1)
  39483.         = false & ((newValues at: 2)
  39484.             = false) ifTrue: [TTMList speak: 'No code type has been selected.'].
  39485.     (newValues at: 3)
  39486.         = false & ((newValues at: 4)
  39487.             = false) ifTrue: [TTMList speak: 'No dialect has been selected.'].
  39488.     (newValues at: 5)
  39489.         = true ifTrue: [enumerateActivities := 1].
  39490.     (newValues at: 1)
  39491.         = true
  39492.         ifTrue: 
  39493.             [(newValues at: 3)
  39494.                 = true ifTrue: [self codeAsQuintus].
  39495.             (newValues at: 4)
  39496.                 = true ifTrue: [self codeAsProlog3]].
  39497.     (newValues at: 2)
  39498.         = true ifTrue: [selection stateFormulas size ~= 0 ifFalse: [TTMList speak: 'There are NO State Formulas for this TTM.']
  39499.             ifTrue: 
  39500.                 [(newValues at: 3)
  39501.                     = true ifTrue: [self sfAsQuintus].
  39502.                 (newValues at: 4)
  39503.                     = true ifTrue: [self sfAsProlog3]]].
  39504.     ScheduledControllers activeController close! !
  39505.  
  39506. !TTMList methodsFor: 'code output'!
  39507. enumerationCommentOn: aStream 
  39508.     "if the user has selected enumeration then make a comment"
  39509.  
  39510.     | c anAV avList k |
  39511.     enumerateActivities > 0
  39512.         ifTrue: 
  39513.             [selection fileHeading: 'Activity Variable Type Enumeration:' on: aStream.
  39514.             c := 1.
  39515.             [c > selection activityvariable size]
  39516.                 whileFalse: 
  39517.                     [anAV := selection activityvariable at: c.
  39518.                     selection fileLine: '% enumeration of ' , (anAV at: 1) , ':' on: aStream.
  39519.                     avList := selection typeForAV: anAV.
  39520.                     avList notNil
  39521.                         ifTrue: 
  39522.                             [k := 1.
  39523.                             [k > avList size]
  39524.                                 whileFalse: 
  39525.                                     [selection fileLine: '%     [' , k printString , ' = ' , (avList at: k) myName , ']' on: aStream.
  39526.                                     k := k + 1]].
  39527.                     c := c + 1]]! !
  39528.  
  39529. !TTMList methodsFor: 'code output'!
  39530. enumerationOf: activity in: position 
  39531.     "Return # of activity"
  39532.  
  39533.     | avList k anAV |
  39534.     anAV := selection activityvariable at: position.
  39535.     enumerateActivities > 0
  39536.         ifTrue: 
  39537.             [avList := selection typeForAV: anAV.
  39538.             avList notNil
  39539.                 ifTrue: 
  39540.                     [k := 1.
  39541.                     [k > avList size]
  39542.                         whileFalse: 
  39543.                             [activity = (avList at: k) myName ifTrue: [^k printString].
  39544.                             k := k + 1]]].
  39545.     ^nil! !
  39546.  
  39547. !TTMList methodsFor: 'code output'!
  39548. openFileFor: prologType as: codeType 
  39549.     "Returns the stream in append mode or 
  39550.     
  39551.     returns nil if file could not be opened."
  39552.  
  39553.     | aStream defaultName fileName ending state ready prefix set go myMessage aTransitionCollection fullPath |
  39554.     codeType = #code
  39555.         ifTrue: 
  39556.             [prefix := '.ttm'.
  39557.             editedtrlist := OrderedCollection new.
  39558.             aTransitionCollection := selection computeEffectiveTransitions.
  39559.             aTransitionCollection
  39560.                 do: 
  39561.                     [:x | 
  39562.                     set := OrderedCollection new.
  39563.                     set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  39564.                     editedtrlist add: set]]
  39565.         ifFalse: [prefix := '.sf'].
  39566.     prologType = #quintus
  39567.         ifTrue: 
  39568.             [ending := prefix.
  39569.             state := 'Quintus Prolog file name?']
  39570.         ifFalse: 
  39571.             [ending := prefix , 'p3'.
  39572.             state := 'Prolog III file name?'].
  39573.     defaultName := selection named asString , ending.
  39574.     ready := false.
  39575.     [ready]
  39576.         whileFalse: 
  39577.             [fileName := DialogView request: state initialAnswer: defaultName.
  39578.             fileName isEmpty
  39579.                 ifTrue: 
  39580.                     [TTMList speak: 'No filename given ...generation aborted.'.
  39581.                     aStream := nil.
  39582.                     ^nil]
  39583.                 ifFalse: 
  39584.                     [go := false.
  39585.                     fullPath := (Filename named: selection getDirectory)
  39586.                                 constructString: fileName.
  39587.                     (Filename named: fullPath) exists
  39588.                         ifTrue: 
  39589.                             [myMessage := 'Filename already exists. Overwrite?'.
  39590.                             (DialogView confirm: myMessage)
  39591.                                 = true ifTrue: [go := true]]
  39592.                         ifFalse: [go := true].
  39593.                     go = true
  39594.                         ifTrue: 
  39595.                             [aStream := (Filename named: fullPath) writeStream.
  39596.                             codeType = #code
  39597.                                 ifTrue: [prefix := 'Code']
  39598.                                 ifFalse: [prefix := 'SFs'].
  39599.                             prologType = #quintus
  39600.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  39601.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  39602.                             selection fileTitle: state on: aStream.
  39603.                             selection fileNotePadOn: aStream.
  39604.                             ready := true]]].
  39605.     ^aStream! !
  39606.  
  39607. !TTMList methodsFor: 'code output'!
  39608. openFileForNew: prologType as: codeType 
  39609.     "Returns the stream in append mode or 
  39610.     
  39611.     returns nil if file could not be opened."
  39612.  
  39613.     | aStream defaultName fileName ending state ready prefix set go myMessage aTransitionCollection |
  39614.     codeType = #code
  39615.         ifTrue: 
  39616.             [prefix := '.ttm'.
  39617.             editedtrlist := OrderedCollection new.
  39618.             aTransitionCollection := selection computeEffectiveTransitions.
  39619.             aTransitionCollection
  39620.                 do: 
  39621.                     [:x | 
  39622.                     set := OrderedCollection new.
  39623.                     set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  39624.                     editedtrlist add: set]]
  39625.         ifFalse: [prefix := '.sf'].
  39626.     prologType = #quintus
  39627.         ifTrue: 
  39628.             [ending := prefix.
  39629.             state := 'Quintus Prolog file name?']
  39630.         ifFalse: 
  39631.             [ending := prefix , 'p3'.
  39632.             state := 'Prolog III file name?'].
  39633.     defaultName := selection named asString , ending.
  39634.     ready := false.
  39635.     [ready]
  39636.         whileFalse: 
  39637.             [fileName := DialogView request: state initialAnswer: defaultName.
  39638.             fileName isEmpty
  39639.                 ifTrue: 
  39640.                     [TTMList speak: 'No filename given ...generation aborted.'.
  39641.                     aStream := nil.
  39642.                     ready := true]
  39643.                 ifFalse: 
  39644.                     [go := false.
  39645.                     (Filename named: fileName) exists
  39646.                         ifTrue: 
  39647.                             [myMessage := 'Filename already exists. Overwrite?'.
  39648.                             (DialogView confirm: myMessage)
  39649.                                 = true ifTrue: [go := true]]
  39650.                         ifFalse: [go := true].
  39651.                     go = true
  39652.                         ifTrue: 
  39653.                             [aStream := (Filename named: fileName) writeStream.
  39654.                             codeType = #code
  39655.                                 ifTrue: [prefix := 'Code']
  39656.                                 ifFalse: [prefix := 'SFs'].
  39657.                             prologType = #quintus
  39658.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  39659.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  39660.                             selection fileTitle: state on: aStream.
  39661.                             selection fileNotePadOn: aStream.
  39662.                             ready := true]]].
  39663.     ^aStream! !
  39664.  
  39665. !TTMList methodsFor: 'code output'!
  39666. openFileForOld: prologType as: codeType 
  39667.     "Returns the stream in append mode or 
  39668.     
  39669.     returns nil if file could not be opened."
  39670.  
  39671.     | aStream defaultName fileName ending state ready prefix templist shared count set go myMessage |
  39672.     codeType = #code
  39673.         ifTrue: 
  39674.             [prefix := '.ttm'.
  39675.             editedtrlist := OrderedCollection new.
  39676.             templist := selection transitionlist collect: [:element | element].
  39677.             [templist size > 0]
  39678.                 whileTrue: 
  39679.                     [shared := selection transitionlist sharedTransitionsNamed: templist first myName.
  39680.                     count := 1.
  39681.                     [count > shared size]
  39682.                         whileFalse: 
  39683.                             [templist remove: (shared at: count)
  39684.                                 ifAbsent: [].
  39685.                             count := count + 1].
  39686.                     set := selection processSharedTransitions: shared.
  39687.                     editedtrlist add: set]]
  39688.         ifFalse: [prefix := '.sf'].
  39689.     prologType = #quintus
  39690.         ifTrue: 
  39691.             [ending := prefix.
  39692.             state := 'Quintus Prolog file name?']
  39693.         ifFalse: 
  39694.             [ending := prefix , 'p3'.
  39695.             state := 'Prolog III file name?'].
  39696.     defaultName := selection named asString , ending.
  39697.     ready := false.
  39698.     [ready]
  39699.         whileFalse: 
  39700.             [fileName := DialogView request: state initialAnswer: defaultName.
  39701.             fileName isEmpty
  39702.                 ifTrue: 
  39703.                     [TTMList speak: 'No filename given ...generation aborted.'.
  39704.                     aStream := nil.
  39705.                     ready := true]
  39706.                 ifFalse: 
  39707.                     [go := false.
  39708.                     (Filename named: fileName) exists
  39709.                         ifTrue: 
  39710.                             [myMessage := 'Filename already exists. Overwrite?'.
  39711.                             (DialogView confirm: myMessage)
  39712.                                 = true ifTrue: [go := true]]
  39713.                         ifFalse: [go := true].
  39714.                     go = true
  39715.                         ifTrue: 
  39716.                             [aStream := (Filename named: fileName) writeStream.
  39717.                             codeType = #code
  39718.                                 ifTrue: [prefix := 'Code']
  39719.                                 ifFalse: [prefix := 'SFs'].
  39720.                             prologType = #quintus
  39721.                                 ifTrue: [state := 'Quintus Prolog ' , prefix , ' for TTM: "' , selection named , '"']
  39722.                                 ifFalse: [state := 'Prolog III ' , prefix , '  for TTM: "' , selection named , '"'].
  39723.                             selection fileTitle: state on: aStream.
  39724.                             selection fileNotePadOn: aStream.
  39725.                             ready := true]]].
  39726.     ^aStream! !
  39727.  
  39728. !TTMList methodsFor: 'code output'!
  39729. possiblyEnumerate: contents 
  39730.     "Given a guard, convert it into enumerated type 
  39731.     
  39732.     if required."
  39733.  
  39734.     | editable position |
  39735.     enumerateActivities > 0 ifFalse: [^contents]
  39736.         ifTrue: 
  39737.             [editable := OrderedCollection new.
  39738.             (contents includes: '#')
  39739.                 | (contents includes: '=') & contents size = 3
  39740.                 ifTrue: 
  39741.                     [position := nil.
  39742.                     editable add: (contents at: 1) copy.
  39743.                     editable add: (contents at: 2) copy.
  39744.                     position := selection anExistingAVsPosition: (contents at: 1).
  39745.                     position notNil
  39746.                         ifTrue: [editable add: (self enumerationOf: (contents at: 3)
  39747.                                     in: position)]
  39748.                         ifFalse: [editable add: (contents at: 3) copy].
  39749.                     ^editable ].
  39750.             ^contents]! !
  39751.  
  39752. !TTMList methodsFor: 'code output'!
  39753. possiblyEnumerateNew: contents 
  39754.     "Given a guard, convert it into enumerated type 
  39755.     
  39756.     if required."
  39757.  
  39758.     | editable position |
  39759.     enumerateActivities > 0 ifFalse: [^contents]
  39760.         ifTrue: 
  39761.             [editable := OrderedCollection new.
  39762.             (contents includes: '#')
  39763.                 | (contents includes: '=') & contents size = 3
  39764.                 ifTrue: 
  39765.                     [position := nil.
  39766.                     editable add: (contents at: 1) copy.
  39767.                     editable add: (contents at: 2) copy.
  39768.                     position := selection anExistingAVsPosition: (contents at: 1).
  39769.                     position notNil
  39770.                         ifTrue: [editable add: (self enumerationOf: (contents at: 3)
  39771.                                     in: position)]
  39772.                         ifFalse: [editable add: (contents at: 3) copy].
  39773.                     ^editable ].
  39774.             ^contents]! !
  39775.  
  39776. !TTMList methodsFor: 'code output'!
  39777. possiblyEnumerateOld: contents 
  39778.     "Given a guard, convert it into enumerated type 
  39779.     
  39780.     if required."
  39781.  
  39782.     | editable possibleVar possibleValue position newValue expression |
  39783.     enumerateActivities > 0 ifFalse: [^contents]
  39784.         ifTrue: 
  39785.             [(contents includes: '#')
  39786.                 | (contents includes: '=')
  39787.                 ifTrue: 
  39788.                     [expression := (contents at: 2) copy.
  39789.                     possibleVar := (contents at: 1) copy.
  39790.                     possibleValue := (contents at: 3) copy.
  39791.                     position := selection anExistingAVsPosition: possibleVar.
  39792.                     position notNil
  39793.                         ifTrue: [newValue := self enumerationOf: possibleValue in: position]
  39794.                         ifFalse: [newValue := possibleValue].
  39795.                     editable := OrderedCollection new.
  39796.                     editable add: possibleVar; add: expression; add: newValue.
  39797.                     ^editable].
  39798.             ^contents]! !
  39799.  
  39800. !TTMList methodsFor: 'code output'!
  39801. sfAsProlog3
  39802.     "output SFs in the prolog 3 format"
  39803.  
  39804.     | aStream count anSF anSFNumber |
  39805.     aStream := self openFileFor: #prolog3 as: #sfs.
  39806.     aStream = nil
  39807.         ifFalse: 
  39808.             [self variablesInitialize.
  39809.             self enumerationCommentOn: aStream.
  39810.             selection fileHeading: 'SFs:' on: aStream.
  39811.             count := 1.
  39812.             [count > selection stateFormulas size]
  39813.                 whileFalse: 
  39814.                     [anSF := (selection stateFormulas at: count)
  39815.                                 at: 2.
  39816.                     anSFNumber := (selection stateFormulas at: count)
  39817.                                 at: 1.
  39818.                     selection fileThis: (self
  39819.                             makeSF: anSF
  39820.                             with: anSFNumber
  39821.                             for: #prolog3)
  39822.                         on: aStream.
  39823.                     count := count + 1].
  39824.             selection fileHeading: 'SF negations:' on: aStream.
  39825.             count := 1.
  39826.             [count > selection stateFormulas size]
  39827.                 whileFalse: 
  39828.                     [anSF := (selection stateFormulas at: count)
  39829.                                 at: 2.
  39830.                     anSFNumber := (selection stateFormulas at: count)
  39831.                                 at: 1.
  39832.                     selection fileThis: (self makeSFNegations: anSF with: anSFNumber)
  39833.                         on: aStream.
  39834.                     count := count + 1].
  39835.             aStream close]! !
  39836.  
  39837. !TTMList methodsFor: 'code output'!
  39838. sfAsQuintus
  39839.     "output SFs in the quintus prolog format"
  39840.  
  39841.     | aStream anSF count anSFNumber |
  39842.     aStream := self openFileFor: #quintus as: #sfs.
  39843.     aStream = nil
  39844.         ifFalse: 
  39845.             [self variablesInitialize.
  39846.             self enumerationCommentOn: aStream.
  39847.             selection fileHeading: 'Multifile and Dynamic declarations:' on: aStream.
  39848.             selection fileLine: ':- multifile prop/3, sf/3.' on: aStream.
  39849.             selection fileLine: ':- dynamic prop/3, sf/3.' on: aStream.
  39850.             selection fileHeading: 'Prop definitions:' on: aStream.
  39851.             selection fileThis: self makeEnabledForQuintus on: aStream.
  39852.             selection fileHeading: 'SFs:' on: aStream.
  39853.             count := 1.
  39854.             [count > selection stateFormulas size]
  39855.                 whileFalse: 
  39856.                     [anSF := (selection stateFormulas at: count)
  39857.                                 at: 2.
  39858.                     anSFNumber := (selection stateFormulas at: count)
  39859.                                 at: 1.
  39860.                     selection fileThis: (self
  39861.                             makeSF: anSF
  39862.                             with: anSFNumber
  39863.                             for: #quintus)
  39864.                         on: aStream.
  39865.                     count := count + 1].
  39866.             aStream close]! !
  39867.  
  39868. !TTMList methodsFor: 'code generation'!
  39869. divideAssignment: str 
  39870.     | res ind comma colon |
  39871.     ind := 1.
  39872.     res := OrderedCollection new.
  39873.     (str occurrencesOf: $:)
  39874.         timesRepeat: 
  39875.             [comma := str
  39876.                         nextIndexOf: $,
  39877.                         from: ind
  39878.                         to: str size.
  39879.             comma isNil ifTrue: [comma := str size + 1].
  39880.             colon := str
  39881.                         nextIndexOf: $:
  39882.                         from: ind
  39883.                         to: str size.
  39884.             res add: (Array with: (str copyFrom: ind to: colon - 1)
  39885.                     with: (str copyFrom: colon + 1 to: comma - 1)).
  39886.             ind := comma + 1].
  39887.     ^res! !
  39888.  
  39889. !TTMList methodsFor: 'code generation'!
  39890. functionTraverse: start lookFor: targetVariable 
  39891.     "A recursive traversal."
  39892.  
  39893.     | count assignment |
  39894.     start left ~= nil & temporary isNil ifTrue: [self functionTraverse: start left lookFor: targetVariable].
  39895.     start right ~= nil & temporary isNil ifTrue: [self functionTraverse: start right lookFor: targetVariable].
  39896.     start isAtom & temporary isNil ifTrue: [(start contents at: 1)
  39897.             = targetVariable
  39898.             ifTrue: 
  39899.                 [count := 3.
  39900.                 assignment := ''.
  39901.                 [count > start contents size]
  39902.                     whileFalse: 
  39903.                         [assignment := assignment , (start contents at: count).
  39904.                         count := count + 1].
  39905.                 temporary := assignment]]! !
  39906.  
  39907. !TTMList methodsFor: 'code generation'!
  39908. getLHSOfAssignmentsIn: str 
  39909.     | res ind comma colon |
  39910.     ind := 1.
  39911.     res := OrderedCollection new.
  39912.     (str occurrencesOf: $:)
  39913.         timesRepeat: 
  39914.             [comma := str
  39915.                         nextIndexOf: $,
  39916.                         from: ind
  39917.                         to: str size.
  39918.             comma isNil ifTrue: [comma := str size + 1].
  39919.             colon := str
  39920.                         nextIndexOf: $:
  39921.                         from: ind
  39922.                         to: str size.
  39923.             res add: (str copyFrom: ind to: colon - 1).
  39924.             ind := comma + 1].
  39925.     ^res! !
  39926.  
  39927. !TTMList methodsFor: 'code generation'!
  39928. guardTraverseP3: start 
  39929.     "A recursive traversal. Differs from Quintus 
  39930.     
  39931.     by not inserting left and right brackets."
  39932.  
  39933.     | count newContents e enumeratedContents |
  39934.     
  39935.     start left ~= nil ifTrue: [self guardTraverseP3: start left].
  39936.     start right ~= nil ifTrue: [self guardTraverseP3: start right].
  39937.     start contents ~= 'ROOT' ifTrue: [start isAtom
  39938.             ifTrue: 
  39939.                 [count := 1.
  39940.                 newContents := ''.
  39941.                 enumeratedContents := self possiblyEnumerate: start contents.
  39942.                 start contents: enumeratedContents.
  39943.                 [count > start contents size]
  39944.                     whileFalse: 
  39945.                         [e := (start contents at: count) copy.
  39946.                         newContents := newContents , e asString.
  39947.                         count := count + 1].
  39948.                 start contents: newContents]
  39949.             ifFalse: [start contents = 'AND'
  39950.                     ifTrue: [start contents: start left contents , ',' , start right contents]
  39951.                     ifFalse: [start contents: start left contents , ';' , start right contents]]]! !
  39952.  
  39953. !TTMList methodsFor: 'code generation'!
  39954. guardTraverseQuintus: start 
  39955.     "A recursive traversal."
  39956.  
  39957.     | count newContents e enumeratedContents |
  39958.     start left ~= nil ifTrue: [self guardTraverseQuintus: start left].
  39959.     start right ~= nil ifTrue: [self guardTraverseQuintus: start right].
  39960.     start contents ~= 'ROOT' ifTrue: [start isAtom
  39961.             ifTrue: 
  39962.                 [count := 1.
  39963.                 newContents := ''.
  39964.                 enumeratedContents := self possiblyEnumerate: start contents.
  39965.                 start contents: enumeratedContents.
  39966.                 [count > start contents size]
  39967.                     whileFalse: [(start contents includes: '#')
  39968.                             ifTrue: 
  39969.                                 [count = 1 ifTrue: [newContents := newContents , 'not('].
  39970.                                 e := start contents at: count.
  39971.                                 e = '#' ifTrue: [e := '='].
  39972.                                 newContents := newContents , e.
  39973.                                 count := count + 1.
  39974.                                 count > start contents size ifTrue: [newContents := newContents , ')']]
  39975.                             ifFalse: 
  39976.                                 [e := start contents at: count.
  39977.                                 newContents := newContents , e.
  39978.                                 count := count + 1]].
  39979.                 start contents: newContents]
  39980.             ifFalse: [start contents = 'AND'
  39981.                     ifTrue: [start contents: '(' , start left contents , ',' , start right contents , ')']
  39982.                     ifFalse: [start contents: '(' , start left contents , ';' , start right contents , ')']]]! !
  39983.  
  39984. !TTMList methodsFor: 'code generation'!
  39985. makeEnabledForQuintus
  39986.     | table |
  39987.     table := OrderedCollection new.
  39988.     table add: '?-consult(''' , selection named , '.ttm'').'.
  39989.     table add: 'prop(' , selection named , ',  enabled, [ X, N ] ) :-'.
  39990.     table add: '        en(' , selection named , ', Transition, X ),  not (Transition = tick).'.
  39991.     ^table! !
  39992.  
  39993. !TTMList methodsFor: 'code generation'!
  39994. makeFunction: aFunction 
  39995.     "We go through each 
  39996.     
  39997.     variable in the ttm. If there is an assignment for it 
  39998.     
  39999.     put in newFunction, else put variable itself."
  40000.     "NOTE if there are multiple assignments for a 
  40001.     
  40002.     variable, this routine will ONLY select the first one."
  40003.  
  40004.     | newFunction count supplement currentVariable position lhs df ind |
  40005.     count := 1.
  40006.     newFunction := ''.
  40007.     lhs := self getLHSOfAssignmentsIn: aFunction.
  40008.     df := self divideAssignment: aFunction.
  40009.     variableSet
  40010.         do: 
  40011.             [:x | 
  40012.             currentVariable := x at: 1.
  40013.             temporary := nil.
  40014.             (lhs includes: currentVariable)
  40015.                 = false
  40016.                 ifTrue: [temporary := nil]
  40017.                 ifFalse: [df size > 0
  40018.                         ifTrue: 
  40019.                             [ind := 1.
  40020.                             [temporary = nil]
  40021.                                 whileTrue: [((df at: ind)
  40022.                                         at: 1)
  40023.                                         = currentVariable
  40024.                                         ifTrue: [temporary := (df at: ind)
  40025.                                                         at: 2]
  40026.                                         ifFalse: [ind := ind + 1]]]].
  40027.             temporary isNil
  40028.                 ifFalse: 
  40029.                     [position := selection anExistingAVsPosition: currentVariable.
  40030.                     position notNil
  40031.                         ifTrue: 
  40032.                             [supplement := self enumerationOf: temporary in: position.
  40033.                             supplement isNil ifTrue: [supplement := temporary]]
  40034.                         ifFalse: [supplement := temporary]]
  40035.                 ifTrue: [supplement := currentVariable].
  40036.             newFunction := newFunction , supplement , ','.
  40037.             count := count + 1].
  40038.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  40039.  
  40040. !TTMList methodsFor: 'code generation'!
  40041. makeFunctionOld: aFunction 
  40042.     "Form a parse tree. Now, we go through each 
  40043.     
  40044.     variable in the ttm. If there is an assignment for it 
  40045.     
  40046.     put in newFunction, else put variable itself."
  40047.     "NOTE if there are multiple assignments for a 
  40048.     
  40049.     variable, this routine will ONLY select the first one."
  40050.  
  40051.     | root newFunction count supplement currentVariable position |
  40052.     root := (ParseTree orderIntoTree: (ParseTree fission: aFunction definedAs: #function)
  40053.                 from: selection) treeRoot.
  40054.     count := 1.
  40055.     newFunction := ''.
  40056.     [count > variableSet size]
  40057.         whileFalse: 
  40058.             [currentVariable := (variableSet at: count)
  40059.                         at: 1.
  40060.             temporary := nil.
  40061.             self functionTraverse: root lookFor: currentVariable.
  40062.             temporary isNil
  40063.                 ifFalse: 
  40064.                     [position := selection anExistingAVsPosition: currentVariable.
  40065.                     position notNil
  40066.                         ifTrue: 
  40067.                             [supplement := self enumerationOf: temporary in: position.
  40068.                             supplement isNil ifTrue: [supplement := temporary]]
  40069.                         ifFalse: [supplement := temporary]]
  40070.                 ifTrue: [supplement := currentVariable].
  40071.             newFunction := newFunction , supplement , ','.
  40072.             count := count + 1].
  40073.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  40074.  
  40075. !TTMList methodsFor: 'code generation'!
  40076. makeFunctionQuintus: aFunction 
  40077.     "Form a parse tree. Now, we go through each 
  40078.     
  40079.     variable in the ttm. If there is an assignment for it 
  40080.     
  40081.     put in newFunction, else put variable itself."
  40082.     "NOTE if there are multiple assignments for a 
  40083.     
  40084.     variable, this routine will ONLY select the first one."
  40085.  
  40086.     | lhs newFunction count supplement currentVariable position setOfFunctions df ind |
  40087.     count := 1.
  40088.     newFunction := ''.
  40089.     setOfFunctions := OrderedCollection new.
  40090.     lhs := self getLHSOfAssignmentsIn: aFunction.
  40091.     df := self divideAssignment: aFunction.
  40092.     variableSet
  40093.         do: 
  40094.             [:x | 
  40095.             currentVariable := x at: 1.
  40096.             temporary := nil.
  40097.             (lhs includes: currentVariable)
  40098.                 = false
  40099.                 ifTrue: [temporary := nil]
  40100.                 ifFalse: [df size > 0
  40101.                         ifTrue: 
  40102.                             [ind := 1.
  40103.                             [temporary = nil]
  40104.                                 whileTrue: [((df at: ind)
  40105.                                         at: 1)
  40106.                                         = currentVariable
  40107.                                         ifTrue: [temporary := (df at: ind)
  40108.                                                         at: 2]
  40109.                                         ifFalse: [ind := ind + 1]]]].
  40110.             temporary isNil
  40111.                 ifFalse: 
  40112.                     [position := selection anExistingAVsPosition: currentVariable.
  40113.                     position notNil
  40114.                         ifTrue: 
  40115.                             [supplement := self enumerationOf: temporary in: position.
  40116.                             supplement isNil ifTrue: [supplement := temporary]]
  40117.                         ifFalse: 
  40118.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  40119.                             supplement := currentVariable , 'new']]
  40120.                 ifTrue: [supplement := currentVariable].
  40121.             newFunction := newFunction , supplement , ','.
  40122.             count := count + 1].
  40123.     temporary := setOfFunctions.
  40124.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  40125.  
  40126. !TTMList methodsFor: 'code generation'!
  40127. makeFunctionQuintusOld: aFunction 
  40128.     "Form a parse tree. Now, we go through each 
  40129.     
  40130.     variable in the ttm. If there is an assignment for it 
  40131.     
  40132.     put in newFunction, else put variable itself."
  40133.     "NOTE if there are multiple assignments for a 
  40134.     
  40135.     variable, this routine will ONLY select the first one."
  40136.  
  40137.     | root newFunction count supplement currentVariable position setOfFunctions   |
  40138.     root := (ParseTree orderIntoTree: (ParseTree fission: aFunction definedAs: #function)
  40139.                 from: selection) treeRoot.
  40140.     count := 1.
  40141.     newFunction := ''.
  40142.     setOfFunctions := OrderedCollection new.
  40143.     [count > variableSet size]
  40144.         whileFalse: 
  40145.             [currentVariable := (variableSet at: count)
  40146.                         at: 1.
  40147.             temporary := nil.
  40148.             self functionTraverse: root lookFor: currentVariable.
  40149.             temporary isNil
  40150.                 ifFalse: 
  40151.                     [position := selection anExistingAVsPosition: currentVariable.
  40152.                     position notNil
  40153.                         ifTrue: 
  40154.                             [supplement := self enumerationOf: temporary in: position.
  40155.                             supplement isNil ifTrue: [supplement := temporary]]
  40156.                         ifFalse: 
  40157.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  40158.                             supplement := currentVariable , 'new']]
  40159.                 ifTrue: [supplement := currentVariable].
  40160.             newFunction := newFunction , supplement , ','.
  40161.             count := count + 1].
  40162.     temporary := setOfFunctions.
  40163.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  40164.  
  40165. !TTMList methodsFor: 'code generation'!
  40166. makeFunctionQuintusX: aFunction 
  40167.     "Form a parse tree. Now, we go through each 
  40168.     
  40169.     variable in the ttm. If there is an assignment for it 
  40170.     
  40171.     put in newFunction, else put variable itself."
  40172.     "NOTE if there are multiple assignments for a 
  40173.     
  40174.     variable, this routine will ONLY select the first one."
  40175.  
  40176.     | lhs newFunction count supplement currentVariable position setOfFunctions |
  40177.     count := 1.
  40178.     newFunction := ''.
  40179.     setOfFunctions := OrderedCollection new.
  40180.     lhs := self getLHSOfAssignmentsIn: aFunction.
  40181.     (self divideAssignment: aFunction)
  40182.         do: 
  40183.             [:x | 
  40184.             currentVariable := x at: 1.
  40185.             temporary := nil.
  40186.             (lhs includes: currentVariable)
  40187.                 = false
  40188.                 ifTrue: [temporary := nil]
  40189.                 ifFalse: [temporary := x at: 2].
  40190.             temporary isNil
  40191.                 ifFalse: 
  40192.                     [position := selection anExistingAVsPosition: currentVariable.
  40193.                     position notNil
  40194.                         ifTrue: 
  40195.                             [supplement := self enumerationOf: temporary in: position.
  40196.                             supplement isNil ifTrue: [supplement := temporary]]
  40197.                         ifFalse: 
  40198.                             [setOfFunctions add: currentVariable , 'new is ' , temporary.
  40199.                             supplement := currentVariable , 'new']]
  40200.                 ifTrue: [supplement := currentVariable].
  40201.             newFunction := newFunction , supplement , ','.
  40202.             count := count + 1].
  40203.     temporary := setOfFunctions.
  40204.     ^'[' , (newFunction copyFrom: 1 to: newFunction size - 1) , ']'! !
  40205.  
  40206. !TTMList methodsFor: 'code generation'!
  40207. makeFunctionsFor: prologType 
  40208.     "Create h() predicates for all of the transitions 
  40209.     
  40210.     in the ttm, selection."
  40211.  
  40212.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  40213.     table := OrderedCollection new.
  40214.     common := 'h(' , selection named , ', '.
  40215.     prologType = #quintus
  40216.         ifTrue: 
  40217.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  40218.             table add: current.
  40219.             trCount := 1.
  40220.             [trCount > editedtrlist size]
  40221.                 whileFalse: 
  40222.                     [currentTr := editedtrlist at: trCount.
  40223.                     samplename := currentTr at: 1.
  40224.                     samplefunction := currentTr at: 3.
  40225.                     temporary := OrderedCollection new.
  40226.                     samplefunction = 'nil'
  40227.                         ifTrue: [supplement := self variablesUppercase]
  40228.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  40229.                     temporary size = 0
  40230.                         ifTrue: 
  40231.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40232.                             table add: current]
  40233.                         ifFalse: 
  40234.                             [tempCount := 1.
  40235.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  40236.                             table add: current.
  40237.                             [tempCount > temporary size]
  40238.                                 whileFalse: 
  40239.                                     [temp1 := temporary at: tempCount.
  40240.                                     temp1 := TTMList
  40241.                                                 inString: temp1
  40242.                                                 replace: '%'
  40243.                                                 with: ' mod '.
  40244.                                     temp1 := TTMList
  40245.                                                 inString: temp1
  40246.                                                 replace: '/'
  40247.                                                 with: ' div '.
  40248.                                     current := '     ' , temp1.
  40249.                                     tempCount = temporary size
  40250.                                         ifTrue: [current := current , '.']
  40251.                                         ifFalse: [current := current , ','].
  40252.                                     table add: current.
  40253.                                     tempCount := tempCount + 1]].
  40254.                     trCount := trCount + 1]]
  40255.         ifFalse: 
  40256.             [trCount := 1.
  40257.             [trCount > editedtrlist size]
  40258.                 whileFalse: 
  40259.                     [currentTr := editedtrlist at: trCount.
  40260.                     samplename := currentTr at: 1.
  40261.                     samplefunction := currentTr at: 3.
  40262.                     samplefunction = 'nil'
  40263.                         ifTrue: [supplement := self variablesUppercase]
  40264.                         ifFalse: 
  40265.                             [supplement := self makeFunction: samplefunction.
  40266.                             supplement := TTMList
  40267.                                         inString: supplement
  40268.                                         replace: '%'
  40269.                                         with: ' mod '.
  40270.                             supplement := TTMList
  40271.                                         inString: supplement
  40272.                                         replace: '/'
  40273.                                         with: ' div '].
  40274.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40275.                     table add: current.
  40276.                     trCount := trCount + 1]].
  40277.     ^table! !
  40278.  
  40279. !TTMList methodsFor: 'code generation'!
  40280. makeFunctionsForNew: prologType 
  40281.     "Create h() predicates for all of the transitions 
  40282.     
  40283.     in the ttm, selection."
  40284.  
  40285.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  40286.     table := OrderedCollection new.
  40287.     common := 'h(' , selection named , ', '.
  40288.     prologType = #quintus
  40289.         ifTrue: 
  40290.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  40291.             table add: current.
  40292.             trCount := 1.
  40293.             [trCount > editedtrlist size]
  40294.                 whileFalse: 
  40295.                     [currentTr := editedtrlist at: trCount.
  40296.                     samplename := currentTr at: 1.
  40297.                     samplefunction := currentTr at: 3.
  40298.                     temporary := OrderedCollection new.
  40299.                     samplefunction = 'nil'
  40300.                         ifTrue: [supplement := self variablesUppercase]
  40301.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  40302.                     temporary size = 0
  40303.                         ifTrue: 
  40304.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40305.                             table add: current]
  40306.                         ifFalse: 
  40307.                             [tempCount := 1.
  40308.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  40309.                             table add: current.
  40310.                             [tempCount > temporary size]
  40311.                                 whileFalse: 
  40312.                                     [temp1 := temporary at: tempCount.
  40313.                                     temp1 := TTMList
  40314.                                                 inString: temp1
  40315.                                                 replace: '%'
  40316.                                                 with: ' mod '.
  40317.                                     temp1 := TTMList
  40318.                                                 inString: temp1
  40319.                                                 replace: '/'
  40320.                                                 with: ' div '.
  40321.                                     current := '     ' , temp1.
  40322.                                     tempCount = temporary size
  40323.                                         ifTrue: [current := current , '.']
  40324.                                         ifFalse: [current := current , ','].
  40325.                                     table add: current.
  40326.                                     tempCount := tempCount + 1]].
  40327.                     trCount := trCount + 1]]
  40328.         ifFalse: 
  40329.             [trCount := 1.
  40330.             [trCount > editedtrlist size]
  40331.                 whileFalse: 
  40332.                     [currentTr := editedtrlist at: trCount.
  40333.                     samplename := currentTr at: 1.
  40334.                     samplefunction := currentTr at: 3.
  40335.                     samplefunction = 'nil'
  40336.                         ifTrue: [supplement := self variablesUppercase]
  40337.                         ifFalse: 
  40338.                             [supplement := self makeFunction: samplefunction.
  40339.                             supplement := TTMList
  40340.                                         inString: supplement
  40341.                                         replace: '%'
  40342.                                         with: ' mod '.
  40343.                             supplement := TTMList
  40344.                                         inString: supplement
  40345.                                         replace: '/'
  40346.                                         with: ' div '].
  40347.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40348.                     table add: current.
  40349.                     trCount := trCount + 1]].
  40350.     ^table! !
  40351.  
  40352. !TTMList methodsFor: 'code generation'!
  40353. makeFunctionsForOld: prologType 
  40354.     "Create h() predicates for all of the transitions 
  40355.     
  40356.     in the ttm, selection."
  40357.  
  40358.     | table common current samplename samplefunction supplement trCount currentTr tempCount temp1 |
  40359.     table := OrderedCollection new.
  40360.     common := 'h(' , selection named , ', '.
  40361.     prologType = #quintus
  40362.         ifTrue: 
  40363.             [current := common , 'tick, ' , self variablesUppercase , ', ' , self variablesUppercase , '). '.
  40364.             table add: current.
  40365.             trCount := 1.
  40366.             [trCount > editedtrlist size]
  40367.                 whileFalse: 
  40368.                     [currentTr := editedtrlist at: trCount.
  40369.                     samplename := currentTr at: 1.
  40370.                     samplefunction := currentTr at: 3.
  40371.                     temporary := OrderedCollection new.
  40372.                     samplefunction = 'nil'
  40373.                         ifTrue: [supplement := self variablesUppercase]
  40374.                         ifFalse: [supplement := self makeFunctionQuintus: samplefunction].
  40375.                     temporary size = 0
  40376.                         ifTrue: 
  40377.                             [current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40378.                             table add: current]
  40379.                         ifFalse: 
  40380.                             [tempCount := 1.
  40381.                             current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , ') :-'.
  40382.                             table add: current.
  40383.                             [tempCount > temporary size]
  40384.                                 whileFalse: 
  40385.                                     [temp1 := temporary at: tempCount.
  40386.                                     temp1 := TTMList
  40387.                                                 inString: temp1
  40388.                                                 replace: '%'
  40389.                                                 with: ' mod '.
  40390.                                     temp1 := TTMList
  40391.                                                 inString: temp1
  40392.                                                 replace: '/'
  40393.                                                 with: ' div '.
  40394.                                     current := '     ' , temp1.
  40395.                                     tempCount = temporary size
  40396.                                         ifTrue: [current := current , '.']
  40397.                                         ifFalse: [current := current , ','].
  40398.                                     table add: current.
  40399.                                     tempCount := tempCount + 1]].
  40400.                     trCount := trCount + 1]]
  40401.         ifFalse: 
  40402.             [trCount := 1.
  40403.             [trCount > editedtrlist size]
  40404.                 whileFalse: 
  40405.                     [currentTr := editedtrlist at: trCount.
  40406.                     samplename := currentTr at: 1.
  40407.                     samplefunction := currentTr at: 3.
  40408.                     samplefunction = 'nil'
  40409.                         ifTrue: [supplement := self variablesUppercase]
  40410.                         ifFalse: [supplement := self makeFunction: samplefunction].
  40411.                     current := common , samplename , ', ' , self variablesUppercase , ', ' , supplement , '). '.
  40412.                     table add: current.
  40413.                     trCount := trCount + 1]].
  40414.     ^table! !
  40415.  
  40416. !TTMList methodsFor: 'code generation'!
  40417. makeGuard: aGuard for: prologType 
  40418.     "Given a guard string, make a Parse Tree then 
  40419.     
  40420.     use it to make brackets around stuff, then 
  40421.     
  40422.     return a table of lines that should be output."
  40423.  
  40424.     | root tree |
  40425.     tree := ParseTree orderIntoTree: (ParseTree fission: aGuard copy definedAs: #guard)
  40426.                 from: selection.
  40427.     prologType = #prolog3
  40428.         ifTrue: 
  40429.             [root := tree inPrenexForm treeRoot.
  40430.             self guardTraverseP3: root.
  40431.             ^self separateLinesP3: root left contents]
  40432.         ifFalse: 
  40433.             ["root := tree treeRoot.
  40434.             self guardTraverseQuintus: root.
  40435.             ^self separateLinesQuintus: root left contents"
  40436.             ^self separateLinesQuintus: aGuard]! !
  40437.  
  40438. !TTMList methodsFor: 'code generation'!
  40439. makeGuardsFor: prologType 
  40440.     "Create en() predicates for all of the 
  40441.     
  40442.     transitions in the ttm, selection."
  40443.  
  40444.     | table common samplename sampleguard supplement count preamble trCount currentTr temp1 |
  40445.     table := OrderedCollection new.
  40446.     common := 'en(' , selection named , ', '.
  40447.     prologType = #quintus
  40448.         ifTrue: 
  40449.             [preamble := common , 'tick, ' , self variablesUppercase , '). '.
  40450.             table add: preamble].
  40451.     trCount := 1.
  40452.     [trCount > editedtrlist size]
  40453.         whileFalse: 
  40454.             [currentTr := editedtrlist at: trCount.
  40455.             samplename := currentTr at: 1.
  40456.             sampleguard := currentTr at: 2.
  40457.             preamble := common , samplename , ', ' , self variablesUppercase , ')'.
  40458.             sampleguard = 'nil'
  40459.                 ifTrue: [table add: preamble , '. ']
  40460.                 ifFalse: 
  40461.                     [prologType = #quintus
  40462.                         ifTrue: 
  40463.                             [preamble := preamble , ' :-'.
  40464.                             table add: preamble]
  40465.                         ifFalse: [preamble := preamble , '{'].
  40466.                     supplement := self makeGuard: sampleguard for: prologType.
  40467.                     count := 1.
  40468.                     [count > supplement size]
  40469.                         whileFalse: 
  40470.                             [temp1 := supplement at: count.
  40471.                             temp1 := TTMList
  40472.                                         inString: temp1
  40473.                                         replace: '%'
  40474.                                         with: ' mod '.
  40475.                             temp1 := TTMList
  40476.                                         inString: temp1
  40477.                                         replace: '/'
  40478.                                         with: ' div '.
  40479.                             prologType = #quintus
  40480.                                 ifTrue: [(self isArithmetic: temp1)
  40481.                                         = true & ((self containLtOrGt: temp1)
  40482.                                             = false)
  40483.                                         ifTrue: 
  40484.                                             [temp1 := TTMList
  40485.                                                         inString: temp1
  40486.                                                         replace: '='
  40487.                                                         with: ' =:= '.
  40488.                                             temp1 := TTMList
  40489.                                                         inString: temp1
  40490.                                                         replace: '#'
  40491.                                                         with: ' =\= '.
  40492.                                             table add: temp1]
  40493.                                         ifFalse: 
  40494.                                             [temp1 := TTMList
  40495.                                                         inString: temp1
  40496.                                                         replace: '#'
  40497.                                                         with: ' \= '.
  40498.                                             table add: temp1]]
  40499.                                 ifFalse: [table add: preamble , temp1 , '}. '].
  40500.                             count := count + 1]].
  40501.             trCount := trCount + 1].
  40502.     ^table! !
  40503.  
  40504. !TTMList methodsFor: 'code generation'!
  40505. makeInitialConditionFor: prologType 
  40506.     | table supplement count preamble currentIC currentout c e position resultingValue |
  40507.     table := OrderedCollection new.
  40508.     variableSet size > 0 ifTrue: [prologType = #quintus
  40509.             ifTrue: [selection specificIC size = 0
  40510.                     ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  40511.                     ifFalse: 
  40512.                         [preamble := 'initialcondition(' , selection named , ', ['.
  40513.                         count := 1.
  40514.                         [count > selection specificIC size]
  40515.                             whileFalse: 
  40516.                                 [currentIC := (selection specificIC at: count)
  40517.                                             at: 2.
  40518.                                 currentout := preamble.
  40519.                                 c := 1.
  40520.                                 [c > currentIC size]
  40521.                                     whileFalse: 
  40522.                                         [e := currentIC at: c.
  40523.                                         position := selection anExistingAVsPosition: (e at: 1).
  40524.                                         position notNil
  40525.                                             ifTrue: 
  40526.                                                 [resultingValue := self enumerationOf: (e at: 2)
  40527.                                                             in: position.
  40528.                                                 resultingValue isNil ifTrue: [resultingValue := e at: 2]]
  40529.                                             ifFalse: [resultingValue := e at: 2].
  40530.                                         currentout := currentout , resultingValue.
  40531.                                         c = currentIC size ifFalse: [currentout := currentout , ', ']
  40532.                                             ifTrue: 
  40533.                                                 [currentout := currentout , ']). '.
  40534.                                                 table add: currentout].
  40535.                                         c := c + 1].
  40536.                                 count := count + 1]]]
  40537.             ifFalse: [selection initialcondition asString = 'nil'
  40538.                     ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  40539.                     ifFalse: 
  40540.                         [preamble := 'initialcondition(' , selection named , ', ' , self variablesUppercase , ')'.
  40541.                         preamble := preamble , ' {'.
  40542.                         supplement := self makeGuard: selection initialcondition for: prologType.
  40543.                         count := 1.
  40544.                         [count > supplement size]
  40545.                             whileFalse: 
  40546.                                 [table add: preamble , (supplement at: count) , '}. '.
  40547.                                 count := count + 1]]]].
  40548.     ^table! !
  40549.  
  40550. !TTMList methodsFor: 'code generation'!
  40551. makeLohisFor: prologType 
  40552.     "Create lohi() predicates for all of the 
  40553.     
  40554.     transitions in the ttm, selection."
  40555.  
  40556.     | table common current trCount currentTr samplename samplelow samplehi |
  40557.     table := OrderedCollection new.
  40558.     common := 'lohi(' , selection named , ', '.
  40559.     prologType = #quintus
  40560.         ifTrue: 
  40561.             [current := common , 'tick, 0, infinity). '.
  40562.             table add: current].
  40563.     trCount := 1.
  40564.     [trCount > editedtrlist size]
  40565.         whileFalse: 
  40566.             [currentTr := editedtrlist at: trCount.
  40567.             samplename := currentTr at: 1.
  40568.             samplelow := currentTr at: 4.
  40569.             samplehi := currentTr at: 5.
  40570.             current := common , samplename , ', ' , samplelow , ', ' , samplehi , '). '.
  40571.             table add: current.
  40572.             trCount := trCount + 1].
  40573.     ^table! !
  40574.  
  40575. !TTMList methodsFor: 'code generation'!
  40576. makeMap
  40577.     | table current count |
  40578.     table := OrderedCollection new.
  40579.     variableSet size > 0
  40580.         ifTrue: 
  40581.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  40582.             table add: current.
  40583.             count := 1.
  40584.             [count >= variableSet size]
  40585.                 whileFalse: 
  40586.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  40587.                                     noName: #false) , ','.
  40588.                     table add: current.
  40589.                     count := count + 1].
  40590.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  40591.                             noName: #false) , '. '.
  40592.             table add: current].
  40593.     ^table! !
  40594.  
  40595. !TTMList methodsFor: 'code generation'!
  40596. makeMapForP3
  40597.     | table current count |
  40598.     table := OrderedCollection new.
  40599.     variableSet size > 0
  40600.         ifTrue: 
  40601.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  40602.             table add: current.
  40603.             count := 1.
  40604.             [count >= variableSet size]
  40605.                 whileFalse: 
  40606.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  40607.                                     noName: #false) , ','.
  40608.                     table add: current.
  40609.                     count := count + 1].
  40610.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  40611.                             noName: #false) , '. '.
  40612.             table add: current].
  40613.     ^table! !
  40614.  
  40615. !TTMList methodsFor: 'code generation'!
  40616. makeMapForQP
  40617.     | table current count |
  40618.     table := OrderedCollection new.
  40619.     variableSet size > 0
  40620.         ifTrue: 
  40621.             [current := 'map(' , selection named , ', ' , self variablesLowercase , ', ' , self variablesUppercase , ') :-'.
  40622.             table add: current.
  40623.             count := 1.
  40624.             [count >= variableSet size]
  40625.                 whileFalse: 
  40626.                     [current := '        ' , (self variableTypeFor: (variableSet at: count)
  40627.                                     noName: #true) , ','.
  40628.                     table add: current.
  40629.                     count := count + 1].
  40630.             current := '        ' , (self variableTypeFor: (variableSet at: count)
  40631.                             noName: #true) , '. '.
  40632.             table add: current].
  40633.     ^table! !
  40634.  
  40635. !TTMList methodsFor: 'code generation'!
  40636. makeNegation: aGuard 
  40637.     | root |
  40638.     root := (ParseTree orderIntoTree: (ParseTree fission: aGuard definedAs: #guard)
  40639.                 from: selection) negation inPrenexForm treeRoot.
  40640.     self guardTraverseP3: root.
  40641.     ^self separateLinesP3: root left contents! !
  40642.  
  40643. !TTMList methodsFor: 'code generation'!
  40644. makeNegations
  40645.     "Create negen() predicates for all of the 
  40646.     
  40647.     transitions in the ttm, selection."
  40648.  
  40649.     | table common current samplename sampleguard supplement trCount currentTr |
  40650.     table := OrderedCollection new.
  40651.     common := 'negen(' , selection named , ', '.
  40652.     trCount := 1.
  40653.     [trCount > editedtrlist size]
  40654.         whileFalse: 
  40655.             [currentTr := editedtrlist at: trCount.
  40656.             samplename := currentTr at: 1.
  40657.             sampleguard := currentTr at: 2.
  40658.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  40659.             sampleguard = 'nil'
  40660.                 ifTrue: [table add: current , '. ']
  40661.                 ifFalse: 
  40662.                     [current := current , ' {'.
  40663.                     supplement := self makeNegation: sampleguard copy.
  40664.                     supplement do: [:x | table add: current , x , '}. ']].
  40665.             trCount := trCount + 1].
  40666.     ^table! !
  40667.  
  40668. !TTMList methodsFor: 'code generation'!
  40669. makeNegationsDebug
  40670.     "Create negen() predicates for all of the 
  40671.     
  40672.     transitions in the ttm, selection."
  40673.  
  40674.     | table common current samplename sampleguard supplement trCount currentTr temp  |
  40675.     table := OrderedCollection new.
  40676.     temp := OrderedCollection new.
  40677.     common := 'negen(' , selection named , ', '.
  40678.     trCount := 1.
  40679.     [trCount > editedtrlist size]
  40680.         whileFalse: 
  40681.             [currentTr := editedtrlist at: trCount.
  40682.             samplename := currentTr at: 1.
  40683.             sampleguard := currentTr at: 2.
  40684.             temp add: sampleguard.
  40685.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  40686.             sampleguard = 'nil'
  40687.                 ifTrue: [table add: current , '. ']
  40688.                 ifFalse: 
  40689.                     [current := current , ' {'.
  40690.                     supplement := (TTMList new) makeNegation: sampleguard.
  40691.                     temp add: supplement.
  40692.                     supplement do: [:x | table add: current , x , '}. ']].
  40693.             trCount := trCount + 1].
  40694.     temp inspect.
  40695.     ^table! !
  40696.  
  40697. !TTMList methodsFor: 'code generation'!
  40698. makeNegationsNew
  40699.     "Create negen() predicates for all of the 
  40700.     
  40701.     transitions in the ttm, selection."
  40702.  
  40703.     | table common current samplename sampleguard supplement trCount currentTr |
  40704.     table := OrderedCollection new.
  40705.     common := 'negen(' , selection named , ', '.
  40706.     trCount := 1.
  40707.     [trCount > editedtrlist size]
  40708.         whileFalse: 
  40709.             [currentTr := editedtrlist at: trCount.
  40710.             samplename := currentTr at: 1.
  40711.             sampleguard := currentTr at: 2.
  40712.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  40713.             sampleguard = 'nil'
  40714.                 ifTrue: [table add: current , '. ']
  40715.                 ifFalse: 
  40716.                     [current := current , ' {'.
  40717.                     supplement := self makeNegation: sampleguard.
  40718.                     supplement do: [:x | table add: current , x , '}. ']].
  40719.             trCount := trCount + 1].
  40720.     ^table! !
  40721.  
  40722. !TTMList methodsFor: 'code generation'!
  40723. makeNegationsOld
  40724.     "Create negen() predicates for all of the 
  40725.     
  40726.     transitions in the ttm, selection."
  40727.  
  40728.     | table common current samplename sampleguard supplement count trCount currentTr |
  40729.     table := OrderedCollection new.
  40730.     common := 'negen(' , selection named , ', '.
  40731.     trCount := 1.
  40732.     [trCount > editedtrlist size]
  40733.         whileFalse: 
  40734.             [currentTr := editedtrlist at: trCount.
  40735.             samplename := currentTr at: 1.
  40736.             sampleguard := currentTr at: 2.
  40737.             current := common , samplename , ', ' , self variablesUppercase , ')'.
  40738.             sampleguard = 'nil'
  40739.                 ifTrue: [table add: current , '. ']
  40740.                 ifFalse: 
  40741.                     [current := current , ' {'.
  40742.                     supplement := self makeNegation: sampleguard.
  40743.                     count := 1.
  40744.                     [count > supplement size]
  40745.                         whileFalse: 
  40746.                             [table add: current , (supplement at: count) , '}. '.
  40747.                             count := count + 1]].
  40748.             trCount := trCount + 1].
  40749.     ^table! !
  40750.  
  40751. !TTMList methodsFor: 'code generation'!
  40752. makeSF: anSF with: anSFNumber for: prologType 
  40753.     | table supplement count preamble temp1 |
  40754.     table := OrderedCollection new.
  40755.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  40756.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  40757.             ifFalse: 
  40758.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  40759.                 prologType = #quintus
  40760.                     ifTrue: 
  40761.                         [preamble := preamble , ' :-'.
  40762.                         table add: preamble]
  40763.                     ifFalse: [preamble := preamble , ' {'].
  40764.                 supplement := self makeGuard: anSF copy for: prologType.
  40765.                 count := 1.
  40766.                 [count > supplement size]
  40767.                     whileFalse: 
  40768.                         [prologType = #quintus
  40769.                             ifTrue: 
  40770.                                 [temp1 := supplement at: count.
  40771.                                 (self isArithmetic: temp1)
  40772.                                     = true & ((self containLtOrGt: temp1)
  40773.                                         = false)
  40774.                                     ifTrue: 
  40775.                                         [temp1 := TTMList
  40776.                                                     inString: temp1
  40777.                                                     replace: '='
  40778.                                                     with: ' =:= '.
  40779.                                         temp1 := TTMList
  40780.                                                     inString: temp1
  40781.                                                     replace: '#'
  40782.                                                     with: ' =\= '.
  40783.                                         table add: temp1]
  40784.                                     ifFalse: 
  40785.                                         [temp1 := TTMList
  40786.                                                     inString: temp1
  40787.                                                     replace: '#'
  40788.                                                     with: ' \= '.
  40789.                                         table add: temp1]]
  40790.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  40791.                         count := count + 1]]].
  40792.     ^table! !
  40793.  
  40794. !TTMList methodsFor: 'code generation'!
  40795. makeSFDebug: anSF with: anSFNumber for: prologType 
  40796.     | table supplement count preamble temp|
  40797.     table := OrderedCollection new.
  40798.     temp := OrderedCollection new.
  40799.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  40800.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  40801.             ifFalse: 
  40802.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  40803.                 prologType = #quintus
  40804.                     ifTrue: 
  40805.                         [preamble := preamble , ' :-'.
  40806.                         table add: preamble]
  40807.                     ifFalse: [preamble := preamble , ' {'].
  40808.                 supplement := self makeGuard: anSF copy for: prologType.
  40809.                 temp add: supplement.
  40810.                 count := 1.
  40811.                 [count > supplement size]
  40812.                     whileFalse: 
  40813.                         [prologType = #quintus
  40814.                             ifTrue: [table add: (supplement at: count)]
  40815.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  40816.                         count := count + 1]]].
  40817.     supplement inspect.
  40818.     ^table! !
  40819.  
  40820. !TTMList methodsFor: 'code generation'!
  40821. makeSFNegations: anSF with: anSFNumber 
  40822.     "Create negsf predicates for the selected TTM"
  40823.  
  40824.     | table current supplement |
  40825.     table := OrderedCollection new.
  40826.     current := 'negsf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  40827.     anSF = 'nil'
  40828.         ifTrue: [table add: current , '. ']
  40829.         ifFalse: 
  40830.             [current := current , ' {'.
  40831.             supplement := self makeNegation: anSF copy.
  40832.             supplement do: [:x | table add: current , x , '}. ']].
  40833.     ^table! !
  40834.  
  40835. !TTMList methodsFor: 'code generation'!
  40836. makeSFNew: anSF with: anSFNumber for: prologType 
  40837.     | table supplement count preamble |
  40838.     table := OrderedCollection new.
  40839.     variableSet size > 0 ifTrue: [anSF asString = 'nil'
  40840.             ifTrue: [table add: 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , '). ']
  40841.             ifFalse: 
  40842.                 [preamble := 'sf(' , selection named , ', ' , anSFNumber , ', ' , self variablesUppercase , ')'.
  40843.                 prologType = #quintus
  40844.                     ifTrue: 
  40845.                         [preamble := preamble , ' :-'.
  40846.                         table add: preamble]
  40847.                     ifFalse: [preamble := preamble , ' {'].
  40848.                 supplement := self makeGuard: anSF copy for: prologType.
  40849.                 count := 1.
  40850.                 [count > supplement size]
  40851.                     whileFalse: 
  40852.                         [prologType = #quintus
  40853.                             ifTrue: [table add: (supplement at: count)]
  40854.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  40855.                         count := count + 1]]].
  40856.     ^table! !
  40857.  
  40858. !TTMList methodsFor: 'code generation'!
  40859. makeTypeForAV: anActivityVariable 
  40860.     | set aString count total |
  40861.     set := selection typeForAV: anActivityVariable.
  40862.     total := set size.
  40863.     aString := ''.
  40864.     enumerateActivities > 0
  40865.         ifTrue: 
  40866.             [aString := (anActivityVariable at: 1) asString , ' >= 1, ' , (anActivityVariable at: 1) asString.
  40867.             aString := aString , ' =< ' , total printString]
  40868.         ifFalse: 
  40869.             [count := 1.
  40870.             [count > set size]
  40871.                 whileFalse: 
  40872.                     [aString := aString , (anActivityVariable at: 1) asString , '=' , (set at: count) myName asString.
  40873.                     count = set size ifFalse: [aString := aString , '; '].
  40874.                     count := count + 1]].
  40875.     ^aString! !
  40876.  
  40877. !TTMList methodsFor: 'code generation'!
  40878. makeTypesFor: prologType 
  40879.     | table current count leftmargin v inset |
  40880.     table := OrderedCollection new.
  40881.     leftmargin := '        '.
  40882.     count := 1.
  40883.     [count > variableSet size]
  40884.         whileFalse: 
  40885.             [v := variableSet at: count.
  40886.             current := self variableTypeFor: v noName: #false.
  40887.             prologType = #quintus
  40888.                 ifTrue: [current := current , ' :- ']
  40889.                 ifFalse: [current := current , ' {'].
  40890.             table add: current.
  40891.             current := leftmargin.
  40892.             (selection anExistingDV: (v at: 1))
  40893.                 ifTrue: 
  40894.                     [(v at: 2)
  40895.                         = '-infinity' ifFalse: [current := current , (v at: 1) , ' >= ' , (v at: 2)].
  40896.                     (v at: 3)
  40897.                         = 'infinity'
  40898.                         ifFalse: 
  40899.                             [(v at: 2)
  40900.                                 ~= '-infinity'
  40901.                                 ifTrue: 
  40902.                                     [current := current , ','.
  40903.                                     table add: current].
  40904.                             current := leftmargin , (v at: 1) , ' =< ' , (v at: 3).
  40905.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  40906.                             current := current , '.'.
  40907.                             table add: current]
  40908.                         ifTrue: 
  40909.                             [(v at: 2)
  40910.                                 = '-infinity' ifTrue: [current := leftmargin , (v at: 1) , ' >= 0; ' , (v at: 1) , ' < 0'].
  40911.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  40912.                             current := current , '. '.
  40913.                             table add: current]]
  40914.                 ifFalse: 
  40915.                     [inset := self makeTypeForAV: v.
  40916.                     prologType = #quintus
  40917.                         ifTrue: [current := current , '(' , inset , '). ']
  40918.                         ifFalse: [current := current , inset , '}. '].
  40919.                     table add: current].
  40920.             count := count + 1].
  40921.     ^table! !
  40922.  
  40923. !TTMList methodsFor: 'code generation'!
  40924. oldmakeInitialConditionFor: prologType 
  40925.     | table supplement count preamble |
  40926.     table := OrderedCollection new.
  40927.     variableSet size > 0 ifTrue: [selection initialcondition asString = 'nil'
  40928.             ifTrue: [table add: 'initialcondition(' , selection named , ', ' , self variablesUppercase , '). ']
  40929.             ifFalse: 
  40930.                 [preamble := 'initialcondition(' , selection named , ', ' , self variablesUppercase , ')'.
  40931.                 prologType = #quintus
  40932.                     ifTrue: 
  40933.                         [preamble := preamble , ' :-'.
  40934.                         table add: preamble]
  40935.                     ifFalse: [preamble := preamble , ' {'].
  40936.                 supplement := self makeGuard: selection initialcondition for: prologType.
  40937.                 count := 1.
  40938.                 [count > supplement size]
  40939.                     whileFalse: 
  40940.                         [prologType = #quintus
  40941.                             ifTrue: [table add: (supplement at: count)]
  40942.                             ifFalse: [table add: preamble , (supplement at: count) , '}. '].
  40943.                         count := count + 1]]].
  40944.     ^table! !
  40945.  
  40946. !TTMList methodsFor: 'code generation'!
  40947. separateLinesP3: aString 
  40948.     "Given a string, divide it into lines 
  40949.     
  40950.     separated at commas."
  40951.  
  40952.     | lines aLine newString left position c segment |
  40953.     (aString at: aString size)
  40954.         = $, | ((aString at: aString size)
  40955.             = $;)
  40956.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  40957.         ifFalse: [newString := aString].
  40958.     lines := OrderedCollection new.
  40959.     left := 1.
  40960.     position := 1.
  40961.     aLine := ''.
  40962.     [position > aString size]
  40963.         whileFalse: 
  40964.             [c := newString at: position.
  40965.             c = $;
  40966.                 ifTrue: 
  40967.                     [segment := newString copyFrom: left to: position - 1.
  40968.                     aLine := aLine , segment.
  40969.                     left := position + 1.
  40970.                     lines add: aLine.
  40971.                     aLine := ''].
  40972.             position := position + 1].
  40973.     segment := newString copyFrom: left to: position - 1.
  40974.     aLine := aLine , segment.
  40975.     lines add: aLine.
  40976.     ^lines! !
  40977.  
  40978. !TTMList methodsFor: 'code generation'!
  40979. separateLinesQuintus: aString 
  40980.     "Given a string, divide it into lines 
  40981.     
  40982.     separated at commas and semi-colons. 
  40983.     
  40984.     End it with a period."
  40985.  
  40986.     | lines aLine leftMargin newString left position c segment |
  40987.     (aString at: aString size)
  40988.         = $, | ((aString at: aString size)
  40989.             = $;)
  40990.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  40991.         ifFalse: [newString := aString].
  40992.     leftMargin := '        '.
  40993.     lines := OrderedCollection new.
  40994.     left := 1.
  40995.     position := 1.
  40996.     aLine := leftMargin , ''.
  40997.     [position > aString size]
  40998.         whileFalse: 
  40999.             [c := newString at: position.
  41000.             c = $, | (c = $;)
  41001.                 ifTrue: 
  41002.                     [segment := newString copyFrom: left to: position.
  41003.                     aLine := aLine , segment.
  41004.                     left := position + 1.
  41005.                     "lines add: (TTMList
  41006.                             inString: aLine
  41007.                             replace: '#'
  41008.                             with: ' \= ')."
  41009.                     lines add: aLine.
  41010.                     aLine := leftMargin , ''].
  41011.             c = $) ifTrue: [leftMargin := leftMargin copyFrom: 1 to: leftMargin size - 1].
  41012.             c = $( ifTrue: [leftMargin := leftMargin , ' '].
  41013.             position := position + 1].
  41014.     segment := newString copyFrom: left to: position - 1.
  41015.     aLine := aLine , segment , '.'.
  41016.     "lines add: (TTMList
  41017.             inString: aLine
  41018.             replace: '#'
  41019.             with: ' \= ')."
  41020.     lines add: aLine.
  41021.     ^lines! !
  41022.  
  41023. !TTMList methodsFor: 'code generation'!
  41024. separateLinesQuintusSF: aString 
  41025.     "Given a string, divide it into lines 
  41026.     
  41027.     separated at commas and semi-colons. 
  41028.     
  41029.     End it with a period."
  41030.  
  41031.     | lines aLine leftMargin newString left position c segment |
  41032.     (aString at: aString size)
  41033.         = $, | ((aString at: aString size)
  41034.             = $;)
  41035.         ifTrue: [newString := aString copyFrom: 1 to: aString size - 1]
  41036.         ifFalse: [newString := aString].
  41037.     leftMargin := '        '.
  41038.     lines := OrderedCollection new.
  41039.     left := 1.
  41040.     position := 1.
  41041.     aLine := leftMargin , ''.
  41042.     [position > aString size]
  41043.         whileFalse: 
  41044.             [c := newString at: position.
  41045.             c = $, | (c = $;)
  41046.                 ifTrue: 
  41047.                     [segment := newString copyFrom: left to: position.
  41048.                     aLine := aLine , segment.
  41049.                     left := position + 1.
  41050.                     "lines add: (TTMList
  41051.                             inString: aLine
  41052.                             replace: '#'
  41053.                             with: ' \= ')."
  41054.                     lines add: aLine.
  41055.                     aLine := leftMargin , ''].
  41056.             c = $) ifTrue: [leftMargin := leftMargin copyFrom: 1 to: leftMargin size - 1].
  41057.             c = $( ifTrue: [leftMargin := leftMargin , ' '].
  41058.             position := position + 1].
  41059.     segment := newString copyFrom: left to: position - 1.
  41060.     aLine := aLine , segment , '.'.
  41061.     "lines add: (TTMList
  41062.             inString: aLine
  41063.             replace: '#'
  41064.             with: ' \= ')."
  41065.     lines add: aLine.
  41066.     ^lines! !
  41067.  
  41068. !TTMList methodsFor: 'code generation'!
  41069. variablesInitialize
  41070.     | count existingDV |
  41071.     variableSet := selection activityvariable collect: [:existingAV | existingAV].
  41072.     count := 1.
  41073.     selection datavariable size
  41074.         timesRepeat: 
  41075.             [existingDV := selection datavariable at: count.
  41076.             count := count + 1.
  41077.             variableSet add: existingDV]! !
  41078.  
  41079. !TTMList methodsFor: 'code generation'!
  41080. variablesLowercase
  41081.     | current count |
  41082.     variableSet size > 0
  41083.         ifTrue: 
  41084.             [current := '['.
  41085.             count := 1.
  41086.             [count >= variableSet size]
  41087.                 whileFalse: 
  41088.                     [current := current , ((variableSet at: count)
  41089.                                     at: 1) asText asLowercase asString , ','.
  41090.                     count := count + 1].
  41091.             current := current , ((variableSet at: count)
  41092.                             at: 1) asText asLowercase asString , ']'.
  41093.             ^current]
  41094.         ifFalse: [^nil]! !
  41095.  
  41096. !TTMList methodsFor: 'code generation'!
  41097. variablesUppercase
  41098.     | current count |
  41099.     variableSet size > 0
  41100.         ifTrue: 
  41101.             [current := '['.
  41102.             count := 1.
  41103.             [count >= variableSet size]
  41104.                 whileFalse: 
  41105.                     [current := current , ((variableSet at: count)
  41106.                                     at: 1) asString , ','.
  41107.                     count := count + 1].
  41108.             current := current , ((variableSet at: count)
  41109.                             at: 1) asString , ']'.
  41110.             ^current]
  41111.         ifFalse: [^nil]! !
  41112.  
  41113. !TTMList methodsFor: 'code generation'!
  41114. variableTypeFor: variable noName: aBoolean 
  41115.     aBoolean = #true
  41116.         ifTrue: [^'type(' , (variable at: 1) asText asLowercase asString , ', ' , (variable at: 1) asString , ')']
  41117.         ifFalse: [^'type(' , selection named , ', ' , (variable at: 1) asText asLowercase asString , ', ' , (variable at: 1) asString , ')']! !
  41118.  
  41119. !TTMList methodsFor: 'button access'!
  41120. doAdd
  41121.     "Prompt the user for a TTM name and activity variable."
  41122.  
  41123.     | choice activityvariable newTTM existingNames avDefault |
  41124.     choice := DialogView request: '(First letter must be lower case)' , (String with: Character cr) , 'New TTM name?'.
  41125.     choice isEmpty
  41126.         ifTrue: [^self]
  41127.         ifFalse: [(TTMList aUsefulTTMName: choice)
  41128.                 ifFalse: 
  41129.                     [TTMList speak: 'illegal TTM name - add aborted'.
  41130.                     ^self]
  41131.                 ifTrue: 
  41132.                     [existingNames := models collect: [:existingTTM | existingTTM named].
  41133.                     (existingNames includes: choice)
  41134.                         ifTrue: 
  41135.                             [TTMList speak: 'TTM name already used - add aborted.'.
  41136.                             ^self].
  41137.                     avDefault := 'X_' , choice.
  41138.                     activityvariable := DialogView
  41139.                                 request: '(First letter must be upper case)' , (String with: Character cr) , 'Activity Variable of TTM?'
  41140.                                 initialAnswer: avDefault
  41141.                                 onCancel: [^nil].
  41142.                     activityvariable isEmpty
  41143.                         ifTrue: 
  41144.                             [TTMList speak: 'activity variable not given - add aborted.'.
  41145.                             ^self]
  41146.                         ifFalse: [(TTMList aUsefulTTMName: activityvariable)
  41147.                                 & (activityvariable at: 1) isUppercase
  41148.                                 ifTrue: 
  41149.                                     [newTTM := TTM create: choice with: activityvariable.
  41150.                                     models add: newTTM.
  41151.                                     newTTM openWindows: (Array
  41152.                                             with: 0
  41153.                                             with: 0
  41154.                                             with: 0
  41155.                                             with: 0).
  41156.                                     self changed: #transaction]
  41157.                                 ifFalse: 
  41158.                                     [TTMList speak: 'illegal Activity Variable name - add aborted.'.
  41159.                                     ^self]]]]! !
  41160.  
  41161. !TTMList methodsFor: 'button access'!
  41162. doConditions
  41163.     selection isNil
  41164.         ifFalse: 
  41165.             [(selection openWindows at: 1)
  41166.                 = 1
  41167.                 ifTrue: 
  41168.                     [TTMList speak: 'window is already open.'.
  41169.                     ^nil]
  41170.                 ifFalse: [selection openWindows at: 1 put: 1].
  41171.             ConditionsWindow open: selection]! !
  41172.  
  41173. !TTMList methodsFor: 'button access'!
  41174. doCopy
  41175.     "Prompt the user for name of new TTM."
  41176.  
  41177.     | newname oldname newTTM |
  41178.     selection == nil
  41179.         ifFalse: 
  41180.             [oldname := selection named , '2'.
  41181.             newname := DialogView
  41182.                         request: 'Name for copy of TTM?'
  41183.                         initialAnswer: oldname
  41184.                         onCancel: [^nil].
  41185.             newname isEmpty
  41186.                 ifTrue: [^self]
  41187.                 ifFalse: 
  41188.                     [newTTM := selection aCopy.
  41189.                     newTTM named: newname.
  41190.                     newTTM activitytree getRoot myName: newname.
  41191.                     models add: newTTM.
  41192.                     newTTM openWindows: (Array
  41193.                             with: 0
  41194.                             with: 0
  41195.                             with: 0
  41196.                             with: 0).
  41197.                     self changed: #transaction]]! !
  41198.  
  41199. !TTMList methodsFor: 'button access'!
  41200. doEdit
  41201.     "Edit the selected TTM. We pass it the entire list 
  41202.     
  41203.     because we need to allow TTM insertion."
  41204.  
  41205.     selection == nil
  41206.         ifFalse: 
  41207.             [(selection openWindows at: 2)
  41208.                 = 1
  41209.                 ifTrue: []
  41210.                 ifFalse: [selection openWindows at: 2 put: 1].
  41211.             EditingWindow open: selection from: self]! !
  41212.  
  41213. !TTMList methodsFor: 'button access'!
  41214. doFileAccess
  41215.  
  41216.      FileList openOnPattern: '*' for: self! !
  41217.  
  41218. !TTMList methodsFor: 'button access'!
  41219. doFileAccess1
  41220.     | window container myWrapper left hsize top vsize qButton sButton dirListView ldButton |
  41221.     currentDir := Filename currentDirectory.
  41222.     dirContents := currentDir directoryContents.
  41223.     window := ScheduledWindow new.
  41224.     window label: 'File Access'.
  41225.     window minimumSize: 200 @ 200.
  41226.     window insideColor: ColorValue white.
  41227.     container := CompositePart new.
  41228.     dirListView := SelectionInListView
  41229.                 on: self
  41230.                 printItems: false
  41231.                 oneItem: false
  41232.                 aspect: #fileTransaction
  41233.                 change: #fileSelection:
  41234.                 list: #fileList
  41235.                 menu: nil
  41236.                 initialSelection: nil
  41237.                 useIndex: true.
  41238.     myWrapper := TTMList wrap: (LookPreferences edgeDecorator on: dirListView).
  41239.     container add: myWrapper borderedIn: (0.02 @ 0.06 extent: 0.96 @ 0.8).
  41240.     left := 0.02.
  41241.     hsize := 0.3.
  41242.     top := 0.9.
  41243.     vsize := 0.09.
  41244.     sButton := PushButton named: 'Save'.
  41245.     sButton model: ((PluggableAdaptor on: self)
  41246.             getBlock: [:model | false]
  41247.             putBlock: [:model :value | model fileSave]
  41248.             updateBlock: [:model :value :parameter | false]).
  41249.     (container add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  41250.         insideColor: ColorValue white.
  41251.     left := left + 0.3.
  41252.     ldButton := PushButton named: 'Load'.
  41253.     ldButton model: ((PluggableAdaptor on: self)
  41254.             getBlock: [:model | false]
  41255.             putBlock: [:model :value | model fileLoad]
  41256.             updateBlock: [:model :value :parameter | false]).
  41257.     (container add: ldButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  41258.         insideColor: ColorValue white.
  41259.     left := left + 0.3.
  41260.     qButton := PushButton named: 'Exit'.
  41261.     qButton model: ((PluggableAdaptor on: self)
  41262.             getBlock: [:model | false]
  41263.             putBlock: [:model :value | ScheduledControllers activeController close]
  41264.             updateBlock: [:model :value :parameter | false]).
  41265.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  41266.         insideColor: ColorValue white.
  41267.     window component: container.
  41268.     window open! !
  41269.  
  41270. !TTMList methodsFor: 'button access'!
  41271. doFileAccessNew
  41272.     FileList openOnPattern: '*.mdl' for: self! !
  41273.  
  41274. !TTMList methodsFor: 'button access'!
  41275. doGenerate
  41276.     "Generate Code."
  41277.  
  41278.     | labels prompt window top container topCorner hsize vsize okButton notokButton bigSize |
  41279.     selection == nil
  41280.         ifFalse: 
  41281.             [enumerateActivities := 0.
  41282.             labels := OrderedCollection new.
  41283.             labels add: 'TTM code'; add: 'State Formula code'; add: ' in Quintus Prolog'; add: ' in Prolog III'; add: ' with enumeration'.
  41284.             prompt := 'Code Generation'.
  41285.             window := ScheduledWindow
  41286.                         model: nil
  41287.                         label: prompt
  41288.                         minimumSize: 250 @ 200.
  41289.             window maximumSize: 250 @ 200.
  41290.             top := DialogView new.
  41291.             container := CompositePart new.
  41292.             topCorner := 0.1.
  41293.             hsize := 0.2.
  41294.             vsize := 0.15.
  41295.             okButton := PushButton named: 'accept'.
  41296.             okButton model: ((PluggableAdaptor on: self)
  41297.                     getBlock: [:model | false]
  41298.                     putBlock: [:model :value | model doRunGenerate]
  41299.                     updateBlock: [:model :value :parameter | false]).
  41300.             (container add: okButton borderedIn: ((LayoutFrame new) leftFraction: 0.2; topFraction: topCorner; rightFraction: 0.2 + hsize; bottomFraction: topCorner + vsize))
  41301.                 borderColor: ColorValue black;
  41302.                 borderWidth: 1.
  41303.             notokButton := PushButton named: 'cancel'.
  41304.             notokButton model: ((PluggableAdaptor on: self)
  41305.                     getBlock: [:model | false]
  41306.                     putBlock: [:model :value | ScheduledControllers activeController close]
  41307.                     updateBlock: [:model :value :parameter | false]).
  41308.             (container add: notokButton borderedIn: ((LayoutFrame new) leftFraction: 0.56; topFraction: topCorner; rightFraction: 0.56 + hsize; bottomFraction: topCorner + vsize))
  41309.                 borderColor: ColorValue black;
  41310.                 borderWidth: 1.
  41311.             temporary := (1 to: labels size)
  41312.                         collect: [:i | ValueHolder newBoolean].
  41313.             top leftIndent: 70; rightIndent: 300; yPosition: 70;
  41314.                 addColumn: (1 to: temporary size)
  41315.                 fromX: 0
  41316.                 toX: 1
  41317.                 collect: 
  41318.                     [:i | 
  41319.                     | view |
  41320.                     view := LabeledBooleanView model: (temporary at: i).
  41321.                     view beRadioButton.
  41322.                     view controller beToggle.
  41323.                     view label: (labels at: i).
  41324.                     BorderedWrapper on: view].
  41325.             container add: top.
  41326.             bigSize := top preferredBounds extent copy.
  41327.             bigSize y: bigSize y + 20.
  41328.             window component: container.
  41329.             window openWithExtent: bigSize]! !
  41330.  
  41331. !TTMList methodsFor: 'button access'!
  41332. doQuery
  41333.     selection == nil
  41334.         ifFalse: 
  41335.             [(selection openWindows at: 3)
  41336.                 = 1
  41337.                 ifTrue: 
  41338.                     [TTMList speak: 'window is already open.'.
  41339.                     ^nil]
  41340.                 ifFalse: [selection openWindows at: 3 put: 1].
  41341.             QueryWindow openTable: selection]! !
  41342.  
  41343. !TTMList methodsFor: 'button access'!
  41344. doRemove
  41345.     "Prompt the user for name of TTM to be removed."
  41346.  
  41347.     | location ans1 |
  41348.     selection == nil
  41349.         ifFalse: 
  41350.             [ans1 := DialogView confirm: 'Are you certain you wish to remove TTM?'.
  41351.             ans1 = true
  41352.                 ifTrue: 
  41353.                     [location := models indexOf: selection.
  41354.                     models removeAtIndex: location.
  41355.                     self changed: #transaction]]! !
  41356.  
  41357. !TTMList methodsFor: 'button access'!
  41358. doRename
  41359.     "Prompt the user for name of TTM to be renamed."
  41360.  
  41361.     | newname oldname |
  41362.     selection == nil
  41363.         ifFalse: 
  41364.             [oldname := selection named.
  41365.             newname := DialogView
  41366.                         request: 'New name for TTM?'
  41367.                         initialAnswer: oldname
  41368.                         onCancel: [^nil].
  41369.             newname isEmpty
  41370.                 ifTrue: [^self]
  41371.                 ifFalse: 
  41372.                     [selection named: newname.
  41373.                     selection activitytree getRoot myName: newname.
  41374.                     self changed: #transaction]]! !
  41375.  
  41376. !TTMList methodsFor: 'button access'!
  41377. doSimulate
  41378.     selection == nil
  41379.         ifFalse: 
  41380.             [(selection openWindows at: 4)
  41381.                 = 1
  41382.                 ifTrue: 
  41383.                     [TTMList speak: 'window is already open.'.
  41384.                     ^nil]
  41385.                 ifFalse: [selection openWindows at: 4 put: 1].
  41386.             SimulateWindow open: selection]! !
  41387.  
  41388. !TTMList methodsFor: 'list access'!
  41389. realTTMList
  41390.  
  41391.      ^models! !
  41392.  
  41393. !TTMList methodsFor: 'list access'!
  41394. selection: index 
  41395.     "If the selection has been changed, remember the new 
  41396.     
  41397.     selection."
  41398.  
  41399.     | newSel |
  41400.     newSel := index = 0
  41401.                 ifTrue: [nil]
  41402.                 ifFalse: [models at: index].
  41403.     selection == newSel ifTrue: [^self].
  41404.     selection := newSel.
  41405.     self changed: #noteList.
  41406.     self changed: #dvTransaction.
  41407.     self changed: #avTransaction.
  41408.     self changed: #chTransaction.
  41409.     self changed: #sfTransaction! !
  41410.  
  41411. !TTMList methodsFor: 'list access'!
  41412. ttmList
  41413.  
  41414.      ^models collect: [:existingTTM | (existingTTM named)  ]! !
  41415.  
  41416. !TTMList methodsFor: 'list access'!
  41417. ttmListMenu
  41418.     | labelValues menuValues |
  41419.     selection == nil
  41420.         ifTrue: 
  41421.             [menuValues := #(#doAdd #doFileAccess ).
  41422.             labelValues := #(#(#add ) #(#'file access' ) )]
  41423.         ifFalse: 
  41424.             [menuValues := #(#doAdd #doRemove #doRename #doCopy #doEdit #doConditions #doQuery #doSimulate #doGenerate #doFileAccess ).
  41425.             labelValues := #(#(#add #remove #rename ) #(#copy #edit #'specify IC' ) #(#query #simulate #'generate code' ) #(#'file
  41426.  
  41427. access' ) )].
  41428.     ^PopUpMenu labelList: labelValues values: menuValues! !
  41429.  
  41430. !TTMList methodsFor: 'variable access'!
  41431. avList
  41432.  
  41433.     selection == nil ifTrue: [^nil].
  41434.  
  41435.     ^selection activityvariable collect: [:existingAV | existingAV at: 1]! !
  41436.  
  41437. !TTMList methodsFor: 'variable access'!
  41438. avMenu
  41439.  
  41440.      avSelection == nil ifTrue: [^nil].
  41441.  
  41442.      ^PopUpMenu
  41443.  
  41444.                labelList: #((rename))
  41445.  
  41446.                values: #(avRename)! !
  41447.  
  41448. !TTMList methodsFor: 'variable access'!
  41449. avRename
  41450.     | newname oldname oldAV newAV |
  41451.     avSelection == nil
  41452.         ifFalse: 
  41453.             [oldname := avSelection at: 1.
  41454.             newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New name for activity variable?' initialAnswer: oldname.
  41455.             newname isEmpty
  41456.                 ifTrue: [^self]
  41457.                 ifFalse: [(selection aValidVariableName: newname)
  41458.                         ifFalse: 
  41459.                             [TTMList speak: 'illegal variable name.'.
  41460.                             ^self]
  41461.                         ifTrue: 
  41462.                             [oldAV := avSelection copy.
  41463.                             avSelection at: 1 put: newname.
  41464.                             newAV := avSelection copy.
  41465.                             self changed: #avTransaction.
  41466.                             selection renameVariable: oldname asString to: newname asString.
  41467.                             selection
  41468.                                 changeAllAVsAt: selection activitytree getRoot
  41469.                                 from: oldAV
  41470.                                 to: newAV.
  41471.                             selection renameActivityVariable: (oldAV at: 1)
  41472.                                 to: (newAV at: 1).
  41473.                             self changed: #curSFList]]]! !
  41474.  
  41475. !TTMList methodsFor: 'variable access'!
  41476. avSelection: index 
  41477.     "If the selection has been changed, remember the new 
  41478.     
  41479.     selection."
  41480.  
  41481.     | newSel |
  41482.     selection == nil
  41483.         ifFalse: 
  41484.             [newSel := index = 0
  41485.                         ifTrue: [nil]
  41486.                         ifFalse: [selection activityvariable at: index].
  41487.             avSelection == newSel ifTrue: [^self].
  41488.             avSelection := newSel]! !
  41489.  
  41490. !TTMList methodsFor: 'variable access'!
  41491. currentDirectory
  41492.     ^currentDirectory! !
  41493.  
  41494. !TTMList methodsFor: 'variable access'!
  41495. currentDirectory: aDirectory 
  41496.     currentDirectory := aDirectory! !
  41497.  
  41498. !TTMList methodsFor: 'variable access'!
  41499. dvAdd
  41500.     "Add an data variable."
  41501.  
  41502.     | newname |
  41503.     newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New data variable name?'.
  41504.     newname isEmpty
  41505.         ifTrue: [^self]
  41506.         ifFalse: [(selection aValidVariableName: newname)
  41507.                 ifFalse: [TTMList speak: 'illegal data variable name']
  41508.                 ifTrue: [(selection anExistingAV: newname)
  41509.                         = true | ((selection anExistingDV: newname)
  41510.                             = true)
  41511.                         ifTrue: [TTMList speak: newname , ' : variable name already in use']
  41512.                         ifFalse: 
  41513.                             [selection
  41514.                                 datavariable: newname
  41515.                                 lrange: '0'
  41516.                                 hrange: 'infinity'
  41517.                                 initial: '0'.
  41518.                             selection updateSpecificIC.
  41519.                             self changed: #dvTransaction]]]! !
  41520.  
  41521. !TTMList methodsFor: 'variable access'!
  41522. dvChangeHigh
  41523.  
  41524.     "Change upper bound of a data variable."
  41525.  
  41526.  
  41527.  
  41528.     | high oldHigh initialAsNumber highAsNumber lowAsNumber |
  41529.  
  41530.     dvSelection == nil
  41531.  
  41532.         ifFalse: 
  41533.  
  41534.             [oldHigh := dvSelection at: 3.
  41535.  
  41536.             high := DialogView request: 'New upper limit for data variable?' initialAnswer: oldHigh.
  41537.  
  41538.             high isEmpty ifTrue: [^self].
  41539.  
  41540.             (TTMList aValidNumber: high)
  41541.  
  41542.                 & (high ~= '-infinity')
  41543.  
  41544.                 ifFalse: 
  41545.  
  41546.                     [TTMList speak: 'invalid upper bound.'.
  41547.  
  41548.                     ^nil].
  41549.  
  41550.             highAsNumber := TTMList convertToNumber: high.
  41551.  
  41552.             (dvSelection at: 2)
  41553.  
  41554.                 ~= '-infinity'
  41555.  
  41556.                 ifTrue: 
  41557.  
  41558.                     [lowAsNumber := TTMList convertToNumber: (dvSelection at: 2).
  41559.  
  41560.                     highAsNumber > lowAsNumber
  41561.  
  41562.                         ifFalse: 
  41563.  
  41564.                             [TTMList speak: 'invalid upper bound.'.
  41565.  
  41566.                             ^nil]].
  41567.  
  41568.             dvSelection at: 3 put: high.
  41569.  
  41570.             high = 'infinity' ifFalse: [(dvSelection at: 4)
  41571.  
  41572.                     = 'infinity'
  41573.  
  41574.                     ifFalse: 
  41575.  
  41576.                         [initialAsNumber := TTMList convertToNumber: (dvSelection at: 4).
  41577.  
  41578.                         initialAsNumber > highAsNumber ifTrue: [dvSelection at: 4 put: (dvSelection at: 2)]]].
  41579.  
  41580.             self changed: #dvTransaction]! !
  41581.  
  41582. !TTMList methodsFor: 'variable access'!
  41583. dvChangeLow
  41584.  
  41585.     "Change lower bound of a data variable."
  41586.  
  41587.  
  41588.  
  41589.     | low oldLow initialAsNumber lowAsNumber highAsNumber |
  41590.  
  41591.     dvSelection == nil
  41592.  
  41593.         ifFalse: 
  41594.  
  41595.             [oldLow := dvSelection at: 2.
  41596.  
  41597.             low := DialogView request: 'New lower limit for data variable?' initialAnswer: oldLow.
  41598.  
  41599.             low isEmpty ifTrue: [^self].
  41600.  
  41601.             (TTMList aValidNumber: low)
  41602.  
  41603.                 & (low ~= 'infinity')
  41604.  
  41605.                 ifFalse: 
  41606.  
  41607.                     [TTMList speak: 'invalid lower bound.'.
  41608.  
  41609.                     ^nil].
  41610.  
  41611.             lowAsNumber := TTMList convertToNumber: low.
  41612.  
  41613.             (dvSelection at: 3)
  41614.  
  41615.                 ~= 'infinity'
  41616.  
  41617.                 ifTrue: 
  41618.  
  41619.                     [highAsNumber := TTMList convertToNumber: (dvSelection at: 3).
  41620.  
  41621.                     lowAsNumber < highAsNumber
  41622.  
  41623.                         ifFalse: 
  41624.  
  41625.                             [TTMList speak: 'invalid lower bound'.
  41626.  
  41627.                             ^nil]].
  41628.  
  41629.             dvSelection at: 2 put: low.
  41630.  
  41631.             (dvSelection at: 4)
  41632.  
  41633.                 = 'infinity'
  41634.  
  41635.                 ifTrue: 
  41636.  
  41637.                     [dvSelection at: 4 put: low.
  41638.  
  41639.                     self changed: #icTransaction]
  41640.  
  41641.                 ifFalse: 
  41642.  
  41643.                     [initialAsNumber := TTMList convertToNumber: (dvSelection at: 4).
  41644.  
  41645.                     initialAsNumber < lowAsNumber ifTrue: [dvSelection at: 4 put: low]].
  41646.  
  41647.             self changed: #dvTransaction]! !
  41648.  
  41649. !TTMList methodsFor: 'variable access'!
  41650. dvList
  41651.  
  41652.     | low high |
  41653.  
  41654.     selection == nil
  41655.  
  41656.         ifTrue: [^nil]
  41657.  
  41658.         ifFalse: 
  41659.  
  41660.             [low := '  low: '.
  41661.  
  41662.             high := '  high: '.
  41663.  
  41664.             ^selection datavariable collect: [:existingDV | (existingDV at: 1)
  41665.  
  41666.                     , low , (existingDV at: 2) , high , (existingDV at: 3)]]! !
  41667.  
  41668. !TTMList methodsFor: 'variable access'!
  41669. dvMenu
  41670.  
  41671.     selection == nil ifTrue: [^nil].
  41672.  
  41673.     dvSelection == nil
  41674.  
  41675.         ifTrue: [^PopUpMenu labelList: #(#(#add ) ) values: #(#dvAdd )]
  41676.  
  41677.         ifFalse: [^PopUpMenu labelList: #(#(#add #remove #rename 'new lower limit' 'new upper limit' ) ) values: #(#dvAdd #dvRemove #dvRename #dvChangeLow #dvChangeHigh )]! !
  41678.  
  41679. !TTMList methodsFor: 'variable access'!
  41680. dvRemove
  41681.  
  41682.     "Remove a data variable."
  41683.  
  41684.  
  41685.  
  41686.     | location |
  41687.  
  41688.     dvSelection == nil ifFalse: [(selection variableIsBeingUsed: (dvSelection at: 1))
  41689.  
  41690.             ifTrue: [TTMList speak: 'Cannot delete - data variable is used within TTM.']
  41691.  
  41692.             ifFalse: 
  41693.  
  41694.                 [location := selection datavariable indexOf: dvSelection.
  41695.  
  41696.                 selection datavariable removeAtIndex: location.
  41697.  
  41698.                 selection updateSpecificIC.
  41699.  
  41700.                 self changed: #dvTransaction]]! !
  41701.  
  41702. !TTMList methodsFor: 'variable access'!
  41703. dvRename
  41704.     "Rename a data variable."
  41705.  
  41706.     | newname oldname |
  41707.     dvSelection == nil
  41708.         ifFalse: 
  41709.             [oldname := dvSelection at: 1.
  41710.             newname := DialogView request: '(First letter must be upper case)' , (String with: Character cr) , 'New name for data variable?' initialAnswer: oldname.
  41711.             newname isEmpty
  41712.                 ifTrue: [^self]
  41713.                 ifFalse: [(selection aValidVariableName: newname)
  41714.                         ifFalse: 
  41715.                             [TTMList speak: 'illegal variable name.'.
  41716.                             ^self]
  41717.                         ifTrue: 
  41718.                             [dvSelection at: 1 put: newname.
  41719.                             self changed: #dvTransaction.
  41720.                             selection renameVariable: oldname asString to: newname asString.
  41721.                             self changed: #curSFList]]]! !
  41722.  
  41723. !TTMList methodsFor: 'variable access'!
  41724. dvSelection: index 
  41725.  
  41726.      "If the selection has been changed, remember the new
  41727.  
  41728. selection."
  41729.  
  41730.  
  41731.  
  41732.      | newSel |
  41733.  
  41734.      newSel := index = 0
  41735.  
  41736.                     ifTrue: [nil]
  41737.  
  41738.                     ifFalse: [selection datavariable at: index].
  41739.  
  41740.      dvSelection == newSel ifTrue: [^self].
  41741.  
  41742.      dvSelection := newSel.! !
  41743.  
  41744. !TTMList methodsFor: 'variable access'!
  41745. fileSelection: aFileName 
  41746.  
  41747.      fileSelection := aFileName! !
  41748.  
  41749. !TTMList methodsFor: 'variable access'!
  41750. tempStack
  41751.  
  41752.      ^tempStack! !
  41753.  
  41754. !TTMList methodsFor: 'variable access'!
  41755. tempStack: anyThing 
  41756.  
  41757.      tempStack := anyThing! !
  41758.  
  41759. !TTMList methodsFor: 'note pad access'!
  41760. noteAccept: candidate 
  41761.  
  41762.      selection note: candidate asString.
  41763.  
  41764.      ^true! !
  41765.  
  41766. !TTMList methodsFor: 'note pad access'!
  41767. noteList
  41768.  
  41769.      selection == nil
  41770.  
  41771.           ifTrue: [^nil]
  41772.  
  41773.           ifFalse: [^selection note]! !
  41774.  
  41775. !TTMList methodsFor: 'note pad access'!
  41776. noteMenu
  41777.  
  41778.     selection ~~ nil ifFalse: [^nil]
  41779.  
  41780.         ifTrue: [^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #accept #cancel )]! !
  41781.  
  41782. !TTMList methodsFor: 'channel access'!
  41783. chAdd
  41784.     "Add a communication channel."
  41785.  
  41786.     | newname |
  41787.     newname := DialogView request: 'New communication channel name?'.
  41788.     newname isEmpty
  41789.         ifTrue: [^self]
  41790.         ifFalse: [(selection aValidVariableName: newname)
  41791.                 ifTrue: 
  41792.                     [selection commchannel: newname.
  41793.                     self changed: #chTransaction]]! !
  41794.  
  41795. !TTMList methodsFor: 'channel access'!
  41796. chList
  41797.     selection == nil
  41798.         ifTrue: [^nil]
  41799.         ifFalse: [^selection commchannel collect: [:existingCH | existingCH at: 1]]! !
  41800.  
  41801. !TTMList methodsFor: 'channel access'!
  41802. chMenu
  41803.     selection == nil ifTrue: [^nil].
  41804.     chSelection == nil
  41805.         ifTrue: [^PopUpMenu labelList: #(#(#add ) ) values: #(#chAdd )]
  41806.         ifFalse: [^PopUpMenu labelList: #(#(#add #remove #rename ) ) values: #(#chAdd #chRemove #chRename )]! !
  41807.  
  41808. !TTMList methodsFor: 'channel access'!
  41809. chRemove
  41810.     "Remove a communication channel."
  41811.  
  41812.     | location |
  41813.     chSelection == nil ifFalse: [(selection variableIsBeingUsed: (chSelection at: 1))
  41814.             ifTrue: [TTMList speak: 'Cannot delete - comm. channel is used within TTM.']
  41815.             ifFalse: 
  41816.                 [location := selection commchannel indexOf: chSelection.
  41817.                 selection commchannel removeAtIndex: location.
  41818.                 self changed: #chTransaction]]! !
  41819.  
  41820. !TTMList methodsFor: 'channel access'!
  41821. chRename
  41822.     "Rename a communication channel."
  41823.  
  41824.     | newname oldname |
  41825.     chSelection == nil
  41826.         ifFalse: 
  41827.             [oldname := chSelection at: 1.
  41828.             newname := DialogView request: 'New name for comm. channel?' initialAnswer: oldname.
  41829.             newname isEmpty
  41830.                 ifTrue: [^self]
  41831.                 ifFalse: [(selection aValidVariableName: newname)
  41832.                         ifFalse: [^self]
  41833.                         ifTrue: 
  41834.                             [chSelection at: 1 put: newname.
  41835.                             self changed: #chTransaction.
  41836.                             selection renameVariable: oldname asString to: newname asString]]]! !
  41837.  
  41838. !TTMList methodsFor: 'channel access'!
  41839. chSelection: index 
  41840.     "If the selection has been changed, remember the new 
  41841.     
  41842.     selection."
  41843.  
  41844.     | newSel |
  41845.     newSel := index = 0
  41846.                 ifTrue: [nil]
  41847.                 ifFalse: [selection commchannel at: index].
  41848.     chSelection == newSel ifTrue: [^self].
  41849.     chSelection := newSel! !
  41850.  
  41851. !TTMList methodsFor: 'sf access'!
  41852. curSFAccept: candidateCondition 
  41853.     | accept cCondition ast undefined |
  41854.     accept := false.
  41855.     candidateCondition isEmpty
  41856.         ifTrue: [cCondition := 'nil']
  41857.         ifFalse: [cCondition := candidateCondition].
  41858.     cCondition asString = 'nil'
  41859.         ifTrue: [accept := true]
  41860.         ifFalse: 
  41861.             [accept := true.
  41862.             ast := BuildBoolParser new parseForAST: cCondition asString
  41863.                         ifFail: 
  41864.                             [TTMList speak: cCondition asString , ' : Invalid state formula'.
  41865.                             accept := false]].
  41866.     accept = false ifFalse: [ast rhsVars do: [:x | (selection anExistingAV: x)
  41867.                 = false & ((selection anExistingDV: x)
  41868.                     = false)
  41869.                 ifTrue: 
  41870.                     [undefined isNil ifTrue: [undefined := ''].
  41871.                     undefined := undefined , '  ' , x]]].
  41872.     accept = false | undefined notNil = true
  41873.         ifTrue: [undefined notNil
  41874.                 ifTrue: 
  41875.                     [TTMList speak: (cCondition asString , ' : state formula\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  41876.                     self changed: #curSFList.
  41877.                     ^true]]
  41878.         ifFalse: 
  41879.             [sfSelection at: 2 put: cCondition asString.
  41880.             self changed: #curSFList.
  41881.             ^true]! !
  41882.  
  41883. !TTMList methodsFor: 'sf access'!
  41884. curSFAcceptNew: candidateCondition 
  41885.     | accept cCondition ast undefined |
  41886.     accept := false.
  41887.     candidateCondition isEmpty
  41888.         ifTrue: [cCondition := 'nil']
  41889.         ifFalse: [cCondition := candidateCondition].
  41890.     cCondition asString = 'nil'
  41891.         ifTrue: [accept := true]
  41892.         ifFalse: 
  41893.             [accept := true.
  41894.             ast := BuildBoolParser new parseForAST: cCondition asString
  41895.                         ifFail: 
  41896.                             [TTMList speak: cCondition asString , ' : Invalid state formula'.
  41897.                             accept := false]].
  41898.     accept = false ifFalse: [ast rhsVars do: [:x | (selection anExistingAV: x)
  41899.                 = false & (selection anExistingDV: x) = false
  41900.                 ifTrue: 
  41901.                     [undefined isNil ifTrue: [undefined := ''].
  41902.                     undefined := undefined , '  ' , x]]].
  41903.     accept = false | undefined notNil = true
  41904.         ifTrue: [undefined notNil
  41905.                 ifTrue: 
  41906.                     [TTMList speak: (cCondition asString , ' : state formula\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  41907.                     self changed: #curSFList.
  41908.                     ^true]]
  41909.         ifFalse: 
  41910.             [sfSelection at: 2 put: cCondition asString.
  41911.             self changed: #curSFList.
  41912.             ^true]! !
  41913.  
  41914. !TTMList methodsFor: 'sf access'!
  41915. curSFAcceptOld: candidateCondition 
  41916.     | accept cCondition |
  41917.     accept := false.
  41918.     candidateCondition isEmpty
  41919.         ifTrue: [cCondition := 'nil']
  41920.         ifFalse: [cCondition := candidateCondition].
  41921.     cCondition asString = 'nil'
  41922.         ifTrue: [accept := true]
  41923.         ifFalse: [(ParseTree guardSyntaxCheck: cCondition asString from: selection)
  41924.                 ifFalse: [accept := true]].
  41925.     accept = false
  41926.         ifFalse: 
  41927.             [sfSelection at: 2 put: cCondition asString.
  41928.             self changed: #curSFList.
  41929.             ^true]
  41930.         ifTrue: 
  41931.             [TTMList speak: 'revised state formula rejected.'.
  41932.             self changed: #curSFList.
  41933.             ^true]! !
  41934.  
  41935. !TTMList methodsFor: 'sf access'!
  41936. curSFList
  41937.  
  41938.      sfSelection == nil
  41939.  
  41940.           ifTrue: [^nil]
  41941.  
  41942.           ifFalse: [^sfSelection at: 2]! !
  41943.  
  41944. !TTMList methodsFor: 'sf access'!
  41945. curSFMenu
  41946.     selection == nil | (sfSelection == nil)
  41947.         ifTrue: [^nil]
  41948.         ifFalse: [^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #accept #cancel )]! !
  41949.  
  41950. !TTMList methodsFor: 'sf access'!
  41951. sfAdd
  41952.     | newname totalNumber checkIfValid count okay temp |
  41953.     totalNumber := selection stateFormulas size.
  41954.     checkIfValid := true.
  41955.     [checkIfValid = true]
  41956.         whileTrue: 
  41957.             [count := 1.
  41958.             okay := true.
  41959.             [count > selection stateFormulas size]
  41960.                 whileFalse: 
  41961.                     [((selection stateFormulas at: count)
  41962.                         at: 1)
  41963.                         = totalNumber printString
  41964.                         ifTrue: 
  41965.                             [okay := false.
  41966.                             count := selection stateFormulas size].
  41967.                     count := count + 1].
  41968.             okay = true
  41969.                 ifTrue: [checkIfValid := false]
  41970.                 ifFalse: [totalNumber := totalNumber + 1]].
  41971.     newname := DialogView request: 'New state formula name?' initialAnswer: totalNumber printString.
  41972.     newname isEmpty
  41973.         ifTrue: [^self]
  41974.         ifFalse: 
  41975.             [temp := selection stateFormulas collect: [:x | x at: 1].
  41976.             (TTMList aUsefulActLabel: newname)
  41977.                 ifTrue: [(temp includes: newname)
  41978.                         ifFalse: 
  41979.                             [selection stateFormulas: newname holding: 'nil'.
  41980.                             self changed: #sfTransaction]
  41981.                         ifTrue: [DialogView warn: 'State Formula Name Already in Use']]]! !
  41982.  
  41983. !TTMList methodsFor: 'sf access'!
  41984. sfClear
  41985.  
  41986.      selection stateFormulas: OrderedCollection new.
  41987.  
  41988.      self changed: #sfTransaction! !
  41989.  
  41990. !TTMList methodsFor: 'sf access'!
  41991. sfCopy
  41992.     | newname copiedsf |
  41993.     sfSelection == nil
  41994.         ifFalse: 
  41995.             [newname := DialogView request: 'Copied state formula number?'.
  41996.             newname isEmpty
  41997.                 ifTrue: [^self]
  41998.                 ifFalse: [(TTMList aUsefulActLabel: newname)
  41999.                         ifFalse: 
  42000.                             [TTMList speak: 'illegal sf name.'.
  42001.                             ^self]
  42002.                         ifTrue: 
  42003.                             [copiedsf := sfSelection at: 2.
  42004.                             selection stateFormulas: newname holding: copiedsf.
  42005.                             self changed: #sfTransaction]]]! !
  42006.  
  42007. !TTMList methodsFor: 'sf access'!
  42008. sfList
  42009.  
  42010.      selection == nil
  42011.  
  42012.           ifTrue: [^nil]
  42013.  
  42014.           ifFalse: [^selection stateFormulas collect:
  42015.  
  42016. [:existingSF | existingSF at: 1]]! !
  42017.  
  42018. !TTMList methodsFor: 'sf access'!
  42019. sfMenu
  42020.     selection == nil ifTrue: [^nil].
  42021.     sfSelection == nil
  42022.         ifTrue: [^PopUpMenu labelList: #(#(#add #clear ) ) values: #(#sfAdd #sfClear )]
  42023.         ifFalse: [^PopUpMenu labelList: #(#(#add #copy #clear #remove #renumber ) ) values: #(#sfAdd #sfCopy #sfClear #sfRemove #sfRenumber )]! !
  42024.  
  42025. !TTMList methodsFor: 'sf access'!
  42026. sfRemove
  42027.     | location |
  42028.     sfSelection == nil
  42029.         ifFalse: 
  42030.             [location := selection stateFormulas indexOf: sfSelection.
  42031.             selection stateFormulas removeAtIndex: location.
  42032.             self changed: #sfTransaction]! !
  42033.  
  42034. !TTMList methodsFor: 'sf access'!
  42035. sfRenumber
  42036.  
  42037.      | newname oldname |
  42038.  
  42039.      sfSelection == nil
  42040.  
  42041.           ifFalse: 
  42042.  
  42043.                [oldname := sfSelection at: 1.
  42044.  
  42045.                newname := DialogView request: 'New number for
  42046.  
  42047. SF?' initialAnswer: oldname.
  42048.  
  42049.                newname isEmpty
  42050.  
  42051.                     ifTrue: [^self]
  42052.  
  42053.                     ifFalse: [(TTMList aUsefulActLabel: newname)
  42054.  
  42055.                               ifFalse: [^self]
  42056.  
  42057.                               ifTrue: 
  42058.  
  42059.                                    [sfSelection at: 1 put:
  42060.  
  42061. newname.
  42062.  
  42063.                                    self changed:
  42064.  
  42065. #sfTransaction]]]! !
  42066.  
  42067. !TTMList methodsFor: 'sf access'!
  42068. sfSelection: index 
  42069.  
  42070.      "If the selection has been changed, remember the new
  42071.  
  42072. selection."
  42073.  
  42074.  
  42075.  
  42076.      | newSel |
  42077.  
  42078.      newSel := index = 0
  42079.  
  42080.                     ifTrue: [nil]
  42081.  
  42082.                     ifFalse: [selection stateFormulas at: index].
  42083.  
  42084.      sfSelection == newSel ifTrue: [^self].
  42085.  
  42086.      sfSelection := newSel.
  42087.  
  42088.      self changed: #curSFList! !
  42089.  
  42090. !TTMList methodsFor: 'filing operations'!
  42091. actualFileLoad
  42092.     | newTTM |
  42093.     newTTM := TTM getTTMFromFile: fileSelection.
  42094.     temporaryTTM := newTTM aCopy.
  42095.     temporaryTTM openWindows: (Array
  42096.             with: 0
  42097.             with: 0
  42098.             with: 0
  42099.             with: 0).
  42100.     models add: temporaryTTM.
  42101.     self changed: #transaction! !
  42102.  
  42103. !TTMList methodsFor: 'filing operations'!
  42104. actualFileLoadOld
  42105.     | aStream result line packingSection allParts |
  42106.     aStream := (Filename named: fileSelection) readStream.
  42107.     packingSection := nil.
  42108.     allParts := OrderedCollection new.
  42109.     result := aStream next.
  42110.     line := ''.
  42111.     [result notNil]
  42112.         whileTrue: 
  42113.             [result = Character cr
  42114.                 ifTrue: [line = ''
  42115.                         ifTrue: []
  42116.                         ifFalse: 
  42117.                             [(line at: 1)
  42118.                                 = $% | (line = '')
  42119.                                 ifTrue: []
  42120.                                 ifFalse: [(line at: 1)
  42121.                                         = $*
  42122.                                         ifTrue: 
  42123.                                             [self packAway: allParts into: packingSection.
  42124.                                             packingSection := line.
  42125.                                             allParts := OrderedCollection new]
  42126.                                         ifFalse: [packingSection = '*Initial Conditions' | (packingSection = '*State Formulas' | (packingSection = '*Note Pad'))
  42127.                                                 ifTrue: [allParts add: line]
  42128.                                                 ifFalse: [allParts add: (TTMList elementsFromLine: line)]]].
  42129.                             line := '']]
  42130.                 ifFalse: [line := line , (String with: result)].
  42131.             result := aStream next].
  42132.     aStream close! !
  42133.  
  42134. !TTMList methodsFor: 'filing operations'!
  42135. actualFileSave: aFileName 
  42136.     TTM storeTTM: selection onFile: aFileName! !
  42137.  
  42138. !TTMList methodsFor: 'filing operations'!
  42139. actualFileSaveOld: aFileName 
  42140.     | aStream count current listOfActivities left cc right actvar aPoint node arc icName icSet entry |
  42141.     aStream := (Filename named: aFileName) writeStream.
  42142.     selection fileTitle: selection named , '.model Description' on: aStream.
  42143.     selection fileLine: '%' on: aStream.
  42144.     selection fileLine: '*Activity Variables' on: aStream.
  42145.     selection fileLine: '%==================' on: aStream.
  42146.     count := 1.
  42147.     [count > selection activityvariable size]
  42148.         whileFalse: 
  42149.             [current := selection activityvariable at: count.
  42150.             selection fileLine: (current at: 1)
  42151.                     , ' ' , (current at: 2) on: aStream.
  42152.             count := count + 1].
  42153.     selection fileLine: '%' on: aStream.
  42154.     selection fileLine: '*Data Variables' on: aStream.
  42155.     selection fileLine: '%==============' on: aStream.
  42156.     count := 1.
  42157.     [count > selection datavariable size]
  42158.         whileFalse: 
  42159.             [current := selection datavariable at: count.
  42160.             selection fileLine: (current at: 1)
  42161.                     , ' ' , (current at: 2) , ' ' , (current at: 3) , ' ' , (current at: 4) on: aStream.
  42162.             count := count + 1].
  42163.     selection fileLine: '%' on: aStream.
  42164.     selection fileLine: '*Communication Channels' on: aStream.
  42165.     selection fileLine: '%======================' on: aStream.
  42166.     count := 1.
  42167.     [count > selection commchannel size]
  42168.         whileFalse: 
  42169.             [current := selection commchannel at: count.
  42170.             selection fileLine: (current at: 1)
  42171.                 on: aStream.
  42172.             count := count + 1].
  42173.     selection fileLine: '%' on: aStream.
  42174.     selection fileLine: '*State Formulas' on: aStream.
  42175.     selection fileLine: '%==============' on: aStream.
  42176.     count := 1.
  42177.     [count > selection stateFormulas size]
  42178.         whileFalse: 
  42179.             [current := selection stateFormulas at: count.
  42180.             selection fileLine: '!!' , (current at: 1) on: aStream.
  42181.             selection fileLine: (current at: 2)
  42182.                 on: aStream.
  42183.             count := count + 1].
  42184.     selection fileLine: '%' on: aStream.
  42185.     selection fileLine: '*Initial Conditions' on: aStream.
  42186.     selection fileLine: '%==================' on: aStream.
  42187.     selection fileLine: selection initialcondition on: aStream.
  42188.     selection fileLine: '%' on: aStream.
  42189.     selection fileLine: '*Specific Initial Conditions' on: aStream.
  42190.     selection fileLine: '%===========================' on: aStream.
  42191.     count := 1.
  42192.     [count > selection specificIC size]
  42193.         whileFalse: 
  42194.             [current := selection specificIC at: count.
  42195.             icName := '!!' , (current at: 1).
  42196.             icSet := current at: 2.
  42197.             selection fileLine: icName on: aStream.
  42198.             cc := 1.
  42199.             [cc > icSet size]
  42200.                 whileFalse: 
  42201.                     [entry := icSet at: cc.
  42202.                     selection fileLine: (entry at: 1)
  42203.                             , ' ' , (entry at: 2) on: aStream.
  42204.                     cc := cc + 1].
  42205.             count := count + 1].
  42206.     selection fileLine: '%' on: aStream.
  42207.     selection fileLine: '*Activities' on: aStream.
  42208.     selection fileLine: '%==========' on: aStream.
  42209.     listOfActivities := selection activitytree listOfActivities.
  42210.     count := 1.
  42211.     [count > listOfActivities size]
  42212.         whileFalse: 
  42213.             [current := listOfActivities at: count.
  42214.             selection fileLine: '% --------' , count printString , '--------' on: aStream.
  42215.             current left isNil
  42216.                 ifTrue: [left := '@']
  42217.                 ifFalse: 
  42218.                     [cc := 1.
  42219.                     [cc > listOfActivities size]
  42220.                         whileFalse: 
  42221.                             [(listOfActivities at: cc)
  42222.                                 = current left ifTrue: [left := cc printString].
  42223.                             cc := cc + 1]].
  42224.             current right isNil
  42225.                 ifTrue: [right := '@']
  42226.                 ifFalse: 
  42227.                     [cc := 1.
  42228.                     [cc > listOfActivities size]
  42229.                         whileFalse: 
  42230.                             [(listOfActivities at: cc)
  42231.                                 = current right ifTrue: [right := cc printString].
  42232.                             cc := cc + 1]].
  42233.             selection fileLine: current myName on: aStream.
  42234.             selection fileLine: left on: aStream.
  42235.             selection fileLine: right on: aStream.
  42236.             selection fileLine: current collectionType printString on: aStream.
  42237.             selection fileLine: current default printString on: aStream.
  42238.             cc := 1.
  42239.             [cc > selection activityvariable size]
  42240.                 whileFalse: 
  42241.                     [current av = (selection activityvariable at: cc) ifTrue: [actvar := cc printString].
  42242.                     cc := cc + 1].
  42243.             selection fileLine: actvar on: aStream.
  42244.             current myBox isNil
  42245.                 ifTrue: 
  42246.                     [selection fileLine: '@' on: aStream.
  42247.                     selection fileLine: '@' on: aStream.
  42248.                     selection fileLine: '@' on: aStream]
  42249.                 ifFalse: 
  42250.                     [selection fileLine: current myBox depth printString on: aStream.
  42251.                     aPoint := TTMList pointToString: current myBox location.
  42252.                     selection fileLine: aPoint on: aStream.
  42253.                     aPoint := (TTMList pointToString: current myBox dimensions origin)
  42254.                                 , ' ' , (TTMList pointToString: current myBox dimensions corner).
  42255.                     selection fileLine: aPoint on: aStream].
  42256.             count := count + 1].
  42257.     selection fileLine: '%' on: aStream.
  42258.     selection fileLine: '*Transitions' on: aStream.
  42259.     selection fileLine: '%===========' on: aStream.
  42260.     count := 1.
  42261.     [count > selection transitionlist size]
  42262.         whileFalse: 
  42263.             [selection fileLine: '%----------' , count printString , '---------' on: aStream.
  42264.             current := selection transitionlist at: count.
  42265.             selection fileLine: current myName on: aStream.
  42266.             current startingAt isNil
  42267.                 ifTrue: [node := '@']
  42268.                 ifFalse: 
  42269.                     [cc := 1.
  42270.                     [cc > listOfActivities size]
  42271.                         whileFalse: 
  42272.                             [(listOfActivities at: cc)
  42273.                                 = current startingAt ifTrue: [node := cc printString].
  42274.                             cc := cc + 1]].
  42275.             selection fileLine: node on: aStream.
  42276.             current endingAt isNil
  42277.                 ifTrue: [node := '@']
  42278.                 ifFalse: 
  42279.                     [cc := 1.
  42280.                     [cc > listOfActivities size]
  42281.                         whileFalse: 
  42282.                             [(listOfActivities at: cc)
  42283.                                 = current endingAt ifTrue: [node := cc printString].
  42284.                             cc := cc + 1]].
  42285.             selection fileLine: node on: aStream.
  42286.             selection fileLine: current boundLower , ' ' , current boundUpper on: aStream.
  42287.             selection fileLine: current myGuard on: aStream.
  42288.             selection fileLine: current myAction on: aStream.
  42289.             selection fileLine: current depth printString on: aStream.
  42290.             arc := current myArc.
  42291.             aPoint := (TTMList pointToString: arc dimensions origin)
  42292.                         , ' ' , (TTMList pointToString: arc dimensions corner).
  42293.             selection fileLine: aPoint on: aStream.
  42294.             aPoint := (TTMList pointToString: arc sourceStart)
  42295.                         , ' ' , (TTMList pointToString: arc sourceMid) , ' ' , (TTMList pointToString: arc sourceEnd).
  42296.             aPoint := aPoint , ' ' , (TTMList pointToString: arc destStart) , ' ' , (TTMList pointToString: arc destMid) , ' ' , (TTMList pointToString: arc destEnd).
  42297.             selection fileLine: aPoint on: aStream.
  42298.             selection fileLine: arc sourceArrow printString , ' ' , arc destArrow printString on: aStream.
  42299.             count := count + 1].
  42300.     selection fileLine: '%' on: aStream.
  42301.     selection fileLine: '*Note Pad' on: aStream.
  42302.     selection fileLine: '%========' on: aStream.
  42303.     selection fileLine: selection note on: aStream.
  42304.     selection fileLine: '%' on: aStream.
  42305.     selection fileLine: '*END' on: aStream.
  42306.     aStream close! !
  42307.  
  42308. !TTMList methodsFor: 'filing operations'!
  42309. fileList
  42310.     dirContents := SortedCollection new.
  42311.     currentDir directoryContents do: [:x | dirContents add: x].
  42312.     ^dirContents! !
  42313.  
  42314. !TTMList methodsFor: 'filing operations'!
  42315. fileLoad
  42316.     | suffix invalidSelection |
  42317.     invalidSelection := false.
  42318.     fileSelection == nil
  42319.         ifTrue: 
  42320.             [TTMList speak: 'no file selected'.
  42321.             ^nil].
  42322.     (Filename named: fileSelection) exists
  42323.         ifFalse: 
  42324.             [TTMList speak: 'file does not exist'.
  42325.             ^nil].
  42326.     (Filename named: fileSelection) isDirectory
  42327.         ifTrue: 
  42328.             [TTMList speak: 'this is a directory, not a file.'.
  42329.             ^nil].
  42330.     (Filename named: fileSelection) isReadable
  42331.         ifFalse: 
  42332.             [TTMList speak: 'file is not readable.'.
  42333.             ^nil].
  42334.     invalidSelection = false
  42335.         ifTrue: 
  42336.             ["fileSelection size < 7 
  42337.             
  42338.             ifTrue: [invalidSelection := true] 
  42339.             
  42340.             ifFalse: [invalidSelection := false]."
  42341.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  42342.             suffix = '.mdl'
  42343.                 ifTrue: [self actualFileLoad]
  42344.                 ifFalse: [invalidSelection := true]].
  42345.     invalidSelection = true
  42346.         ifTrue: 
  42347.             [TTMList speak: 'this is not a .mdl file.'.
  42348.             ^nil]! !
  42349.  
  42350. !TTMList methodsFor: 'filing operations'!
  42351. fileLoadNew
  42352.     | suffix invalidSelection |
  42353.     invalidSelection := false.
  42354.     fileSelection == nil
  42355.         ifTrue: 
  42356.             [TTMList speak: 'no file selected'.
  42357.             ^nil].
  42358.     (Filename named: fileSelection) exists
  42359.         ifFalse: 
  42360.             [TTMList speak: 'file does not exist'.
  42361.             ^nil].
  42362.     (Filename named: fileSelection) isDirectory
  42363.         ifTrue: 
  42364.             [TTMList speak: 'this is a directory, not a file.'.
  42365.             ^nil].
  42366.     (Filename named: fileSelection) isReadable
  42367.         ifFalse: 
  42368.             [TTMList speak: 'file is not readable.'.
  42369.             ^nil].
  42370.     invalidSelection = false
  42371.         ifTrue: 
  42372.             ["fileSelection size < 7 
  42373.             
  42374.             ifTrue: [invalidSelection := true] 
  42375.             
  42376.             ifFalse: [invalidSelection := false]."
  42377.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  42378.             suffix = '.mdl'
  42379.                 ifTrue: [self actualFileLoad]
  42380.                 ifFalse: [invalidSelection := true]].
  42381.     invalidSelection = true
  42382.         ifTrue: 
  42383.             [TTMList speak: 'this is not a .mdl file.'.
  42384.             ^nil]! !
  42385.  
  42386. !TTMList methodsFor: 'filing operations'!
  42387. fileLoadOld
  42388.     | suffix invalidSelection |
  42389.     invalidSelection := false.
  42390.     fileSelection == nil
  42391.         ifTrue: 
  42392.             [TTMList speak: 'no file selected'.
  42393.             ^nil].
  42394.     (Filename named: fileSelection) exists
  42395.         ifFalse: 
  42396.             [TTMList speak: 'file does not exist'.
  42397.             ^nil].
  42398.     (Filename named: fileSelection) isDirectory
  42399.         ifTrue: 
  42400.             [TTMList speak: 'this is a directory, not a file.'.
  42401.             ^nil].
  42402.     (Filename named: fileSelection) isReadable
  42403.         ifFalse: 
  42404.             [TTMList speak: 'file is not readable.'.
  42405.             ^nil].
  42406.     invalidSelection = false
  42407.         ifTrue: 
  42408.             ["fileSelection size < 7 
  42409.             
  42410.             ifTrue: [invalidSelection := true] 
  42411.             
  42412.             ifFalse: [invalidSelection := false]."
  42413.             suffix := fileSelection copyFrom: fileSelection size - 3 to: fileSelection size.
  42414.             suffix = '.mdl'
  42415.                 ifTrue: [self actualFileLoad]
  42416.                 ifFalse: [invalidSelection := true]].
  42417.     invalidSelection = true
  42418.         ifTrue: 
  42419.             [TTMList speak: 'this is not a .mdl file.'.
  42420.             ^nil]! !
  42421.  
  42422. !TTMList methodsFor: 'filing operations'!
  42423. fileSave
  42424.     "Returns the stream in append mode or 
  42425.     
  42426.     returns nil if file could not be opened."
  42427.  
  42428.     | defaultName ready fileName go myMessage suffix fullPath |
  42429.     selection == nil
  42430.         ifTrue: 
  42431.             [TTMList speak: 'no TTM selected.'.
  42432.             ^nil].
  42433.     defaultName := selection named asString.
  42434.     ready := false.
  42435.     [ready]
  42436.         whileFalse: 
  42437.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  42438.             fileName isEmpty
  42439.                 ifTrue: 
  42440.                     [TTMList speak: 'No filename given - generation aborted.'.
  42441.                     ^nil]
  42442.                 ifFalse: 
  42443.                     [fileName size < 7
  42444.                         ifTrue: [fileName := fileName , '.mdl']
  42445.                         ifFalse: 
  42446.                             [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  42447.                             suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  42448.                     ready := true]].
  42449.     go := false.
  42450.     fullPath := (Filename named: selection getDirectory)
  42451.                 construct: fileName.
  42452.     fullPath exists
  42453.         ifTrue: 
  42454.             [myMessage := 'Filename already exists. Overwrite?'.
  42455.             (DialogView confirm: myMessage)
  42456.                 = true ifTrue: [go := true]]
  42457.         ifFalse: [go := true].
  42458.     go = true
  42459.         ifTrue: 
  42460.             [fullPath exists ifTrue: [fullPath isWritable
  42461.                     ifFalse: 
  42462.                         [TTMList speak: 'file is not writeable.'.
  42463.                         ^nil]].
  42464.             self actualFileSave: ((Filename named: selection getDirectory)
  42465.                     constructString: fileName).
  42466.             self changed: #fileTransaction]! !
  42467.  
  42468. !TTMList methodsFor: 'filing operations'!
  42469. fileSaveNew
  42470.     "Returns the stream in append mode or 
  42471.     
  42472.     returns nil if file could not be opened."
  42473.  
  42474.     | defaultName ready fileName go myMessage suffix fullPath |
  42475.     selection == nil
  42476.         ifTrue: 
  42477.             [TTMList speak: 'no TTM selected.'.
  42478.             ^nil].
  42479.     defaultName := selection named asString.
  42480.     ready := false.
  42481.     [ready]
  42482.         whileFalse: 
  42483.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  42484.             fileName isEmpty
  42485.                 ifTrue: 
  42486.                     [TTMList speak: 'No filename given - generation aborted.'.
  42487.                     ^nil]
  42488.                 ifFalse: 
  42489.                     [fileName size < 7
  42490.                         ifTrue: [fileName := fileName , '.mdl']
  42491.                         ifFalse: 
  42492.                             [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  42493.                             suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  42494.                     ready := true]].
  42495.     go := false.
  42496.     fullPath := (Filename named: fileName)
  42497.                 construct: fileName.
  42498.     fullPath exists
  42499.         ifTrue: 
  42500.             [myMessage := 'Filename already exists. Overwrite?'.
  42501.             (DialogView confirm: myMessage)
  42502.                 = true ifTrue: [go := true]]
  42503.         ifFalse: [go := true].
  42504.     go = true
  42505.         ifTrue: 
  42506.             [(Filename named: fileName) exists ifTrue: [(Filename named: fileName) isWritable
  42507.                     ifFalse: 
  42508.                         [TTMList speak: 'file is not writeable.'.
  42509.                         ^nil]].
  42510.             self actualFileSave: fileName.
  42511.             self changed: #fileTransaction]! !
  42512.  
  42513. !TTMList methodsFor: 'filing operations'!
  42514. fileSaveOld
  42515.     "Returns the stream in append mode or 
  42516.     
  42517.     returns nil if file could not be opened."
  42518.  
  42519.     | defaultName ready fileName go myMessage suffix |
  42520.     selection == nil
  42521.         ifTrue: 
  42522.             [TTMList speak: 'no TTM selected.'.
  42523.             ^nil].
  42524.     defaultName := selection named asString.
  42525.     ready := false.
  42526.     [ready]
  42527.         whileFalse: 
  42528.             [fileName := DialogView request: 'Name for .mdl file?' initialAnswer: defaultName.
  42529.             fileName isEmpty
  42530.                 ifTrue: 
  42531.                     [TTMList speak: 'No filename given - generation aborted.'.
  42532.                     ready := true]
  42533.                 ifFalse: 
  42534.                     [go := false.
  42535.                     (Filename named: fileName) exists
  42536.                         ifTrue: 
  42537.                             [myMessage := 'Filename already exists. Overwrite?'.
  42538.                             (DialogView confirm: myMessage)
  42539.                                 = true ifTrue: [go := true]]
  42540.                         ifFalse: [go := true].
  42541.                     go = true
  42542.                         ifTrue: 
  42543.                             [fileName size < 7
  42544.                                 ifTrue: [fileName := fileName , '.mdl']
  42545.                                 ifFalse: 
  42546.                                     [suffix := fileName copyFrom: fileName size - 5 to: fileName size.
  42547.                                     suffix = '.mdl' ifFalse: [fileName := fileName , '.mdl']].
  42548.                             ready := true]]].
  42549.     (Filename named: fileName) exists ifTrue: [(Filename named: fileName) isWritable
  42550.             ifFalse: 
  42551.                 [TTMList speak: 'file is not writeable.'.
  42552.                 ^nil]].
  42553.     self actualFileSave: fileName.
  42554.     self changed: #fileTransaction! !
  42555.  
  42556. !TTMList methodsFor: 'filing operations'!
  42557. packAway: allParts into: packingSection 
  42558.     | count currentAV currentDV currentCom actName actLeft actRight actType actDefault actAV actDepth actLocation actDimensions currentActivity currentBox aPoint anotherPoint currentTrList trStartAct trEndAct trLowerBound trUpperBound trGuard trAction trPoints cc theString arc pt1 pt2 pt5 pt6 trName trDepth trDimensions trArrows currentTr pt3 pt4 note line current collection sfName icName specifics stateFormulas newname |
  42559.     packingSection isNil ifTrue: [^nil].
  42560.     packingSection = '*Activity Variables'
  42561.         ifTrue: 
  42562.             [count := 1.
  42563.             currentAV := allParts at: count.
  42564.             temporaryTTM := TTM create: 'dummy' with: (currentAV at: 1).
  42565.             (temporaryTTM activityvariable at: 1)
  42566.                 at: 2 put: (currentAV at: 2).
  42567.             count := 2.
  42568.             [count > allParts size]
  42569.                 whileFalse: 
  42570.                     [currentAV := allParts at: count.
  42571.                     temporaryTTM activityvariable: (currentAV at: 1)
  42572.                         initial: (currentAV at: 2).
  42573.                     count := count + 1]].
  42574.     packingSection = '*Data Variables'
  42575.         ifTrue: 
  42576.             [count := 1.
  42577.             [count > allParts size]
  42578.                 whileFalse: 
  42579.                     [currentDV := allParts at: count.
  42580.                     temporaryTTM
  42581.                         datavariable: (currentDV at: 1)
  42582.                         lrange: (currentDV at: 2)
  42583.                         hrange: (currentDV at: 3)
  42584.                         initial: (currentDV at: 4).
  42585.                     count := count + 1]].
  42586.     packingSection = '*Communication Channels'
  42587.         ifTrue: 
  42588.             [count := 1.
  42589.             [count > allParts size]
  42590.                 whileFalse: 
  42591.                     [currentCom := allParts at: count.
  42592.                     temporaryTTM commchannel: (currentCom at: 1).
  42593.                     count := count + 1]].
  42594.     packingSection = '*State Formulas'
  42595.         ifTrue: 
  42596.             [count := 1.
  42597.             collection := ''.
  42598.             sfName := nil.
  42599.             stateFormulas := OrderedCollection new.
  42600.             [count > allParts size]
  42601.                 whileFalse: 
  42602.                     [current := allParts at: count.
  42603.                     (current at: 1)
  42604.                         = $!!
  42605.                         ifTrue: 
  42606.                             [sfName notNil ifTrue: [stateFormulas add: (Array with: sfName with: collection)].
  42607.                             sfName := current copyFrom: 2 to: current size.
  42608.                             collection := '']
  42609.                         ifFalse: [collection := collection , current , (String with: Character cr)].
  42610.                     count := count + 1].
  42611.             collection = '' ifFalse: [stateFormulas add: (Array with: sfName with: collection)].
  42612.             temporaryTTM stateFormulas: stateFormulas].
  42613.     packingSection = '*Initial Conditions'
  42614.         ifTrue: 
  42615.             [count := 1.
  42616.             note := ''.
  42617.             [count > allParts size]
  42618.                 whileFalse: 
  42619.                     [line := allParts at: count.
  42620.                     note := note , line , (String with: Character cr).
  42621.                     count := count + 1].
  42622.             temporaryTTM initialcondition: note].
  42623.     packingSection = '*Specific Initial Conditions'
  42624.         ifTrue: 
  42625.             [count := 1.
  42626.             collection := OrderedCollection new.
  42627.             specifics := OrderedCollection new.
  42628.             icName := nil.
  42629.             [count > allParts size]
  42630.                 whileFalse: 
  42631.                     [current := allParts at: count.
  42632.                     ((current at: 1)
  42633.                         at: 1)
  42634.                         = $!!
  42635.                         ifTrue: 
  42636.                             [icName notNil ifTrue: [specifics add: (Array with: icName with: collection)].
  42637.                             icName := (current at: 1)
  42638.                                         copyFrom: 2 to: (current at: 1) size.
  42639.                             collection := OrderedCollection new]
  42640.                         ifFalse: [collection add: (Array with: (current at: 1)
  42641.                                     with: (current at: 2))].
  42642.                     count := count + 1].
  42643.             collection size > 0 ifTrue: [specifics add: (Array with: icName with: collection)].
  42644.             temporaryTTM specificIC: specifics].
  42645.     packingSection = '*Activities'
  42646.         ifTrue: 
  42647.             [count := 1.
  42648.             activityStack := OrderedCollection new.
  42649.             [count > allParts size]
  42650.                 whileFalse: 
  42651.                     [actName := (allParts at: count)
  42652.                                 at: 1.
  42653.                     actLeft := (allParts at: count + 1)
  42654.                                 at: 1.
  42655.                     actRight := (allParts at: count + 2)
  42656.                                 at: 1.
  42657.                     actType := (allParts at: count + 3)
  42658.                                 at: 1.
  42659.                     actDefault := (allParts at: count + 4)
  42660.                                 at: 1.
  42661.                     actAV := (allParts at: count + 5)
  42662.                                 at: 1.
  42663.                     actDepth := (allParts at: count + 6)
  42664.                                 at: 1.
  42665.                     actLocation := allParts at: count + 7.
  42666.                     actDimensions := allParts at: count + 8.
  42667.                     currentActivity := Activity new.
  42668.                     currentActivity myName: actName.
  42669.                     actLeft = '@'
  42670.                         ifTrue: [currentActivity left: nil]
  42671.                         ifFalse: [currentActivity left: (activityStack at: (TTMList convertToNumber: actLeft))].
  42672.                     actRight = '@'
  42673.                         ifTrue: [currentActivity right: nil]
  42674.                         ifFalse: [currentActivity right: (activityStack at: (TTMList convertToNumber: actRight))].
  42675.                     actType = '#cluster'
  42676.                         ifTrue: [currentActivity collectionType: #cluster]
  42677.                         ifFalse: [currentActivity collectionType: #parallel].
  42678.                     actDefault = 'false'
  42679.                         ifTrue: [currentActivity default: false]
  42680.                         ifFalse: [currentActivity default: true].
  42681.                     currentActivity av: (temporaryTTM activityvariable at: (TTMList convertToNumber: actAV)).
  42682.                     (actLocation at: 1)
  42683.                         = '@'
  42684.                         ifTrue: [currentActivity myBox: nil]
  42685.                         ifFalse: 
  42686.                             [currentBox := Box new.
  42687.                             aPoint := TTMList stringToPoint: (actLocation at: 1)
  42688.                                         at: (actLocation at: 2).
  42689.                             currentBox location: aPoint.
  42690.                             aPoint := TTMList stringToPoint: (actDimensions at: 1)
  42691.                                         at: (actDimensions at: 2).
  42692.                             anotherPoint := TTMList stringToPoint: (actDimensions at: 3)
  42693.                                         at: (actDimensions at: 4).
  42694.                             currentBox dimensions: (Rectangle origin: aPoint corner: anotherPoint).
  42695.                             actDepth = '#hidden'
  42696.                                 ifTrue: [currentBox depth: #hidden]
  42697.                                 ifFalse: [currentBox depth: #exposed].
  42698.                             currentActivity myBox: currentBox].
  42699.                     activityStack add: currentActivity.
  42700.                     count := count + 9].
  42701.             temporaryTTM activitytree newRoot: (activityStack at: activityStack size).
  42702.             temporaryTTM named: temporaryTTM activitytree getRoot myName.
  42703.             [self ttmList includes: temporaryTTM named]
  42704.                 whileTrue: 
  42705.                     [newname := DialogView request: 'TTM of this name already exists.' , (String with: Character cr) , 'Please supply a new name for loaded TTM:'.
  42706.                     (TTMList aUsefulTTMName: newname)
  42707.                         ifTrue: [temporaryTTM named: newname]]].
  42708.     packingSection = '*Transitions'
  42709.         ifTrue: 
  42710.             [count := 1.
  42711.             currentTrList := TransitionList new.
  42712.             [count > allParts size]
  42713.                 whileFalse: 
  42714.                     [trName := (allParts at: count)
  42715.                                 at: 1.
  42716.                     trStartAct := (allParts at: count + 1)
  42717.                                 at: 1.
  42718.                     trEndAct := (allParts at: count + 2)
  42719.                                 at: 1.
  42720.                     trLowerBound := (allParts at: count + 3)
  42721.                                 at: 1.
  42722.                     trUpperBound := (allParts at: count + 3)
  42723.                                 at: 2.
  42724.                     trGuard := allParts at: count + 4.
  42725.                     trAction := allParts at: count + 5.
  42726.                     trDepth := (allParts at: count + 6)
  42727.                                 at: 1.
  42728.                     trDimensions := allParts at: count + 7.
  42729.                     trPoints := allParts at: count + 8.
  42730.                     trArrows := allParts at: count + 9.
  42731.                     currentTr := Transition new.
  42732.                     currentTr myName: trName.
  42733.                     currentTr startingAt: (activityStack at: (TTMList convertToNumber: trStartAct)).
  42734.                     currentTr endingAt: (activityStack at: (TTMList convertToNumber: trEndAct)).
  42735.                     currentTr boundLower: trLowerBound.
  42736.                     currentTr boundUpper: trUpperBound.
  42737.                     cc := 1.
  42738.                     theString := ''.
  42739.                     [cc > trGuard size]
  42740.                         whileFalse: 
  42741.                             [theString = ''
  42742.                                 ifTrue: [theString := trGuard at: cc]
  42743.                                 ifFalse: [theString := theString , ' ' , (trGuard at: cc)].
  42744.                             cc := cc + 1].
  42745.                     currentTr myGuard: theString.
  42746.                     cc := 1.
  42747.                     theString := ''.
  42748.                     [cc > trAction size]
  42749.                         whileFalse: 
  42750.                             [theString = ''
  42751.                                 ifTrue: [theString := trAction at: cc]
  42752.                                 ifFalse: [theString := theString , ' ' , (trAction at: cc)].
  42753.                             cc := cc + 1].
  42754.                     currentTr myAction: theString.
  42755.                     trDepth = '#hidden'
  42756.                         ifTrue: [currentTr depth: #hidden]
  42757.                         ifFalse: [currentTr depth: #exposed].
  42758.                     arc := Arc2 new.
  42759.                     pt1 := TTMList stringToPoint: (trDimensions at: 1)
  42760.                                 at: (trDimensions at: 2).
  42761.                     pt2 := TTMList stringToPoint: (trDimensions at: 3)
  42762.                                 at: (trDimensions at: 4).
  42763.                     arc dimensions: (Rectangle origin: pt1 corner: pt2).
  42764.                     pt1 := TTMList stringToPoint: (trPoints at: 1)
  42765.                                 at: (trPoints at: 2).
  42766.                     pt2 := TTMList stringToPoint: (trPoints at: 3)
  42767.                                 at: (trPoints at: 4).
  42768.                     pt3 := TTMList stringToPoint: (trPoints at: 5)
  42769.                                 at: (trPoints at: 6).
  42770.                     pt4 := TTMList stringToPoint: (trPoints at: 7)
  42771.                                 at: (trPoints at: 8).
  42772.                     pt5 := TTMList stringToPoint: (trPoints at: 9)
  42773.                                 at: (trPoints at: 10).
  42774.                     pt6 := TTMList stringToPoint: (trPoints at: 11)
  42775.                                 at: (trPoints at: 12).
  42776.                     arc sourceStart: pt1.
  42777.                     arc sourceMid: pt2.
  42778.                     arc sourceEnd: pt3.
  42779.                     arc destStart: pt4.
  42780.                     arc destMid: pt5.
  42781.                     arc destEnd: pt6.
  42782.                     arc sourceArrow: (TTMList convertToNumber: (trArrows at: 1)).
  42783.                     arc destArrow: (TTMList convertToNumber: (trArrows at: 2)).
  42784.                     currentTr myArc: arc.
  42785.                     currentTrList add: currentTr.
  42786.                     count := count + 10].
  42787.             temporaryTTM transitionlist: currentTrList].
  42788.     packingSection = '*Note Pad'
  42789.         ifTrue: 
  42790.             [count := 1.
  42791.             note := ''.
  42792.             [count > allParts size]
  42793.                 whileFalse: 
  42794.                     [line := allParts at: count.
  42795.                     note := note , line , (String with: Character cr).
  42796.                     count := count + 1].
  42797.             temporaryTTM note: note.
  42798.             models add: temporaryTTM.
  42799.             temporaryTTM openWindows: (Array
  42800.                     with: 0
  42801.                     with: 0
  42802.                     with: 0
  42803.                     with: 0).
  42804.             self changed: #transaction]! !
  42805.  
  42806. !TTMList methodsFor: 'dirty patch for quintus'!
  42807. containLtOrGt: s 
  42808.     s do: [:x | #($< $> ) do: [:y | x = y ifTrue: [^true]]].
  42809.     ^false! !
  42810.  
  42811. !TTMList methodsFor: 'dirty patch for quintus'!
  42812. isArithmetic: s 
  42813.     |  opStrings opChars |
  42814.     opStrings := #('mod' 'div' ).
  42815.     opChars := #($+ $-  $* ).
  42816.     opStrings do: [:x | (s findString: x startingAt: 1)
  42817.             ~= 0 ifTrue: [^true]].
  42818.     s do: [:x | opChars do: [:y | x = y ifTrue: [^true]]].
  42819.     ^false! !
  42820.  
  42821. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  42822.  
  42823. TTMList class
  42824.     instanceVariableNames: 'currentDirectory '!
  42825.  
  42826. !TTMList class methodsFor: 'type conversions'!
  42827. aValidNumber: aString 
  42828.     "Return true if aString is a valid number or the string 'infinity'."
  42829.  
  42830.     | valid count |
  42831.     aString size = 0
  42832.         ifTrue: [valid := false]
  42833.         ifFalse: 
  42834.             [valid := true.
  42835.             aString = 'infinity' | (aString = '-infinity')
  42836.                 ifFalse: 
  42837.                     [count := 1.
  42838.                     aString size
  42839.                         timesRepeat: 
  42840.                             [(aString at: count) isDigit | (count = 1 & ((aString at: count)
  42841.                                         = $-)) ifFalse: [valid := false].
  42842.                             count := count + 1]]].
  42843.     ^valid! !
  42844.  
  42845. !TTMList class methodsFor: 'type conversions'!
  42846. convertToNumber: aUsersString 
  42847.     "Return a number which is the integer equivalent of the string of digit 
  42848.     
  42849.     characters making up aString."
  42850.  
  42851.     | total current digit number aString neg |
  42852.     (aUsersString at: 1)
  42853.         = $-
  42854.         ifTrue: 
  42855.             [aString := aUsersString copyFrom: 2 to: aUsersString size.
  42856.             neg := true]
  42857.         ifFalse: 
  42858.             [aString := aUsersString.
  42859.             neg := false].
  42860.     total := 0.
  42861.     current := aString size.
  42862.     [current > 0]
  42863.         whileTrue: 
  42864.             [digit := aString at: current.
  42865.             number := 0.
  42866.             digit = $1 ifTrue: [number := 1].
  42867.             digit = $2 ifTrue: [number := 2].
  42868.             digit = $3 ifTrue: [number := 3].
  42869.             digit = $4 ifTrue: [number := 4].
  42870.             digit = $5 ifTrue: [number := 5].
  42871.             digit = $6 ifTrue: [number := 6].
  42872.             digit = $7 ifTrue: [number := 7].
  42873.             digit = $8 ifTrue: [number := 8].
  42874.             digit = $9 ifTrue: [number := 9].
  42875.             total := total + (number * (10 raisedToInteger: aString size - current)).
  42876.             current := current - 1].
  42877.     neg = true ifTrue: [total := total * -1].
  42878.     ^total! !
  42879.  
  42880. !TTMList class methodsFor: 'type conversions'!
  42881. convertToString: aUsersNumber 
  42882.     "Return a string which is the equivalent character string for the integer 
  42883.     
  42884.     aNumber. This is used for displaying when we dont want to use 
  42885.     printstring."
  42886.  
  42887.     | total digit number power totaldigits currentNumber aNumber |
  42888.     total := ''.
  42889.     aNumber := aUsersNumber.
  42890.     aNumber < 0
  42891.         ifTrue: 
  42892.             [total := '-'.
  42893.             aNumber := aNumber * -1].
  42894.     power := 10.
  42895.     totaldigits := 0.
  42896.     aNumber / power < 1 ifFalse: [[aNumber / power < 1]
  42897.             whileFalse: 
  42898.                 [totaldigits := totaldigits + 1.
  42899.                 power := power * 10]].
  42900.     currentNumber := aNumber.
  42901.     [totaldigits >= 0]
  42902.         whileTrue: 
  42903.             [digit := (currentNumber / (10 raisedToInteger: totaldigits)) floor.
  42904.             currentNumber := currentNumber - (digit * (10 raisedToInteger: totaldigits)).
  42905.             number := '0'.
  42906.             digit = 1 ifTrue: [number := '1'].
  42907.             digit = 2 ifTrue: [number := '2'].
  42908.             digit = 3 ifTrue: [number := '3'].
  42909.             digit = 4 ifTrue: [number := '4'].
  42910.             digit = 5 ifTrue: [number := '5'].
  42911.             digit = 6 ifTrue: [number := '6'].
  42912.             digit = 7 ifTrue: [number := '7'].
  42913.             digit = 8 ifTrue: [number := '8'].
  42914.             digit = 9 ifTrue: [number := '9'].
  42915.             total := total , number.
  42916.             totaldigits := totaldigits - 1].
  42917.     ^total! !
  42918.  
  42919. !TTMList class methodsFor: 'type conversions'!
  42920. pointToString: aPoint 
  42921.     ^aPoint x printString , ' ' , aPoint y printString! !
  42922.  
  42923. !TTMList class methodsFor: 'type conversions'!
  42924. stringToPoint: xcoord at: ycoord 
  42925.     | x y |
  42926.     x := TTMList convertToNumber: xcoord.
  42927.     y := TTMList convertToNumber: ycoord.
  42928.     ^Point x: x y: y! !
  42929.  
  42930. !TTMList class methodsFor: 'instance creation'!
  42931. new
  42932.     "Create a TTMList and initialize it."
  42933.  
  42934.     ^super new initialize! !
  42935.  
  42936. !TTMList class methodsFor: 'instance creation'!
  42937. open
  42938.     "Create a new TTMList and open a view on it."
  42939.     "TTMList open"
  42940.  
  42941.     self open: self new.
  42942.     self currentDirectory: Filename currentDirectory asString! !
  42943.  
  42944. !TTMList class methodsFor: 'instance creation'!
  42945. open: aTTMListModel 
  42946.     "Assemble the components of the view and open it on 
  42947.     aTTMListModel."
  42948.  
  42949.     | window container iButton eButton dataView activityView rButton gButton oButton sButton tButton hButton ttmListView myWrapper backColor partColor left top hsize vsize hspace vspace originalTop cButton notePadView sfHeadView sfView gsButton qiButton qButton |
  42950.     aTTMListModel currentDirectory: Filename currentDirectory.
  42951.     backColor := ColorValue veryLightGray.
  42952.     partColor := ColorValue white.
  42953.     window := ScheduledWindow new.
  42954.     window insideColor: partColor.
  42955.     window label: 'Build V.0.985'.
  42956.     window minimumSize: 550 @ 500.
  42957.     window model: TTMListWindow new.
  42958.     container := CompositePart new.
  42959.     originalTop := 0.83.
  42960.     left := 0.06.
  42961.     top := originalTop.
  42962.     hsize := 0.195.
  42963.     vsize := 0.04.
  42964.     hspace := 0.22.
  42965.     vspace := 0.05.
  42966.     (container add: ' ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  42967.         insideColor: backColor.    "Button for adding a ttm to the list"
  42968.     iButton := PushButton named: 'Add TTM'.
  42969.     iButton model: ((PluggableAdaptor on: aTTMListModel)
  42970.             getBlock: [:model | false]
  42971.             putBlock: [:model :value | model doAdd]
  42972.             updateBlock: [:model :value :parameter | false]).
  42973.     (container add: iButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  42974.         insideColor: ColorValue white.
  42975.     top := top + vspace.    "Button for removing a ttm from the list"
  42976.     eButton := PushButton named: 'Remove TTM'.
  42977.     eButton model: ((PluggableAdaptor on: aTTMListModel)
  42978.             getBlock: [:model | false]
  42979.             putBlock: [:model :value | model doRemove]
  42980.             updateBlock: [:model :value :parameter | false]).
  42981.     (container add: eButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  42982.         insideColor: ColorValue white.
  42983.     top := top + vspace.    "Button for renaming the current ttm"
  42984.     rButton := PushButton named: 'Rename TTM'.
  42985.     rButton model: ((PluggableAdaptor on: aTTMListModel)
  42986.             getBlock: [:model | false]
  42987.             putBlock: [:model :value | model doRename]
  42988.             updateBlock: [:model :value :parameter | false]).
  42989.     (container add: rButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  42990.         insideColor: ColorValue white.
  42991.     top := originalTop.
  42992.     left := left + hspace.    "Button for copying the selected ttm."
  42993.     cButton := PushButton named: 'Copy TTM'.
  42994.     cButton model: ((PluggableAdaptor on: aTTMListModel)
  42995.             getBlock: [:model | false]
  42996.             putBlock: [:model :value | model doCopy]
  42997.             updateBlock: [:model :value :parameter | false]).
  42998.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  42999.         insideColor: ColorValue white.
  43000.     top := top + vspace.    "Button for opening the selected ttm."
  43001.     oButton := PushButton named: 'Edit TTM'.
  43002.     oButton model: ((PluggableAdaptor on: aTTMListModel)
  43003.             getBlock: [:model | false]
  43004.             putBlock: [:model :value | model doEdit]
  43005.             updateBlock: [:model :value :parameter | false]).
  43006.     (container add: oButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43007.         insideColor: ColorValue white.
  43008.     top := top + vspace.    "Button for specifying ICs selected ttm"
  43009.     qiButton := PushButton named: 'Specify IC'.
  43010.     qiButton model: ((PluggableAdaptor on: aTTMListModel)
  43011.             getBlock: [:model | false]
  43012.             putBlock: [:model :value | model doConditions]
  43013.             updateBlock: [:model :value :parameter | false]).
  43014.     (container add: qiButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43015.         insideColor: ColorValue white.
  43016.     top := originalTop.
  43017.     left := left + hspace.    "Button for getting querying the TTM"
  43018.     tButton := PushButton named: 'Query TTM'.
  43019.     tButton model: ((PluggableAdaptor on: aTTMListModel)
  43020.             getBlock: [:model | false]
  43021.             putBlock: [:model :value | model doQuery]
  43022.             updateBlock: [:model :value :parameter | false]).
  43023.     (container add: tButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43024.         insideColor: ColorValue white.
  43025.     top := top + vspace.    "Button for simulation of selected ttm"
  43026.     sButton := PushButton named: 'Simulate TTM'.
  43027.     sButton model: ((PluggableAdaptor on: aTTMListModel)
  43028.             getBlock: [:model | false]
  43029.             putBlock: [:model :value | model doSimulate]
  43030.             updateBlock: [:model :value :parameter | false]).
  43031.     (container add: sButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43032.         insideColor: ColorValue white.
  43033.     top := top + vspace.    "Button for generating code for the selected ttm"
  43034.     gButton := PushButton named: 'Generate Code'.
  43035.     gButton model: ((PluggableAdaptor on: aTTMListModel)
  43036.             getBlock: [:model | false]
  43037.             putBlock: [:model :value | model doGenerate]
  43038.             updateBlock: [:model :value :parameter | false]).
  43039.     (container add: gButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43040.         insideColor: ColorValue white.
  43041.     top := originalTop.
  43042.     left := left + hspace.    "Button for filing access"
  43043.     gsButton := PushButton named: 'File Access'.
  43044.     gsButton model: ((PluggableAdaptor on: aTTMListModel)
  43045.             getBlock: [:model | false]
  43046.             putBlock: [:model :value | model doFileAccess]
  43047.             updateBlock: [:model :value :parameter | false]).
  43048.     (container add: gsButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43049.         insideColor: ColorValue white.
  43050.     top := top + vspace.    "Button for getting help"
  43051.     hButton := PushButton named: 'Help' asText allBold.
  43052.     hButton model: ((PluggableAdaptor on: aTTMListModel)
  43053.             getBlock: [:model | false]
  43054.             putBlock: [:model :value | HelpScreens openHelp: 'introduction']
  43055.             updateBlock: [:model :value :parameter | false]).
  43056.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43057.         insideColor: ColorValue white.
  43058.     top := top + vspace.    "Button for quitting"
  43059.     qButton := PushButton named: 'Exit Program'.
  43060.     qButton model: ((PluggableAdaptor on: aTTMListModel)
  43061.             getBlock: [:model | false]
  43062.             putBlock: [:model :value | TTMList closeWindowAndConfirm]
  43063.             updateBlock: [:model :value :parameter | false]).
  43064.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43065.         insideColor: ColorValue white.    "TTM listing view"
  43066.     ttmListView := SelectionInListView
  43067.                 on: aTTMListModel
  43068.                 printItems: false
  43069.                 oneItem: false
  43070.                 aspect: #transaction
  43071.                 change: #selection:
  43072.                 list: #ttmList
  43073.                 menu: #ttmListMenu
  43074.                 initialSelection: nil
  43075.                 useIndex: true.
  43076.     myWrapper := self wrap: (LookPreferences edgeDecorator on: ttmListView).
  43077.     (container add: myWrapper borderedIn: (0.02 @ 0.06 extent: 0.5 @ 0.35))
  43078.         insideColor: partColor.
  43079.     self labelWrap: (container add: ' List Of Existing TTMs:' asText allBold asComposedText borderedIn: (0.02 @ 0.02 extent: 0.5 @ 0.04)).    "Note Pad View"
  43080.     notePadView := TextView
  43081.                 on: aTTMListModel
  43082.                 aspect: #noteList
  43083.                 change: #noteAccept:
  43084.                 menu: #noteMenu
  43085.                 initialSelection: nil.
  43086.     myWrapper := self wrap: (LookPreferences edgeDecorator on: notePadView).
  43087.     (container add: myWrapper borderedIn: (0.02 @ 0.46 extent: 0.5 @ 0.15))
  43088.         insideColor: partColor.
  43089.     self labelWrap: (container add: ' Note Pad:' asText allBold asComposedText borderedIn: (0.02 @ 0.42 extent: 0.5 @ 0.04)).    "Activity Variable view"
  43090.     activityView := SelectionInListView
  43091.                 on: aTTMListModel
  43092.                 printItems: false
  43093.                 oneItem: false
  43094.                 aspect: #avTransaction
  43095.                 change: #avSelection:
  43096.                 list: #avList
  43097.                 menu: #avMenu
  43098.                 initialSelection: nil
  43099.                 useIndex: true.
  43100.     myWrapper := self wrap: (LookPreferences edgeDecorator on: activityView).
  43101.     (container add: myWrapper borderedIn: (0.54 @ 0.06 extent: 0.44 @ 0.24))
  43102.         insideColor: partColor.
  43103.     self labelWrap: (container add: ' Activity Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.02 extent: 0.44 @ 0.04)).    "Data Variable view"
  43104.     dataView := SelectionInListView
  43105.                 on: aTTMListModel
  43106.                 printItems: false
  43107.                 oneItem: false
  43108.                 aspect: #dvTransaction
  43109.                 change: #dvSelection:
  43110.                 list: #dvList
  43111.                 menu: #dvMenu
  43112.                 initialSelection: nil
  43113.                 useIndex: true.
  43114.     myWrapper := self wrap: (LookPreferences edgeDecorator on: dataView).
  43115.     (container add: myWrapper borderedIn: (0.54 @ 0.36 extent: 0.44 @ 0.24))
  43116.         insideColor: partColor.
  43117.     self labelWrap: (container add: ' Data Variables:' asText allBold asComposedText borderedIn: (0.54 @ 0.32 extent: 0.44 @ 0.04)).    "channelView := SelectionInListView 
  43118.     on: aTTMListModel 
  43119.     printItems: false 
  43120.     oneItem: false 
  43121.     aspect: #chTransaction 
  43122.     change: #chSelection: 
  43123.     list: #chList 
  43124.     menu: #chMenu 
  43125.     initialSelection: nil 
  43126.     useIndex: true. 
  43127.     myWrapper := self wrap: (LookPreferences edgeDecorator on: 
  43128.     channelView). 
  43129.     (container add: myWrapper borderedIn: (0.54 @ 0.46 extent: 0.44 @ 
  43130.     0.15)) 
  43131.     insideColor: partColor. 
  43132.     self labelWrap: (container add: ' Communication Channels:' asText 
  43133.     allBold asComposedText borderedIn: (0.54 @ 0.42 extent: 0.44 @ 
  43134.     0.04))."
  43135.     sfHeadView := SelectionInListView
  43136.                 on: aTTMListModel
  43137.                 printItems: false
  43138.                 oneItem: false
  43139.                 aspect: #sfTransaction
  43140.                 change: #sfSelection:
  43141.                 list: #sfList
  43142.                 menu: #sfMenu
  43143.                 initialSelection: nil
  43144.                 useIndex: true.
  43145.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfHeadView).
  43146.     (container add: myWrapper borderedIn: (0.02 @ 0.66 extent: 0.28 @ 0.15))
  43147.         insideColor: partColor.
  43148.     self labelWrap: (container add: ' SFs:' asText allBold asComposedText borderedIn: (0.02 @ 0.62 extent: 0.28 @ 0.04)).
  43149.     sfView := TextView
  43150.                 on: aTTMListModel
  43151.                 aspect: #curSFList
  43152.                 change: #curSFAccept:
  43153.                 menu: #curSFMenu
  43154.                 initialSelection: nil.
  43155.     myWrapper := self wrap: (LookPreferences edgeDecorator on: sfView).
  43156.     (container add: myWrapper borderedIn: (0.32 @ 0.66 extent: 0.66 @ 0.15))
  43157.         insideColor: partColor.
  43158.     self labelWrap: (container add: ' Current SF:' asText allBold asComposedText borderedIn: (0.32 @ 0.62 extent: 0.66 @ 0.04)).
  43159.     window component: container.
  43160.     window open! !
  43161.  
  43162. !TTMList class methodsFor: 'decoration'!
  43163. labelWrap: aLabel 
  43164.     | newLabel |
  43165.     newLabel := aLabel.
  43166.     newLabel insideColor: ColorValue white.
  43167.     newLabel borderColor: ColorValue black.
  43168.     newLabel borderWidth: 1.
  43169.     ^newLabel! !
  43170.  
  43171. !TTMList class methodsFor: 'decoration'!
  43172. wrap: aWrapper 
  43173.     | newWrapper |
  43174.     newWrapper := aWrapper.
  43175.     newWrapper noMenuBar.
  43176.     ^newWrapper
  43177. "newWrapper borderColor: ColorValue black. 
  43178.     
  43179.     newWrapper borderWidth: 1."
  43180.     "newWrapper insideColor: ColorValue white."! !
  43181.  
  43182. !TTMList class methodsFor: 'dialog windows'!
  43183. buildBlanksCheckListFor: prompt with: choices 
  43184.     "How does this work, you may ask. Well it creates 
  43185.     
  43186.     a list of the initial values (they are assumed to be 
  43187.     
  43188.     strings) and the user can type over any of them 
  43189.     
  43190.     he/she wants to change. prompt is the header for 
  43191.     
  43192.     the dialogbox. choices is the set of initial values. 
  43193.     
  43194.     Returns an array of same size as choices with the 
  43195.     
  43196.     new values."
  43197.  
  43198.     | theModel theView count modelArray |
  43199.     choices size > 0
  43200.         ifTrue: 
  43201.             [modelArray := Array new: choices size.
  43202.             count := 1.
  43203.             [count > choices size]
  43204.                 whileFalse: 
  43205.                     [modelArray at: count put: ''.
  43206.                     count := count + 1].
  43207.             theModel := ValueHolder with: modelArray.
  43208.             theView := DialogView model: theModel.
  43209.             theView addVerticalSpace: 3; addTextLabel: prompt.
  43210.             count := 1.
  43211.             [count > choices size]
  43212.                 whileFalse: 
  43213.                     [theView addTextFieldOn: ((PluggableAdaptor on: theModel)
  43214.                             collectionIndex: count)
  43215.                         initially: (choices at: count).
  43216.                     count := count + 1].
  43217.             theView open.
  43218.             ^theModel value]
  43219.         ifFalse: [^nil]! !
  43220.  
  43221. !TTMList class methodsFor: 'dialog windows'!
  43222. closeWindow: windowNumber in: currentTTM 
  43223.     "Closes a specific TTM view and marks it as closed."
  43224.  
  43225.     currentTTM openWindows at: windowNumber put: 0.
  43226.     ScheduledControllers activeController close! !
  43227.  
  43228. !TTMList class methodsFor: 'dialog windows'!
  43229. closeWindowAndConfirm
  43230.     "Close the window, but first make sure it 
  43231.     
  43232.     is what the user wants to do."
  43233.  
  43234.     "(DialogView confirm: 'Are you certain you want to quit?')
  43235.         = true ifTrue: ["ScheduledControllers activeController close"]"! !
  43236.  
  43237. !TTMList class methodsFor: 'dialog windows'!
  43238. show: aString 
  43239.     Transcript nextPutAll: aString; cr; endEntry! !
  43240.  
  43241. !TTMList class methodsFor: 'dialog windows'!
  43242. speak: errormsg 
  43243.     "Reports the given error message."
  43244.  
  43245.     | window container left hsize top vsize qButton |
  43246.     errormsg isNil
  43247.         ifFalse: 
  43248.             [Transcript cr.
  43249.             Transcript show: errormsg.
  43250.             Transcript cr.
  43251.             window := ScheduledWindow new.
  43252.             window minimumSize: 300 @ 80.
  43253.             container := CompositePart new.
  43254.             window label: 'error encountered:'.
  43255.             (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  43256.                 insideColor: ColorValue gray.
  43257.             (container add: errormsg asComposedText borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.75))
  43258.                 insideColor: ColorValue white.
  43259.             left := 0.0.
  43260.             hsize := 0.195.
  43261.             top := 0.75.
  43262.             vsize := 0.25.
  43263.             qButton := PushButton named: 'Exit'.
  43264.             qButton model: ((PluggableAdaptor on: window)
  43265.                     getBlock: [:model | false]
  43266.                     putBlock: [:model :value | ScheduledControllers activeController close]
  43267.                     updateBlock: [:model :value :parameter | false]).
  43268.             (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  43269.                 insideColor: ColorValue white.
  43270.             window component: container.
  43271.             window open]! !
  43272.  
  43273. !TTMList class methodsFor: 'strings'!
  43274. aUsefulActLabel: aString 
  43275.     "Return true if aString has proper syntax for an activity."
  43276.  
  43277.     | count |
  43278.     count := 1.
  43279.     aString size < count ifTrue: [^false].
  43280.     [count > aString size]
  43281.         whileFalse: 
  43282.             [(aString at: count) isAlphaNumeric | ((aString at: count)
  43283.                     = $_) ifFalse: [^false].
  43284.             count := count + 1].
  43285.     ^true! !
  43286.  
  43287. !TTMList class methodsFor: 'strings'!
  43288. aUsefulTrLabel: aString 
  43289.     "Return true if aString has proper syntax for a transition."
  43290.  
  43291.     | valid count |
  43292.     valid := false.
  43293.     aString size = 0 ifFalse: [(aString at: 1) isLetter & (aString at: 1) isLowercase
  43294.             ifTrue: 
  43295.                 [valid := true.
  43296.                 count := 1.
  43297.                 aString size
  43298.                     timesRepeat: 
  43299.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  43300.                                 = $_) ifFalse: [valid := false].
  43301.                         count := count + 1]]].
  43302.     valid = false ifTrue: [TTMList speak: 'invalid text string'].
  43303.     ^valid! !
  43304.  
  43305. !TTMList class methodsFor: 'strings'!
  43306. aUsefulTTMName: aString 
  43307.     "Return true if aString has proper syntax for a variable name."
  43308.  
  43309.     | valid count |
  43310.     valid := false.
  43311.     aString size = 0 ifFalse: [(aString at: 1) isLetter
  43312.             ifTrue: 
  43313.                 [valid := true.
  43314.                 count := 1.
  43315.                 aString size
  43316.                     timesRepeat: 
  43317.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  43318.                                 = $_) ifFalse: [valid := false].
  43319.                         count := count + 1]]].
  43320.     ^valid! !
  43321.  
  43322. !TTMList class methodsFor: 'strings'!
  43323. collectTokensFrom: aString usingParser: aParser 
  43324.     | x t r |
  43325.     r := OrderedCollection new.
  43326.     x := aParser.
  43327.     x initScannerSource: aString.
  43328.     [(t := x nextTokenValue) ~= x endOfInputToken]
  43329.         whileTrue: 
  43330.             [r add: t.
  43331.             x scanner scanToken].
  43332.     ^r! !
  43333.  
  43334. !TTMList class methodsFor: 'strings'!
  43335. elementsFromLine: line 
  43336.     "divides given line at space characters"
  43337.  
  43338.     | parts count part |
  43339.     parts := OrderedCollection new.
  43340.     count := 1.
  43341.     part := ''.
  43342.     [count > line size]
  43343.         whileFalse: 
  43344.             [(line at: count)
  43345.                 = Character space
  43346.                 ifTrue: 
  43347.                     [parts add: part.
  43348.                     part := '']
  43349.                 ifFalse: [part := part , (String with: (line at: count))].
  43350.             count := count + 1].
  43351.     parts ~= '' ifTrue: [parts add: part].
  43352.     ^parts! !
  43353.  
  43354. !TTMList class methodsFor: 'strings'!
  43355. inString: aString replace: sub with: newSub 
  43356.     | result ind1 ind2 s1   |
  43357.     result := ''.
  43358.     s1 := aString size.
  43359.     s1 == 0 ifTrue: [^result].
  43360.     newSub size.
  43361.     ind1 := 1.
  43362.     [ind1 <= s1]
  43363.         whileTrue: 
  43364.             [ind2 := aString indexOfSubCollection: sub startingAt: ind1.
  43365.             ind2 > 0
  43366.                 ifTrue: 
  43367.                     [ind1 == ind2
  43368.                         ifTrue: [result := result , newSub]
  43369.                         ifFalse: [result := result , (aString copyFrom: ind1 to: ind2 - 1) , newSub].
  43370.                     ind1 := ind2 + sub size]
  43371.                 ifFalse: 
  43372.                     [result := result , (aString copyFrom: ind1 to: s1).
  43373.                     ind1 := s1 + 1]].
  43374.     ^result! !
  43375.  
  43376. !TTMList class methodsFor: 'strings'!
  43377. makeStringFromCollection: x 
  43378.     | result |
  43379.     result := ''.
  43380.     x do: [:y | result := result , y].
  43381.     ^result! !
  43382.  
  43383. !TTMList class methodsFor: 'strings'!
  43384. removeAllBlanksFrom: aString 
  43385.     "removes all the separator characters"
  43386.  
  43387.     | count newString c |
  43388.     count := 1.
  43389.     newString := ''.
  43390.     [count > aString size]
  43391.         whileFalse: 
  43392.             [c := aString at: count.
  43393.             c isSeparator ifFalse: [newString := newString , (String with: c)].
  43394.             count := count + 1].
  43395.     ^newString! !
  43396.  
  43397. !TTMList class methodsFor: 'strings'!
  43398. replace: aString instance: oldName to: newName 
  43399.     "replaces a substring within a string"
  43400.  
  43401.     | ic location startPosition continue |
  43402.     ic := aString copy.
  43403.     startPosition := 1.
  43404.     location := ic findString: oldName startingAt: startPosition.
  43405.     [location ~= 0]
  43406.         whileTrue: 
  43407.             [location = 1
  43408.                 ifTrue: [continue := true]
  43409.                 ifFalse: [continue := ((ic at: location - 1) isAlphaNumeric | ((ic at: location - 1)
  43410.                                     = $_)) not].
  43411.             continue ifTrue: [location = ic size ifFalse: [continue := ((ic at: location + oldName size) isAlphaNumeric | ((ic at: location + oldName size)
  43412.                                     = $_)) not]].
  43413.             continue
  43414.                 ifTrue: 
  43415.                     [ic := ic
  43416.                                 changeFrom: location
  43417.                                 to: location + oldName size - 1
  43418.                                 with: newName.
  43419.                     startPosition := location + newName size - 1]
  43420.                 ifFalse: [startPosition := location + oldName size].
  43421.             location := ic findString: oldName startingAt: startPosition].
  43422.     ^ic! !
  43423.  
  43424. !TTMList class methodsFor: 'strings'!
  43425. replaceString: old with: new in: collection 
  43426.     | t |
  43427.     t := OrderedCollection new.
  43428.     collection do: [:x | x = old
  43429.             ifTrue: [t add: new]
  43430.             ifFalse: [t add: x]].
  43431.     ^t! !
  43432.  
  43433. !TTMList class methodsFor: 'temporary - tgen'!
  43434. installTgen
  43435.     | sourceDir |
  43436.     sourceDir := '/tmp/T-gen/'.
  43437.     #('graphn.st' 'comppars.st' 'compscan.st' 'parstree.st' 'scanpars.st' 'changes.st' ) do: [:file | (sourceDir , file) asFilename fileIn]! !
  43438.  
  43439. !TTMList class methodsFor: 'temporary - tgen'!
  43440. installTgen1
  43441.     #('graphn.st' 'comppars.st' 'compscan.st' 'parstree.st' 'scanpars.st' 'changes.st' ) do: [:file | file asFilename fileIn]! !
  43442.  
  43443. !TTMList class methodsFor: 'currentDirectory'!
  43444. currentDirectory
  43445.     ^currentDirectory! !
  43446.  
  43447. !TTMList class methodsFor: 'currentDirectory'!
  43448. currentDirectory: aString 
  43449.     currentDirectory := aString! !
  43450.  
  43451. Object subclass: #DisplayObject
  43452.     instanceVariableNames: ''
  43453.     classVariableNames: ''
  43454.     poolDictionaries: ''
  43455.     category: 'Build'!
  43456. DisplayObject comment:
  43457. 'The abstract class DisplayObject provides the protocol for most
  43458.  
  43459. display primitives that are used by other objects, such as Views,
  43460.  
  43461. for presenting information on the screen.  Its subclasses are
  43462.  
  43463. DisplayMedium, DisplayText, InfiniteForm, OpaqueForm, and Path.
  43464.  
  43465.  
  43466.  
  43467. Subclasses must implement methods for 
  43468.  
  43469.      display box access
  43470.  
  43471.           computeBoundingBox
  43472.  
  43473.      displaying
  43474.  
  43475.           displayOn:at:clippingBox:rule:mask:
  43476.  
  43477.  
  43478.  
  43479. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  43480.  
  43481. '!
  43482.  
  43483. DisplayObject comment:
  43484. 'The abstract class DisplayObject provides the protocol for most
  43485.  
  43486. display primitives that are used by other objects, such as Views,
  43487.  
  43488. for presenting information on the screen.  Its subclasses are
  43489.  
  43490. DisplayMedium, DisplayText, InfiniteForm, OpaqueForm, and Path.
  43491.  
  43492.  
  43493.  
  43494. Subclasses must implement methods for 
  43495.  
  43496.      display box access
  43497.  
  43498.           computeBoundingBox
  43499.  
  43500.      displaying
  43501.  
  43502.           displayOn:at:clippingBox:rule:mask:
  43503.  
  43504.  
  43505.  
  43506. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  43507.  
  43508. '!
  43509.  
  43510. !DisplayObject methodsFor: 'accessing'!
  43511. extent
  43512.     "Answer the point that represents the width and height of
  43513.  
  43514. the
  43515.  
  43516.  
  43517.     receiver's bounding box."
  43518.  
  43519.     ^self boundingBox extent! !
  43520.  
  43521. !DisplayObject methodsFor: 'accessing'!
  43522. height
  43523.     "Answer the number that represents the height of the
  43524.  
  43525. receiver's 
  43526.     bounding box."
  43527.  
  43528.     ^self boundingBox height! !
  43529.  
  43530. !DisplayObject methodsFor: 'accessing'!
  43531. offset
  43532.  
  43533.      "Answer the amount by which the receiver should be offset
  43534.  
  43535. when
  43536.  
  43537.      it is displayed or its position is tested."
  43538.  
  43539.  
  43540.  
  43541.      self subclassResponsibility! !
  43542.  
  43543. !DisplayObject methodsFor: 'accessing'!
  43544. offset: aPoint 
  43545.  
  43546.      "Set the amount by which the receiver's position is offset."
  43547.  
  43548.  
  43549.  
  43550.      ^self! !
  43551.  
  43552. !DisplayObject methodsFor: 'accessing'!
  43553. relativeRectangle
  43554.     "Answer a Rectangle whose top left corner is the receiver's
  43555.  
  43556. offset 
  43557.     position
  43558.  
  43559.  and whose width and height are the same as the receiver."
  43560.  
  43561.     ^Rectangle origin: self offset extent: self extent! !
  43562.  
  43563. !DisplayObject methodsFor: 'accessing'!
  43564. width
  43565.     "Answer the number that represents the width of the
  43566.  
  43567. receiver's 
  43568.     bounding box."
  43569.  
  43570.     ^self boundingBox width! !
  43571.  
  43572. !DisplayObject methodsFor: 'truncation and round off'!
  43573. rounded
  43574.  
  43575.      "Convert the offset of the receiver to integer coordinates."
  43576.  
  43577.  
  43578.  
  43579.      self offset: self offset rounded! !
  43580.  
  43581. !DisplayObject methodsFor: 'displaying'!
  43582. display
  43583.  
  43584.      "Show the receiver on the display screen.  Defaults to
  43585.  
  43586. showing the receiver
  43587.  
  43588.      in the upper left corner of the screen."
  43589.  
  43590.  
  43591.  
  43592.      self displayOn: Display! !
  43593.  
  43594. !DisplayObject methodsFor: 'displaying'!
  43595. displayAt: aDisplayPoint 
  43596.  
  43597.      "Display the receiver located at aDisplayPoint with default
  43598.  
  43599. settings for the
  43600.  
  43601.      displayMedium, rule and halftone."
  43602.  
  43603.  
  43604.  
  43605.      self displayOn: Display
  43606.  
  43607.           at: aDisplayPoint
  43608.  
  43609.           clippingBox: Display boundingBox
  43610.  
  43611.           rule: Form over
  43612.  
  43613.           mask: Form black! !
  43614.  
  43615. !DisplayObject methodsFor: 'displaying'!
  43616. displayOn: aDisplayMedium 
  43617.  
  43618.     "Simple default display in order to see the receiver in the upper left corner of 
  43619.  
  43620.     screen."
  43621.  
  43622.  
  43623.  
  43624.     self displayOn: aDisplayMedium at: 0 @ 0! !
  43625.  
  43626. !DisplayObject methodsFor: 'displaying'!
  43627. displayOn: aDisplayMedium at: aDisplayPoint 
  43628.  
  43629.     "Display the receiver located at aDisplayPoint with default 
  43630.  
  43631.     settings for rule and halftone."
  43632.  
  43633.  
  43634.  
  43635.     self
  43636.  
  43637.         displayOn: aDisplayMedium
  43638.  
  43639.         at: aDisplayPoint
  43640.  
  43641.         clippingBox: aDisplayMedium boundingBox
  43642.  
  43643.         rule: Form over
  43644.  
  43645.         mask: Form black! !
  43646.  
  43647. !DisplayObject methodsFor: 'displaying'!
  43648. displayOn: aDisplayMedium at: aDisplayPoint clippingBox:
  43649.  
  43650. clipRectangle rule: ruleInteger mask: aForm
  43651.  
  43652.      "This is the basic display primitive for graphic display
  43653.  
  43654. objects.  Display 
  43655.  
  43656.      the receiver located at aDisplayPoint with rule, rule
  43657.  
  43658. ruleInteger, and mask, 
  43659.  
  43660.      aForm.  Information to be displayed must be confined to the
  43661.  
  43662. area that 
  43663.  
  43664.      intersects with clipRectangle."
  43665.  
  43666.  
  43667.  
  43668.      self subclassResponsibility! !
  43669.  
  43670. !DisplayObject methodsFor: 'transforming'!
  43671. align: alignmentPoint with: relativePoint 
  43672.  
  43673.      "Translate the receiver's offset such that alignmentPoint
  43674.  
  43675. aligns with relativePoint."
  43676.  
  43677.  
  43678.  
  43679.      self offset: (self offset translateBy: relativePoint -
  43680.  
  43681. alignmentPoint)! !
  43682.  
  43683. !DisplayObject methodsFor: 'transforming'!
  43684. scaleBy: aPoint 
  43685.  
  43686.      "Scale the receiver's offset by the amount of the argument,
  43687.  
  43688. aPoint."
  43689.  
  43690.  
  43691.  
  43692.      self offset: (self offset scaleBy: aPoint)! !
  43693.  
  43694. !DisplayObject methodsFor: 'transforming'!
  43695. translateBy: aPoint 
  43696.  
  43697.      "Translate the receiver's offset by the amount of the
  43698.  
  43699. argument, aPoint."
  43700.  
  43701.  
  43702.  
  43703.      self offset: (self offset translateBy: aPoint)! !
  43704.  
  43705. DisplayObject subclass: #Path
  43706.     instanceVariableNames: 'form collectionOfPoints '
  43707.     classVariableNames: ''
  43708.     poolDictionaries: ''
  43709.     category: 'Build'!
  43710. Path comment:
  43711. 'Class Path is the basic superclass of the graphic spatial
  43712.  
  43713. primitives.  Spatial primitives are used to generate
  43714.  
  43715. "trajactories" or paths like lines and circles.
  43716.  
  43717.      
  43718.  
  43719. Instance Variables:
  43720.  
  43721.      form      <Form> the "brush" used for displaying the path
  43722.  
  43723.      collectionOfPoints  <OrderedCollection> of Points along the
  43724.  
  43725. path
  43726.  
  43727.  
  43728.  
  43729. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  43730.  
  43731. '!
  43732.  
  43733. Path comment:
  43734. 'Class Path is the basic superclass of the graphic spatial
  43735.  
  43736. primitives.  Spatial primitives are used to generate
  43737.  
  43738. "trajactories" or paths like lines and circles.
  43739.  
  43740.      
  43741.  
  43742. Instance Variables:
  43743.  
  43744.      form      <Form> the "brush" used for displaying the path
  43745.  
  43746.      collectionOfPoints  <OrderedCollection> of Points along the
  43747.  
  43748. path
  43749.  
  43750.  
  43751.  
  43752. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  43753.  
  43754. '!
  43755.  
  43756. !Path methodsFor: 'adding'!
  43757. add: aPoint 
  43758.     "Include aPoint as one of the receiver's elements."
  43759.  
  43760.     collectionOfPoints add: aPoint! !
  43761.  
  43762. !Path methodsFor: 'removing'!
  43763. removeAllSuchThat: aBlock 
  43764.  
  43765.      "Evaluate aBlock with each of the collectionOfPoints's as
  43766.  
  43767. the argument.
  43768.  
  43769.       Remove each point for which aBlock evaluates to true.
  43770.  
  43771.       Answer the new instance of receiver's class."
  43772.  
  43773.  
  43774.  
  43775.      | newCollection newPath |
  43776.  
  43777.      newPath:= self species new.
  43778.  
  43779.      newCollection:= collectionOfPoints removeAllSuchThat:
  43780.  
  43781. aBlock.
  43782.  
  43783.      newCollection do: [:point | newPath add: point].
  43784.  
  43785.      newPath form: self form.
  43786.  
  43787.      ^newPath! !
  43788.  
  43789. !Path methodsFor: 'enumerating'!
  43790. collect: aBlock 
  43791.  
  43792.      "Evaluate aBlock with each of the collectionOfPoints's as
  43793.  
  43794. the argument. 
  43795.  
  43796.      Collect the resulting values into a new collectionOfPoints. 
  43797.  
  43798. Answer the 
  43799.  
  43800.      new instance of receivers' class."
  43801.  
  43802.  
  43803.  
  43804.      | newCollection newPath |
  43805.  
  43806.      newPath:= self species new.
  43807.  
  43808.      newCollection:= collectionOfPoints collect: aBlock.
  43809.  
  43810.      newCollection do: [:point | newPath add: point].
  43811.  
  43812.      newPath form: self form.
  43813.  
  43814.      ^newPath! !
  43815.  
  43816. !Path methodsFor: 'enumerating'!
  43817. select: aBlock 
  43818.  
  43819.      "Evaluate aBlock with each of the collectionOfPoints's as
  43820.  
  43821. the argument. 
  43822.  
  43823.      Collect into a new collectionOfPoints, only those elements
  43824.  
  43825. for which aBlock 
  43826.  
  43827.      evaluates to true.  Answer the new instance of receivers'
  43828.  
  43829. class."
  43830.  
  43831.  
  43832.  
  43833.      | newCollection newPath |
  43834.  
  43835.      newPath:= self species new.
  43836.  
  43837.      newCollection:= collectionOfPoints select: aBlock.
  43838.  
  43839.      newCollection do: [:point | newPath add: point].
  43840.  
  43841.      newPath form: self form.
  43842.  
  43843.      ^newPath! !
  43844.  
  43845. !Path methodsFor: 'testing'!
  43846. isEmpty
  43847.     "Answer whether the receiver contains any elements."
  43848.  
  43849.     ^collectionOfPoints isEmpty! !
  43850.  
  43851. !Path methodsFor: 'accessing'!
  43852. at: index 
  43853.  
  43854.      "Answer the point on the receiver's path at position index."
  43855.  
  43856.  
  43857.  
  43858.      ^collectionOfPoints at: index! !
  43859.  
  43860. !Path methodsFor: 'accessing'!
  43861. at: index put: aPoint 
  43862.  
  43863.      "Store the argument, aPoint, as the point on the receiver's
  43864.  
  43865. path at 
  43866.  
  43867.      position index."
  43868.  
  43869.  
  43870.  
  43871.      ^collectionOfPoints at: index put: aPoint! !
  43872.  
  43873. !Path methodsFor: 'accessing'!
  43874. first
  43875.  
  43876.      "Answer the first point on the receiver's path."
  43877.  
  43878.  
  43879.  
  43880.      ^collectionOfPoints first! !
  43881.  
  43882. !Path methodsFor: 'accessing'!
  43883. firstPoint
  43884.  
  43885.      "Answer the first point on the receiver's path."
  43886.  
  43887.  
  43888.  
  43889.      ^collectionOfPoints first! !
  43890.  
  43891. !Path methodsFor: 'accessing'!
  43892. firstPoint: aPoint 
  43893.  
  43894.      "Answer the argument aPoint.  Replace the first element of
  43895.  
  43896. the receiver
  43897.  
  43898.      with the new value aPoint."
  43899.  
  43900.  
  43901.  
  43902.      collectionOfPoints at: 1 put: aPoint.
  43903.  
  43904.      ^aPoint! !
  43905.  
  43906. !Path methodsFor: 'accessing'!
  43907. form
  43908.  
  43909.      "Answer the receiver's form. If form is nil then a 1 x 1
  43910.  
  43911. black form (a 
  43912.  
  43913.      black dot) is answered."
  43914.  
  43915.  
  43916.  
  43917.      | aForm |
  43918.  
  43919.      form == nil
  43920.  
  43921.           ifTrue: 
  43922.  
  43923.                [aForm:= Form new extent: 1 @ 1.
  43924.  
  43925.                aForm black.
  43926.  
  43927.                ^aForm]
  43928.  
  43929.           ifFalse: 
  43930.  
  43931.                [^form]! !
  43932.  
  43933. !Path methodsFor: 'accessing'!
  43934. last
  43935.  
  43936.      "Answer the last point on the receiver's path."
  43937.  
  43938.  
  43939.  
  43940.      ^collectionOfPoints last! !
  43941.  
  43942. !Path methodsFor: 'accessing'!
  43943. offset
  43944.  
  43945.      "There are basically two kinds of display objects in the
  43946.  
  43947. system:  those that, when 
  43948.  
  43949.      asked to transform themselves, create a new object;  and
  43950.  
  43951. those that side effect 
  43952.  
  43953.      themselves by maintaining a record of the transformation
  43954.  
  43955. request (typically 
  43956.  
  43957.      an offset).  Path, like Rectangle and Point, is a display
  43958.  
  43959. object of the first kind."
  43960.  
  43961.  
  43962.  
  43963.      self shouldNotImplement! !
  43964.  
  43965. !Path methodsFor: 'accessing'!
  43966. secondPoint
  43967.  
  43968.      "Answer the second element of the receiver."
  43969.  
  43970.  
  43971.  
  43972.      ^collectionOfPoints at: 2! !
  43973.  
  43974. !Path methodsFor: 'accessing'!
  43975. secondPoint: aPoint 
  43976.  
  43977.      "Answer the argument aPoint.  Replace the second element of
  43978.  
  43979. the receiver
  43980.  
  43981.      with the new value aPoint."
  43982.  
  43983.  
  43984.  
  43985.      collectionOfPoints at: 2 put: aPoint.
  43986.  
  43987.      ^aPoint! !
  43988.  
  43989. !Path methodsFor: 'accessing'!
  43990. size
  43991.  
  43992.      "Answer how many elements the receiver contains."
  43993.  
  43994.  
  43995.  
  43996.      ^collectionOfPoints size! !
  43997.  
  43998. !Path methodsFor: 'accessing'!
  43999. thirdPoint
  44000.  
  44001.      "Answer the third element of the receiver."
  44002.  
  44003.  
  44004.  
  44005.      ^collectionOfPoints at: 3! !
  44006.  
  44007. !Path methodsFor: 'accessing'!
  44008. thirdPoint: aPoint 
  44009.  
  44010.      "Answer the argument aPoint.  Replace the third element of
  44011.  
  44012. the receiver
  44013.  
  44014.      with the new value aPoint."
  44015.  
  44016.  
  44017.  
  44018.      collectionOfPoints at: 3 put: aPoint.
  44019.  
  44020.      ^aPoint! !
  44021.  
  44022. !Path methodsFor: 'As yet unclassified'!
  44023. form: aForm 
  44024.     "Make the argument, aForm, the receiver's form."
  44025.  
  44026.     form := aForm! !
  44027.  
  44028. !Path methodsFor: 'As yet unclassified'!
  44029. initializeCollectionOfPoints: anInteger 
  44030.     "Initialize the collection of points on the path to have 
  44031.     
  44032.     potential anInteger elements."
  44033.  
  44034.     collectionOfPoints := OrderedCollection new: anInteger! !
  44035.  
  44036. !Path methodsFor: 'displaying'!
  44037. displayOn: aDisplayMedium at: aDisplayPoint clippingBox:
  44038.  
  44039. clipRectangle rule: ruleInteger mask: aForm 
  44040.  
  44041.      "Display this Path--offset by aDisplayPoint, clipped by
  44042.  
  44043. clipRectangle and the form 
  44044.  
  44045.      associated with this Path will be displayed according to one
  44046.  
  44047. of the sixteen 
  44048.  
  44049.      functions of two logical variables (ruleInteger).  Also the
  44050.  
  44051. source form will be first 
  44052.  
  44053.      ANDed with aForm as a mask.  Does not effect the state of
  44054.  
  44055. the Path."
  44056.  
  44057.  
  44058.  
  44059.      collectionOfPoints do: 
  44060.  
  44061.           [:element | 
  44062.  
  44063.           self form
  44064.  
  44065.                displayOn: aDisplayMedium
  44066.  
  44067.                at: element + aDisplayPoint
  44068.  
  44069.                clippingBox: clipRectangle
  44070.  
  44071.                rule: ruleInteger
  44072.  
  44073.                mask: aForm]! !
  44074.  
  44075. !Path methodsFor: 'displaying'!
  44076. displayOn: aDisplayMedium transformation: displayTransformation
  44077.  
  44078. clippingBox:
  44079.  
  44080. clipRectangle rule: ruleInteger mask: aForm 
  44081.  
  44082.      "Displays this path, translated and scaled by
  44083.  
  44084. aTransformation."
  44085.  
  44086.      "get the scaled and translated Path."
  44087.  
  44088.  
  44089.  
  44090.      | transformedPath |
  44091.  
  44092.      transformedPath:= displayTransformation applyTo: self.
  44093.  
  44094.      transformedPath
  44095.  
  44096.           displayOn: aDisplayMedium
  44097.  
  44098.           at: 0 @ 0
  44099.  
  44100.           clippingBox: clipRectangle
  44101.  
  44102.           rule: ruleInteger
  44103.  
  44104.           mask: aForm! !
  44105.  
  44106. !Path methodsFor: 'display box access'!
  44107. computeBoundingBox
  44108.  
  44109.  
  44110.  
  44111.      | box computedOrigin computedExtent |
  44112.  
  44113.      form == nil
  44114.  
  44115.           ifTrue: [computedOrigin:= 0@0.
  44116.  
  44117.                     computedExtent:= 0@0]
  44118.  
  44119.           ifFalse: [computedOrigin:= form offset.
  44120.  
  44121.                     computedExtent:= form extent].
  44122.  
  44123.      box:= Rectangle origin: (self at: 1) + computedOrigin
  44124.  
  44125. extent: computedExtent.
  44126.  
  44127.      collectionOfPoints do:
  44128.  
  44129.           [:aPoint | box:= box merge: (Rectangle origin: aPoint +
  44130.  
  44131. computedOrigin extent: computedExtent)].
  44132.  
  44133.      ^box! !
  44134.  
  44135. !Path methodsFor: 'transforming'!
  44136. scaleBy: aPoint 
  44137.  
  44138.      "Answers with a new Path scaled by aPoint.  Does not effect
  44139.  
  44140. the current data in
  44141.  
  44142.      this Path."
  44143.  
  44144.  
  44145.  
  44146.      | newPath |
  44147.  
  44148.      newPath:= self species new: self size.
  44149.  
  44150.      newPath form: self form.
  44151.  
  44152.      collectionOfPoints do: 
  44153.  
  44154.           [:element | 
  44155.  
  44156.           newPath add: 
  44157.  
  44158.                     (aPoint x * element x) truncated @ (aPoint y
  44159.  
  44160. * element y) truncated].
  44161.  
  44162.      ^newPath! !
  44163.  
  44164. !Path methodsFor: 'transforming'!
  44165. translateBy: aPoint 
  44166.  
  44167.      "Answers with a new instance of Path whose elements are
  44168.  
  44169. translated by aPoint.  
  44170.  
  44171.      Does not effect the elements of this Path."
  44172.  
  44173.  
  44174.  
  44175.      | newPath |
  44176.  
  44177.      newPath:= self species new: self size.
  44178.  
  44179.      newPath form: self form.
  44180.  
  44181.      collectionOfPoints do: 
  44182.  
  44183.           [:element | 
  44184.  
  44185.           newPath add: 
  44186.  
  44187.                (element x + aPoint x) truncated @ (element y +
  44188.  
  44189. aPoint y) truncated].
  44190.  
  44191.      ^newPath! !
  44192.  
  44193. !Path methodsFor: 'private'!
  44194. initializeCollectionOfPoints
  44195.  
  44196.      "Initialize the collection of points on the path to be
  44197.  
  44198. empty."
  44199.  
  44200.  
  44201.  
  44202.      collectionOfPoints:= OrderedCollection new! !
  44203.  
  44204. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  44205.  
  44206. Path class
  44207.     instanceVariableNames: ''!
  44208.  
  44209. !Path class methodsFor: 'instance creation'!
  44210. new
  44211.  
  44212.      "Answer a new instance of the receiver that is an empty
  44213.  
  44214. sequence."
  44215.  
  44216.  
  44217.  
  44218.      ^self basicNew initializeCollectionOfPoints! !
  44219.  
  44220. !Path class methodsFor: 'instance creation'!
  44221. new: anInteger 
  44222.  
  44223.      "Answer a new instance of the receiver that has
  44224.  
  44225.      initially anInteger elements in its sequence."
  44226.  
  44227.  
  44228.  
  44229.      ^self basicNew initializeCollectionOfPoints: anInteger! !
  44230.  
  44231. Path subclass: #Spline2
  44232.     instanceVariableNames: 'derivatives '
  44233.     classVariableNames: ''
  44234.     poolDictionaries: ''
  44235.     category: 'Build'!
  44236. Spline2 comment:
  44237. 'Class Spline is a subclass of Path representing a collection of
  44238.  
  44239. Points through which a cubic spline curve is fitted.
  44240.  
  44241.  
  44242.  
  44243. Instance Variables:
  44244.  
  44245.      derivatives    <Array of: Points>
  44246.  
  44247.  
  44248.  
  44249. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  44250.  
  44251. '!
  44252.  
  44253. Spline2 comment:
  44254. 'Class Spline is a subclass of Path representing a collection of
  44255.  
  44256. Points through which a cubic spline curve is fitted.
  44257.  
  44258.  
  44259.  
  44260. Instance Variables:
  44261.  
  44262.      derivatives    <Array of: Points>
  44263.  
  44264.  
  44265.  
  44266. NOTE: This class was ported to Smalltalk version 4.0 by Don Laws.
  44267.  
  44268. '!
  44269.  
  44270. !Spline2 methodsFor: 'accessing'!
  44271. derivativePointsAt: knot 
  44272.     "Answer an Array of three points around the element of the 
  44273.     
  44274.     path knot."
  44275.  
  44276.     ^Array
  44277.         with: ((derivatives at: 1)
  44278.                 at: knot)
  44279.         with: ((derivatives at: 2)
  44280.                 at: knot)
  44281.         with: ((derivatives at: 3)
  44282.                 at: knot)! !
  44283.  
  44284. !Spline2 methodsFor: 'accessing'!
  44285. isCyclic
  44286.     "Answer whether the receiver is cyclic, i.e., folds back on 
  44287.     
  44288.     itself."
  44289.  
  44290.     ^self size > 3 and: [self first = self last]! !
  44291.  
  44292. !Spline2 methodsFor: 'displaying'!
  44293. display
  44294.  
  44295.      "Method for display of a Spline curve approximated by
  44296.  
  44297. straight line segments."
  44298.  
  44299.  
  44300.  
  44301.      | steps a b c d t  begin end endX endY aGraphicsContext |
  44302.  
  44303.       aGraphicsContext:= (Window currentWindow) graphicsContext.
  44304.  
  44305.      begin:= self first.
  44306.  
  44307.      1 to: self size-1 do:         "for each knot"
  44308.  
  44309.           [:k | 
  44310.  
  44311.                "taylor series coefficients"
  44312.  
  44313.           d:= self at: k.
  44314.  
  44315.           c:= (derivatives at: 1) at: k.
  44316.  
  44317.           b:= ((derivatives at: 2) at: k) / 2.0.
  44318.  
  44319.           a:= ((derivatives at: 3) at: k) / 6.0.
  44320.  
  44321.                "guess stepping parameter"
  44322.  
  44323.           steps:= ((derivatives at: 2) at: k) abs + ((derivatives
  44324.  
  44325. at: 2) at: k+1) abs.
  44326.  
  44327.           steps:= 5 max: (steps x + steps y) // 100.
  44328.  
  44329.           1 to: steps do: 
  44330.  
  44331.                [:j | 
  44332.  
  44333.                t:= j asFloat / steps asFloat.
  44334.  
  44335.                endX:= a x * t + b x * t + c x * t + d x.
  44336.  
  44337.                endY:= a y * t + b y * t + c y * t + d y.
  44338.  
  44339.                end:= endX @ endY.
  44340.  
  44341.                aGraphicsContext displayLineFrom: begin  to: end.
  44342.  
  44343.                begin:= end].
  44344.  
  44345.           end:= (self at: k+1).
  44346.  
  44347.           aGraphicsContext displayLineFrom: begin  to: end.
  44348.  
  44349.           ]! !
  44350.  
  44351. !Spline2 methodsFor: 'displaying'!
  44352. displayArcOnContext2: aGraphicsContext onView: aView 
  44353.  
  44354.      "Method for display of a Spline curve approximated by
  44355.  
  44356. straight line 
  44357.  
  44358.      segments."
  44359.  
  44360.  
  44361.  
  44362.      | steps a b c d t begin end endX endY temp |
  44363.  
  44364.      begin:= self first.
  44365.  
  44366.      1 to: self size - 1 do: 
  44367.  
  44368.           [:k | 
  44369.  
  44370.           "for each knot"
  44371.  
  44372.           "taylor series coefficients"
  44373.  
  44374.           d:= self at: k.
  44375.  
  44376.           c:= (derivatives at: 1)
  44377.  
  44378.                          at: k.
  44379.  
  44380.           b:= ((derivatives at: 2)
  44381.  
  44382.                          at: k)
  44383.  
  44384.                          / 2.0.
  44385.  
  44386.           a:= ((derivatives at: 3)
  44387.  
  44388.                          at: k)
  44389.  
  44390.                          / 6.0.    "guess stepping parameter"
  44391.  
  44392.           steps:= ((derivatives at: 2)
  44393.  
  44394.                          at: k) abs + ((derivatives at: 2)
  44395.  
  44396.                               at: k + 1) abs.
  44397.  
  44398.           steps:= 5 max: steps x + steps y // 100.
  44399.  
  44400.           1 to: steps do: 
  44401.  
  44402.                [:j | 
  44403.  
  44404.                t:= j asFloat / steps asFloat.
  44405.  
  44406.                endX:= a x * t + b x * t + c x * t + d x.
  44407.  
  44408.                endY:= a y * t + b y * t + c y * t + d y.
  44409.  
  44410.                end:= endX @ endY.
  44411.  
  44412.                aGraphicsContext paint: ColorValue black;
  44413.  
  44414. lineWidth: 2; displayLineFrom: begin to: end.
  44415.  
  44416.                temp:= begin.
  44417.  
  44418.                begin:= end].  
  44419.  
  44420.           end:= self at: k + 1].
  44421.  
  44422.      ^temp! !
  44423.  
  44424. !Spline2 methodsFor: 'displaying'!
  44425. displayArcOnContext: aGraphicsContext onView: aView 
  44426.     "Method for display of a Spline curve approximated by 
  44427.     
  44428.     straight line 
  44429.     
  44430.     segments."
  44431.  
  44432.     | steps a b c d t begin end endX endY temp |
  44433.     begin := self first.
  44434.     1 to: self size - 1
  44435.         do: 
  44436.             [:k | 
  44437.             "for each knot"
  44438.             "taylor series coefficients"
  44439.             d := self at: k.
  44440.             c := (derivatives at: 1)
  44441.                         at: k.
  44442.             b := ((derivatives at: 2)
  44443.                         at: k)
  44444.                         / 2.0.
  44445.             a := ((derivatives at: 3)
  44446.                         at: k)
  44447.                         / 6.0.    "guess stepping parameter"
  44448.             steps := ((derivatives at: 2)
  44449.                         at: k) abs + ((derivatives at: 2)
  44450.                             at: k + 1) abs.
  44451.             steps := 5 max: steps x + steps y // 100.
  44452.             1 to: steps
  44453.                 do: 
  44454.                     [:j | 
  44455.                     t := j asFloat / steps asFloat.
  44456.                     endX := a x * t + b x * t + c x * t + d x.
  44457.                     endY := a y * t + b y * t + c y * t + d y.
  44458.                     end := endX @ endY.
  44459.                     aGraphicsContext paint: ColorValue black; lineWidth: 3; displayLineFrom: begin to: end.
  44460.                     temp := begin.
  44461.                     begin := end].
  44462.             end := self at: k + 1].
  44463.     ^temp! !
  44464.  
  44465. !Spline2 methodsFor: 'displaying'!
  44466. displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule:
  44467.  
  44468. anInteger mask: aForm 
  44469.  
  44470.      "Method for display of a Spline curve approximated by
  44471.  
  44472. straight line segments."
  44473.  
  44474.  
  44475.  
  44476.      | steps a b c d t myBlt begin end endX endY |
  44477.  
  44478.      myBlt:= BitBlt
  44479.  
  44480.           destForm: aDisplayMedium
  44481.  
  44482.           sourceForm: self form
  44483.  
  44484.           halftoneForm: aForm
  44485.  
  44486.           combinationRule: anInteger
  44487.  
  44488.           destOrigin: aPoint
  44489.  
  44490.           sourceOrigin: 0 @ 0
  44491.  
  44492.           extent: Display extent
  44493.  
  44494.           clipRect: clipRect.
  44495.  
  44496.      begin:= self first.
  44497.  
  44498.      1 to: self size-1 do:         "for each knot"
  44499.  
  44500.           [:k | 
  44501.  
  44502.                "taylor series coefficients"
  44503.  
  44504.           d:= self at: k.
  44505.  
  44506.           c:= (derivatives at: 1) at: k.
  44507.  
  44508.           b:= ((derivatives at: 2) at: k) / 2.0.
  44509.  
  44510.           a:= ((derivatives at: 3) at: k) / 6.0.
  44511.  
  44512.                "guess stepping parameter"
  44513.  
  44514.           steps:= ((derivatives at: 2) at: k) abs + ((derivatives
  44515.  
  44516. at: 2) at: k+1) abs.
  44517.  
  44518.           steps:= 5 max: (steps x + steps y) // 100.
  44519.  
  44520.           1 to: steps do: 
  44521.  
  44522.                [:j | 
  44523.  
  44524.                t:= j asFloat / steps asFloat.
  44525.  
  44526.                endX:= a x * t + b x * t + c x * t + d x.
  44527.  
  44528.                endY:= a y * t + b y * t + c y * t + d y.
  44529.  
  44530.                end:= endX @ endY.
  44531.  
  44532.                myBlt drawFrom: begin rounded to: end rounded.
  44533.  
  44534.                begin:= end].
  44535.  
  44536.           end:= (self at: k+1).
  44537.  
  44538.           myBlt drawFrom: begin rounded to: end rounded.
  44539.  
  44540.           ]! !
  44541.  
  44542. !Spline2 methodsFor: 'displaying'!
  44543. displayOnContext: aGraphicsContext 
  44544.  
  44545.     "Method for display of a Spline curve approximated by straight line segments."
  44546.  
  44547.  
  44548.  
  44549.     | steps a b c d t begin end endX endY |
  44550.  
  44551.     begin := self first.
  44552.  
  44553.     1 to: self size - 1
  44554.  
  44555.         do: 
  44556.  
  44557.             [:k | 
  44558.  
  44559.             "for each knot"
  44560.  
  44561.             "taylor series coefficients"
  44562.  
  44563.             d := self at: k.
  44564.  
  44565.             c := (derivatives at: 1)
  44566.  
  44567.                         at: k.
  44568.  
  44569.             b := ((derivatives at: 2)
  44570.  
  44571.                         at: k)
  44572.  
  44573.                         / 2.0.
  44574.  
  44575.             a := ((derivatives at: 3)
  44576.  
  44577.                         at: k)
  44578.  
  44579.                         / 6.0.    "guess stepping parameter"
  44580.  
  44581.             steps := ((derivatives at: 2)
  44582.  
  44583.                         at: k) abs + ((derivatives at: 2)
  44584.  
  44585.                             at: k + 1) abs.
  44586.  
  44587.             steps := 5 max: steps x + steps y // 100.
  44588.  
  44589.             1 to: steps
  44590.  
  44591.                 do: 
  44592.  
  44593.                     [:j | 
  44594.  
  44595.                     t := j asFloat / steps asFloat.
  44596.  
  44597.                     endX := a x * t + b x * t + c x * t + d x.
  44598.  
  44599.                     endY := a y * t + b y * t + c y * t + d y.
  44600.  
  44601.                     end := endX @ endY.
  44602.  
  44603.                     aGraphicsContext displayLineFrom: begin to: end.
  44604.  
  44605.                     begin := end].
  44606.  
  44607.             end := self at: k + 1.
  44608.  
  44609.             aGraphicsContext displayLineFrom: begin to: end]! !
  44610.  
  44611. !Spline2 methodsFor: 'private'!
  44612. computeCurve
  44613.     "Compute an array for the derivatives at each knot."
  44614.  
  44615.     | size extras values |
  44616.     size := self size.
  44617.     self isCyclic
  44618.         ifTrue: 
  44619.             ["for cyclic curves"
  44620.             extras := 2.    "add 2 extra points to each 
  44621.             
  44622.             end."
  44623.             values := Array new: 2 * extras + size.
  44624.             1 to: extras
  44625.                 do: 
  44626.                     [:i | 
  44627.                     values at: i put: (self at: size - extras + i - 1).
  44628.                     values at: size + extras + i put: (self at: i + 1)].
  44629.             values
  44630.                 replaceFrom: extras + 1
  44631.                 to: extras + size
  44632.                 with: collectionOfPoints]
  44633.         ifFalse: 
  44634.             [extras := 0.
  44635.             values := collectionOfPoints].
  44636.     derivatives := Array new: 3.
  44637.     1 to: 3 do: [:i | derivatives at: i put: (Array new: values size)].
  44638.     self
  44639.         derivs: values
  44640.         first: (derivatives at: 1)
  44641.         second: (derivatives at: 2)
  44642.         third: (derivatives at: 3).
  44643.     extras > 0 ifTrue: ["remove extra points"
  44644.         1 to: 3 do: [:i | derivatives at: i put: ((derivatives at: i)
  44645.                     copyFrom: extras + 1 to: extras + size)]]! !
  44646.  
  44647. !Spline2 methodsFor: 'private'!
  44648. derivs: values first: first second: second third: third 
  44649.     "Compute the first, second and third derivitives at each 
  44650.     
  44651.     point in the array values."
  44652.  
  44653.     | size v b |
  44654.     size := values size.
  44655.     size > 2
  44656.         ifTrue: 
  44657.             [v := Array new: size.
  44658.             v at: 1 put: 4.0.
  44659.             b := Array new: size.
  44660.             b at: 1 put: 6.0 * (values first - ((values at: 2)
  44661.                             * 2.0) + (values at: 3)).
  44662.             2 to: size - 2
  44663.                 do: 
  44664.                     [:i | 
  44665.                     v at: i put: 4.0 - (1.0 / (v at: i - 1)).
  44666.                     b at: i put: 6.0 * ((values at: i)
  44667.                                 - ((values at: i + 1)
  44668.                                         * 2.0) + (values at: i + 2)) - ((b at: i - 1)
  44669.                                 / (v at: i - 1))].
  44670.             second at: size - 1 put: (b at: size - 2)
  44671.                     / (v at: size - 2).
  44672.             size - 2
  44673.                 to: 2
  44674.                 by: -1
  44675.                 do: [:i | second at: i put: (b at: i - 1)
  44676.                             - (second at: i + 1) / (v at: i - 1)]].
  44677.     second at: 1 put: 0.0 asPoint.
  44678.     second at: size put: 0.0 asPoint.
  44679.     1 to: size - 1
  44680.         do: 
  44681.             [:i | 
  44682.             first at: i put: (values at: i + 1)
  44683.                     - (values at: i) - ((second at: i)
  44684.                         * 2.0 + (second at: i + 1) / 6.0).
  44685.             third at: i put: (second at: i + 1)
  44686.                     - (second at: i)]! !
  44687.  
  44688. SequenceableCollection subclass: #ParseTree
  44689.     instanceVariableNames: 'root errors parent currentPosition currentTTM doAgain '
  44690.     classVariableNames: ''
  44691.     poolDictionaries: ''
  44692.     category: 'Build'!
  44693.  
  44694. !ParseTree methodsFor: 'private'!
  44695. addLeftAtom: newAtom to: currentElement 
  44696.     | newElement |
  44697.     newElement := ParseElement
  44698.                 contents: newAtom
  44699.                 left: nil
  44700.                 right: nil.
  44701.     currentElement left: newElement.
  44702.     currentPosition := newElement! !
  44703.  
  44704. !ParseTree methodsFor: 'private'!
  44705. addLeftConnector: newContents to: current with: child 
  44706.     | newElement |
  44707.     newElement := ParseElement
  44708.                 contents: newContents
  44709.                 left: child
  44710.                 right: nil.
  44711.     current left: newElement.
  44712.     currentPosition := newElement! !
  44713.  
  44714. !ParseTree methodsFor: 'private'!
  44715. addRightAtom: newAtom to: currentElement 
  44716.     | newElement |
  44717.     newElement := ParseElement
  44718.                 contents: newAtom
  44719.                 left: nil
  44720.                 right: nil.
  44721.     currentElement right: newElement.
  44722.     currentPosition := newElement! !
  44723.  
  44724. !ParseTree methodsFor: 'private'!
  44725. addRightConnector: newContents to: current with: child 
  44726.     | newElement |
  44727.     newElement := ParseElement
  44728.                 contents: newContents
  44729.                 left: child
  44730.                 right: nil.
  44731.     current right: newElement.
  44732.     currentPosition := newElement! !
  44733.  
  44734. !ParseTree methodsFor: 'private'!
  44735. extraLeftsFrom: start 
  44736.     "A recursive traversal. Mark as error if 
  44737.     
  44738.     there is a node with contents = 'LEFT'.."
  44739.  
  44740.     start left ~= nil ifTrue: [self extraLeftsFrom: start left].
  44741.     start contents = 'LEFT' ifTrue: [errors := 'extra lefts'].
  44742.     start right ~= nil ifTrue: [self extraLeftsFrom: start right]! !
  44743.  
  44744. !ParseTree methodsFor: 'private'!
  44745. negate: start 
  44746.     start left ~= nil ifTrue: [self negate: start left].
  44747.     start = root ifFalse: [start isAtom
  44748.             ifTrue: [start contents: (self negateAtom: start contents)]
  44749.             ifFalse: [start contents = 'AND'
  44750.                     ifTrue: [start contents: 'OR']
  44751.                     ifFalse: [start contents = 'OR'
  44752.                             ifTrue: [start contents: 'AND']
  44753.                             ifFalse: [TTMList speak: 'error in negating guard']]]].
  44754.     start right ~= nil ifTrue: [self negate: start right]! !
  44755.  
  44756. !ParseTree methodsFor: 'private'!
  44757. negateAtom: oldAtom 
  44758.     "We want to reverse all comparator signs. 
  44759.     
  44760.     Then return the atom."
  44761.  
  44762.     | anAtom p operator comparator replacement replacement2 |
  44763.     anAtom := oldAtom copy.
  44764.     p := 1.
  44765.     operator := anAtom at: p.
  44766.     [(ParseTree isAComparator: operator) = true | (p = anAtom size)]
  44767.         whileFalse: 
  44768.             [p := p + 1.
  44769.             operator := anAtom at: p].
  44770.     p = anAtom size ifTrue: [^anAtom].
  44771.     comparator := operator.
  44772.     replacement2 := nil.
  44773.     (anAtom at: p + 1)
  44774.         = '=' | ((anAtom at: p + 1)
  44775.             = '<')
  44776.         ifTrue: 
  44777.             [comparator = '=' ifTrue: [replacement := '>'].
  44778.             comparator = '>' ifTrue: [replacement := '<'].
  44779.             anAtom removeAtIndex: p + 1]
  44780.         ifFalse: 
  44781.             [comparator = '#' ifTrue: [replacement := '='].
  44782.             comparator = '=' ifTrue: [replacement := '#'].
  44783.             comparator = '<'
  44784.                 ifTrue: 
  44785.                     [replacement := '>'.
  44786.                     replacement2 := '='].
  44787.             comparator = '>'
  44788.                 ifTrue: 
  44789.                     [replacement := '='.
  44790.                     replacement2 := '<']].
  44791.     anAtom at: p put: replacement.
  44792.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  44793.     ^anAtom! !
  44794.  
  44795. !ParseTree methodsFor: 'private'!
  44796. negateAtomNew: oldAtom 
  44797.     "We want to reverse all comparator signs. 
  44798.     
  44799.     Then return the atom."
  44800.  
  44801.     | anAtom p operator comparator replacement replacement2 |
  44802.     anAtom := oldAtom.
  44803.     p := 1.
  44804.     operator := anAtom at: p.
  44805.     [ParseTree isAComparator: operator]
  44806.         whileFalse: 
  44807.             [p := p + 1.
  44808.             operator := anAtom at: p].
  44809.     comparator := operator.
  44810.     replacement2 := nil.
  44811.     (anAtom at: p + 1)
  44812.         = '=' | ((anAtom at: p + 1)
  44813.             = '<')
  44814.         ifTrue: 
  44815.             [comparator = '=' ifTrue: [replacement := '>'].
  44816.             comparator = '>' ifTrue: [replacement := '<'].
  44817.             "anAtom removeAtIndex: p + 1"]
  44818.         ifFalse: 
  44819.             [comparator = '#' ifTrue: [replacement := '='].
  44820.             comparator = '=' ifTrue: [replacement := '#'].
  44821.             comparator = '<'
  44822.                 ifTrue: 
  44823.                     [replacement := '>'.
  44824.                     replacement2 := '='].
  44825.             comparator = '>'
  44826.                 ifTrue: 
  44827.                     [replacement := '='.
  44828.                     replacement2 := '<']].
  44829.     "anAtom removeAtIndex: p."
  44830.     anAtom at: p put: replacement .
  44831.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  44832.     ^anAtom! !
  44833.  
  44834. !ParseTree methodsFor: 'private'!
  44835. negateAtomOld: oldAtom 
  44836.     "We want to reverse all comparator signs. 
  44837.     
  44838.     Then return the atom."
  44839.  
  44840.     | anAtom p operator comparator replacement replacement2 |
  44841.     anAtom := oldAtom.
  44842.     p := 1.
  44843.     operator := anAtom at: p.
  44844.     [ParseTree isAComparator: operator]
  44845.         whileFalse: 
  44846.             [p := p + 1.
  44847.             operator := anAtom at: p].
  44848.     comparator := operator.
  44849.     replacement2 := nil.
  44850.     (anAtom at: p + 1)
  44851.         = '=' | ((anAtom at: p + 1)
  44852.             = '<')
  44853.         ifTrue: 
  44854.             [comparator = '=' ifTrue: [replacement := '>'].
  44855.             comparator = '>' ifTrue: [replacement := '<'].
  44856.             anAtom removeAtIndex: p + 1]
  44857.         ifFalse: 
  44858.             [comparator = '#' ifTrue: [replacement := '='].
  44859.             comparator = '=' ifTrue: [replacement := '#'].
  44860.             comparator = '<'
  44861.                 ifTrue: 
  44862.                     [replacement := '>'.
  44863.                     replacement2 := '='].
  44864.             comparator = '>'
  44865.                 ifTrue: 
  44866.                     [replacement := '='.
  44867.                     replacement2 := '<']].
  44868.     anAtom removeAtIndex: p.
  44869.     anAtom add: replacement beforeIndex: p.
  44870.     replacement2 = nil ifFalse: [anAtom add: replacement2 beforeIndex: p + 1].
  44871.     ^anAtom! !
  44872.  
  44873. !ParseTree methodsFor: 'private'!
  44874. parentOf: target startingAt: start 
  44875.     "A recursive search called by method 'parentOf:'. 
  44876.     
  44877.     Once the parent is found; i.e. no longer = nil, the 
  44878.     
  44879.     search is ended as quickly as possible."
  44880.  
  44881.     start left ~= nil & parent isNil
  44882.         ifTrue: [self parentOf: target startingAt: start left]
  44883.         ifFalse: [].
  44884.     parent isNil
  44885.         ifTrue: [start left = target | (start right = target)
  44886.                 ifTrue: [parent := start]
  44887.                 ifFalse: []]
  44888.         ifFalse: [].
  44889.     start right ~= nil & parent isNil
  44890.         ifTrue: [self parentOf: target startingAt: start right]
  44891.         ifFalse: []! !
  44892.  
  44893. !ParseTree methodsFor: 'private'!
  44894. prenex: start 
  44895.     "Recursive traversal that does one pass of switching 
  44896.     
  44897.     AND and ORs. If more passes may be required, it sets 
  44898.     
  44899.     doAgain = true."
  44900.  
  44901.     | current rsubtree lsubtree movedNode newsubtree |
  44902.     current := start.
  44903.     current contents = 'AND'
  44904.         ifTrue: 
  44905.             [rsubtree := current right.
  44906.             lsubtree := current left.
  44907.             lsubtree contents = 'OR'
  44908.                 ifTrue: 
  44909.                     [current contents: 'OR'.
  44910.                     lsubtree contents: 'AND'.
  44911.                     movedNode := lsubtree right copy.
  44912.                     lsubtree right: rsubtree.
  44913.                     newsubtree := ParseElement
  44914.                                 contents: 'AND'
  44915.                                 left: movedNode
  44916.                                 right: rsubtree copy.
  44917.                     current right: newsubtree.
  44918.                     doAgain := true]
  44919.                 ifFalse: [rsubtree contents = 'OR'
  44920.                         ifTrue: 
  44921.                             [current contents: 'OR'.
  44922.                             rsubtree contents: 'AND'.
  44923.                             movedNode := rsubtree left copy.
  44924.                             rsubtree left: lsubtree.
  44925.                             newsubtree := ParseElement
  44926.                                         contents: 'AND'
  44927.                                         left: lsubtree copy
  44928.                                         right: movedNode.
  44929.                             current left: newsubtree.
  44930.                             doAgain := true]]].
  44931.     start left ~= nil ifTrue: [self prenex: start left].
  44932.     start right ~= nil ifTrue: [self prenex: start right]! !
  44933.  
  44934. !ParseTree methodsFor: 'possible events'!
  44935. atom: newAtom 
  44936.     "An ATOM was encountered. Alter the      
  44937.     ParseTree accordingly. An ATOM could be      
  44938.     a boolean expression or an assignment."
  44939.  
  44940.     currentPosition isAtom
  44941.         ifTrue: 
  44942.             ["errors := 'consecutive atoms'.
  44943.             TTMList speak: errors"]
  44944.         ifFalse: [currentPosition left = nil
  44945.                 ifTrue: [self addLeftAtom: newAtom to: currentPosition]
  44946.                 ifFalse: [currentPosition right = nil & (currentPosition contents ~= 'LEFT')
  44947.                         ifTrue: [self addRightAtom: newAtom to: currentPosition]
  44948.                         ifFalse: 
  44949.                             [errors := 'missing connector'.
  44950.                             TTMList speak: errors]]]! !
  44951.  
  44952. !ParseTree methodsFor: 'possible events'!
  44953. chooseEventFor: anElement 
  44954.     "anElement can be either a left bracket, a right 
  44955.     
  44956.     bracket, logical AND, logical OR, or an atom."
  44957.  
  44958.     | component |
  44959.     errors := nil.
  44960.     component := anElement at: 1.
  44961.     component = '('
  44962.         ifTrue: [self leftBracket]
  44963.         ifFalse: [component = ')'
  44964.                 ifTrue: [self rightBracket]
  44965.                 ifFalse: [component = ';'
  44966.                         ifTrue: [self logicalOr]
  44967.                         ifFalse: [component = ','
  44968.                                 ifTrue: [self logicalAnd]
  44969.                                 ifFalse: [TTMList speak: 'unknown event']]]]! !
  44970.  
  44971. !ParseTree methodsFor: 'possible events'!
  44972. inPrenexForm
  44973.     "Converts the parse tree into prenex form then 
  44974.     
  44975.     returns it."
  44976.  
  44977.     | continue |
  44978.     doAgain := false.
  44979.     
  44980.     continue := true.
  44981.     [continue]
  44982.         whileTrue: 
  44983.             [self prenex: root.
  44984.             continue := doAgain.
  44985.             doAgain := false].
  44986.     ^self! !
  44987.  
  44988. !ParseTree methodsFor: 'possible events'!
  44989. leftBracket
  44990.     "A left bracket was encountered. We create 
  44991.     
  44992.     a special temporary connector for this. Its 
  44993.     
  44994.     left pointer points to all within the brackets 
  44995.     
  44996.     and its right pointer is never used. When the 
  44997.     
  44998.     right bracket is encountered this connector 
  44999.     
  45000.     is removed."
  45001.  
  45002.     | father |
  45003.     currentPosition contents = 'LEFT' | (currentPosition = root)
  45004.         ifTrue: [self
  45005.                 addLeftConnector: 'LEFT'
  45006.                 to: currentPosition
  45007.                 with: currentPosition left]
  45008.         ifFalse: [currentPosition isAtom
  45009.                 ifTrue: 
  45010.                     [father := self parentOf: currentPosition.
  45011.                     father left isNil
  45012.                         ifTrue: [self
  45013.                                 addLeftConnector: 'LEFT'
  45014.                                 to: currentPosition
  45015.                                 with: nil]
  45016.                         ifFalse: [father right isNil
  45017.                                 ifTrue: [self
  45018.                                         addRightConnector: 'LEFT'
  45019.                                         to: currentPosition
  45020.                                         with: nil]
  45021.                                 ifFalse: 
  45022.                                     [errors := 'missing AND/OR'.
  45023.                                     TTMList speak: errors]]]
  45024.                 ifFalse: [currentPosition left isNil
  45025.                         ifTrue: [self
  45026.                                 addLeftConnector: 'LEFT'
  45027.                                 to: currentPosition
  45028.                                 with: nil]
  45029.                         ifFalse: [currentPosition right isNil
  45030.                                 ifTrue: [self
  45031.                                         addRightConnector: 'LEFT'
  45032.                                         to: currentPosition
  45033.                                         with: nil]
  45034.                                 ifFalse: 
  45035.                                     [errors := 'missing AND/OR'.
  45036.                                     TTMList speak: errors]]]]! !
  45037.  
  45038. !ParseTree methodsFor: 'possible events'!
  45039. logicalAnd
  45040.     "A AND was encountered. Alter the ParseTree accordingly. 
  45041.     
  45042.     We want to place this logical AND where the currentPosition 
  45043.     
  45044.     is and make the currentPosition its left child."
  45045.  
  45046.     | father child |
  45047.     currentPosition contents = 'ROOT' | (currentPosition contents = 'LEFT')
  45048.         ifTrue: 
  45049.             [errors := 'AND encountered prior to an atom'.
  45050.             TTMList speak: errors]
  45051.         ifFalse: [currentPosition isAtom
  45052.                 ifFalse: 
  45053.                     [errors := 'consecutive AND/ORs'.
  45054.                     TTMList speak: errors]
  45055.                 ifTrue: 
  45056.                     [father := self parentOf: currentPosition.
  45057.                     child := currentPosition.
  45058.                     [father ~= root & (father contents ~= 'LEFT' & (father left ~= nil & (father right ~= nil)))]
  45059.                         whileTrue: 
  45060.                             [child := father.
  45061.                             father := self parentOf: child].
  45062.                     father = root | (father contents = 'LEFT')
  45063.                         ifTrue: [self
  45064.                                 addLeftConnector: 'AND'
  45065.                                 to: father
  45066.                                 with: child]
  45067.                         ifFalse: 
  45068.                             [errors := 'consecutive
  45069.  
  45070. AND/ORs'.
  45071.                             TTMList speak: errors]]]! !
  45072.  
  45073. !ParseTree methodsFor: 'possible events'!
  45074. logicalOr
  45075.     "A OR was encountered. Alter the 
  45076.     
  45077.     ParseTree accordingly. See logicalAnd 
  45078.     
  45079.     for description."
  45080.  
  45081.     | father child |
  45082.     currentPosition = root | (currentPosition contents = 'LEFT')
  45083.         ifTrue: 
  45084.             [errors := 'OR encountered prior to an atom'.
  45085.             TTMList speak: errors]
  45086.         ifFalse: [currentPosition isAtom
  45087.                 ifFalse: 
  45088.                     [errors := 'consecutive AND/ORs'.
  45089.                     TTMList speak: errors]
  45090.                 ifTrue: 
  45091.                     [father := self parentOf: currentPosition.
  45092.                     child := currentPosition.
  45093.                     [father ~= root & (father contents ~= 'LEFT') & (father left ~= nil & (father right ~= nil))]
  45094.                         whileTrue: 
  45095.                             [child := father.
  45096.                             father := self parentOf: child].
  45097.                     father = root | (father contents = 'LEFT')
  45098.                         ifTrue: [self
  45099.                                 addLeftConnector: 'OR'
  45100.                                 to: father
  45101.                                 with: child]
  45102.                         ifFalse: 
  45103.                             [errors := 'consecutive AND/ORs'.
  45104.                             TTMList speak: errors]]]! !
  45105.  
  45106. !ParseTree methodsFor: 'possible events'!
  45107. negation
  45108.     "Changes the current parse tree to its negation. 
  45109.     
  45110.     Example: (A , (B ; C)) becomes (~A ; (~B , ~C))."
  45111.  
  45112.     self negate: root.
  45113.     ^self! !
  45114.  
  45115. !ParseTree methodsFor: 'possible events'!
  45116. rightBracket
  45117.     "A right bracket was encountered. Alter the 
  45118.     
  45119.     ParseTree accordingly. 
  45120.     
  45121.     We must find the corresponding left bracket. 
  45122.     
  45123.     It acts as a placeholder."
  45124.  
  45125.     | father grandFather |
  45126.     currentPosition = root
  45127.         ifTrue: 
  45128.             [errors := 'Right bracket encountered prior to left'.
  45129.             TTMList speak: errors]
  45130.         ifFalse: 
  45131.             [father := self parentOf: currentPosition.
  45132.             [father contents = 'LEFT' | (father = root)]
  45133.                 whileFalse: [father := self parentOf: father].
  45134.             father = root
  45135.                 ifTrue: 
  45136.                     [errors := 'extra right bracket'.
  45137.                     TTMList speak: errors]
  45138.                 ifFalse: 
  45139.                     [grandFather := self parentOf: father.
  45140.                     grandFather left = father
  45141.                         ifTrue: [grandFather left: father left]
  45142.                         ifFalse: [grandFather right: father left]]]! !
  45143.  
  45144. !ParseTree methodsFor: 'accessing'!
  45145. error
  45146.     ^errors! !
  45147.  
  45148. !ParseTree methodsFor: 'accessing'!
  45149. extraLefts
  45150.     errors := nil.
  45151.     self extraLeftsFrom: root.
  45152.     errors isNil ifFalse: [TTMList speak: 'extra left brackets'].
  45153.     ^errors isNil not! !
  45154.  
  45155. !ParseTree methodsFor: 'accessing'!
  45156. isNotAtom: aComponent 
  45157.     "Return true if the component is leftbracket, 
  45158.     
  45159.     rightbracket, comma, or semi-colon."
  45160.  
  45161.     | result |
  45162.     result := false.
  45163.     aComponent = '(' ifTrue: [result := true].
  45164.     aComponent = ')' ifTrue: [result := true].
  45165.     aComponent = ',' ifTrue: [result := true].
  45166.     aComponent = ';' ifTrue: [result := true].
  45167.     ^result! !
  45168.  
  45169. !ParseTree methodsFor: 'accessing'!
  45170. isNotAtomOld: aComponent 
  45171.     "Return true if the component is leftbracket, 
  45172.     
  45173.     rightbracket, comma, or semi-colon."
  45174.  
  45175.     | result |
  45176.     result := false.
  45177.     aComponent = '(' ifTrue: [result := true].
  45178.     aComponent = ')' ifTrue: [result := true].
  45179.     aComponent = ',' ifTrue: [result := true].
  45180.     aComponent = ';' ifTrue: [result := true].
  45181.     ^result! !
  45182.  
  45183. !ParseTree methodsFor: 'accessing'!
  45184. parentOf: currentElement 
  45185.     "Return the parent of the current Element in 
  45186.     
  45187.     the parse tree. This is used for changing 
  45188.     
  45189.     pointers to the current Element."
  45190.  
  45191.     root = nil
  45192.         ifTrue: [^nil]
  45193.         ifFalse: 
  45194.             [parent := nil.
  45195.             currentElement = root
  45196.                 ifTrue: [^nil]
  45197.                 ifFalse: 
  45198.                     [self parentOf: currentElement startingAt: root.
  45199.                     ^parent]]! !
  45200.  
  45201. !ParseTree methodsFor: 'accessing'!
  45202. treeRoot
  45203.     ^root! !
  45204.  
  45205. !ParseTree methodsFor: 'initialize-release'!
  45206. initializeWith: ttm 
  45207.     "root is initialized as a special connector. Its contents 
  45208.     
  45209.     should never be changed. Its left pointer is to the 
  45210.     
  45211.     parse tree (initialized as nil). Its right pointer is never 
  45212.     
  45213.     used."
  45214.  
  45215.     currentTTM := ttm.
  45216.     errors := nil.
  45217.     root := ParseElement
  45218.                 contents: 'ROOT'
  45219.                 left: nil
  45220.                 right: nil.
  45221.     currentPosition := root.
  45222.     ^root! !
  45223.  
  45224. !ParseTree methodsFor: 'tree syntax check'!
  45225. checkAtomsAs: atomType 
  45226.     errors := nil.
  45227.     atomType = #function
  45228.         ifTrue: [self functionCheck: root]
  45229.         ifFalse: [self guardCheck: root].
  45230.     ^errors! !
  45231.  
  45232. !ParseTree methodsFor: 'tree syntax check'!
  45233. functionCheck: start 
  45234.     "A recursive traversal."
  45235.  
  45236.     start left ~= nil ifTrue: [self functionCheck: start left].
  45237.     start isAtom ifTrue: [(self isFunctionAtom: start contents)
  45238.             ifFalse: 
  45239.                 [errors := 'assignment error'.
  45240.                 TTMList speak: errors]].
  45241.     start right ~= nil ifTrue: [self functionCheck: start right]! !
  45242.  
  45243. !ParseTree methodsFor: 'tree syntax check'!
  45244. guardCheck: start 
  45245.     "A recursive traversal."
  45246.  
  45247.     start left ~= nil ifTrue: [self guardCheck: start left].
  45248.     start isAtom ifTrue: [(self isGuardAtom: start contents)
  45249.             ifFalse: 
  45250.                 [errors := 'expression error'.
  45251.                 TTMList speak: errors]].
  45252.     start right ~= nil ifTrue: [self guardCheck: start right]! !
  45253.  
  45254. !ParseTree methodsFor: 'atom syntax check'!
  45255. isAValidOperand: anAtom from: start to: end with: allowance 
  45256.     "Return true if the section of the atom from start      
  45257.     to end is a valid operand. Note that it      
  45258.     is allowable to have X - -Y which would translate      
  45259.     into X + Y, but not --X + Y. 
  45260.     Allowances refer to what the routine should allow.      
  45261.     If #channel then will only accept an operand that      
  45262.     is a communication channel. If #variable then only      
  45263.     a variable. If #noOperations then no addition or      
  45264.     subtraction is allowed (though negatives are okay)."
  45265.  
  45266.     | p firstPart |
  45267.     p := start.
  45268.     allowance = #channel | (allowance = #variable)
  45269.         ifTrue: 
  45270.             [end > start ifTrue: [^false].
  45271.             allowance = #channel
  45272.                 ifTrue: [^currentTTM anExistingCh: (anAtom at: p)]
  45273.                 ifFalse: [^currentTTM anExistingV: (anAtom at: p)]].
  45274.     firstPart := true.
  45275.     [p > end]
  45276.         whileFalse: 
  45277.             [(ParseTree isAnOperator: (anAtom at: p))
  45278.                 ifTrue: 
  45279.                     [firstPart = false & (allowance = #noOperations) ifTrue: [^false].
  45280.                     p := p + 1.
  45281.                     p > end ifTrue: [^false].
  45282.                     (ParseTree isAnOperator: (anAtom at: p))
  45283.                         ifTrue: 
  45284.                             [firstPart = true | (allowance = #noOperations) ifTrue: [^false].
  45285.                             p := p + 1.
  45286.                             p > end ifTrue: [^false]]].
  45287.             (currentTTM anExistingActivityName: (anAtom at: p))
  45288.                 | (currentTTM anExistingV: (anAtom at: p)) | (TTMList aValidNumber: (anAtom at: p)) ifFalse: [^false].
  45289.             firstPart := false.
  45290.             p := p + 1].
  45291.     ^true! !
  45292.  
  45293. !ParseTree methodsFor: 'atom syntax check'!
  45294. isFunctionAtom: anAtom 
  45295.     "Return true if anAtom is a function assignment."
  45296.  
  45297.     | count assignment allowance1 allowance2 |
  45298.     count := 1.
  45299.     assignment := 0.
  45300.     [count > anAtom size]
  45301.         whileFalse: 
  45302.             [(ParseTree isAnAssigner: (anAtom at: count))
  45303.                 ifTrue: 
  45304.                     [assignment > 0 ifTrue: [^false].
  45305.                     assignment := count].
  45306.             count := count + 1].
  45307.     assignment < 2 | (assignment = anAtom size) ifTrue: [^false].
  45308.     allowance1 := #variable.
  45309.     allowance2 := #anything.
  45310.     (anAtom at: assignment)
  45311.         = '?' | ((anAtom at: assignment)
  45312.             = '!!')
  45313.         ifTrue: 
  45314.             [allowance1 := #channel.
  45315.             (anAtom at: assignment)
  45316.                 = '?' ifTrue: [allowance2 := #variable]].
  45317.     (self
  45318.         isAValidOperand: anAtom
  45319.         from: 1
  45320.         to: assignment - 1
  45321.         with: allowance1)
  45322.         ifFalse: [^false].
  45323.     (self
  45324.         isAValidOperand: anAtom
  45325.         from: assignment + 1
  45326.         to: anAtom size
  45327.         with: allowance2)
  45328.         ifFalse: [^false].
  45329.     ^true! !
  45330.  
  45331. !ParseTree methodsFor: 'atom syntax check'!
  45332. isGuardAtom: anAtom 
  45333.     "Return true if anAtom is a valid guard expression."
  45334.  
  45335.     | count comparator double |
  45336.     count := 1.
  45337.     comparator := 0.
  45338.     double := 0.
  45339.     [count > anAtom size]
  45340.         whileFalse: 
  45341.             [(ParseTree isAComparator: (anAtom at: count))
  45342.                 ifTrue: [comparator > 0
  45343.                         ifTrue: 
  45344.                             [double > 0 ifTrue: [^false].
  45345.                             (anAtom at: comparator)
  45346.                                 = '>' & ((anAtom at: count)
  45347.                                     = '=') | ((anAtom at: comparator)
  45348.                                     = '=' & ((anAtom at: count)
  45349.                                         = '<')) ifFalse: [^false].
  45350.                             double := count]
  45351.                         ifFalse: [comparator := count]].
  45352.             count := count + 1].
  45353.     comparator < 2 | (comparator = anAtom size) ifTrue: [^false].
  45354.     double = 0 ifTrue: [double := comparator].
  45355.     (self
  45356.         isAValidOperand: anAtom
  45357.         from: 1
  45358.         to: comparator - 1
  45359.         with: #anything)
  45360.         ifFalse: [^false].
  45361.     (self
  45362.         isAValidOperand: anAtom
  45363.         from: double + 1
  45364.         to: anAtom size
  45365.         with: #anything)
  45366.         ifFalse: [^false].
  45367.     ^true! !
  45368.  
  45369. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  45370.  
  45371. ParseTree class
  45372.     instanceVariableNames: ''!
  45373.  
  45374. !ParseTree class methodsFor: 'symbol identity'!
  45375. isAComparator: aComponent 
  45376.     "Return true if the component is #, =, <, >, >=, or =<."
  45377.  
  45378.     | result |
  45379.     result := false.
  45380.     aComponent = '#' ifTrue: [result := true].
  45381.     aComponent = '=' ifTrue: [result := true].
  45382.     aComponent = '<' ifTrue: [result := true].
  45383.     aComponent = '>' ifTrue: [result := true].
  45384.     aComponent = '>=' ifTrue: [result := true].
  45385.     aComponent = '=<' ifTrue: [result := true].
  45386.     ^result! !
  45387.  
  45388. !ParseTree class methodsFor: 'symbol identity'!
  45389. isAnAssigner: aComponent 
  45390.     "Return true if the component is :, ?, or !!."
  45391.  
  45392.     | result |
  45393.     result := false.
  45394.     aComponent = ':' ifTrue: [result := true].
  45395.     aComponent = '?' ifTrue: [result := true].
  45396.     aComponent = '!!' ifTrue: [result := true].
  45397.     ^result! !
  45398.  
  45399. !ParseTree class methodsFor: 'symbol identity'!
  45400. isAnOperator: aComponent 
  45401.     "Return true if the component is + or - or * or /"
  45402.  
  45403.     | result |
  45404.     result := false.
  45405.     aComponent = '+' ifTrue: [result := true].
  45406.     aComponent = '-' ifTrue: [result := true].
  45407.     aComponent = '*' ifTrue: [result := true].
  45408.     aComponent = '/' ifTrue: [result := true].
  45409.     aComponent = '%' ifTrue: [result := true].
  45410.     ^result! !
  45411.  
  45412. !ParseTree class methodsFor: 'symbol identity'!
  45413. isAnOperatorOld: aComponent 
  45414.     "Return true if the component is + or - or *."
  45415.  
  45416.     | result |
  45417.     result := false.
  45418.     aComponent = '+' ifTrue: [result := true].
  45419.     aComponent = '-' ifTrue: [result := true].
  45420.     aComponent = '*' ifTrue: [result := true].
  45421.     ^result! !
  45422.  
  45423. !ParseTree class methodsFor: 'string syntax check'!
  45424. functionSyntaxCheck: aString from: currentTTM 
  45425.     "Fission the string into components, then order 
  45426.     
  45427.     them by creating a parse tree. Finally, examine 
  45428.     
  45429.     each assignment to see that it is valid."
  45430.  
  45431.     | errors components parseTree |
  45432.     errors := false.
  45433.     components := ParseTree fission: aString definedAs: #function.
  45434.     components = nil
  45435.         ifTrue: 
  45436.             [TTMList speak: 'illegal symbol(s)'.
  45437.             errors := true]
  45438.         ifFalse: 
  45439.             [parseTree := ParseTree orderIntoTree: components from: currentTTM.
  45440.             parseTree = nil
  45441.                 ifTrue: 
  45442.                     [TTMList speak: 'error in parsing function'.
  45443.                     errors := true]
  45444.                 ifFalse: [parseTree extraLefts
  45445.                         ifTrue: [errors := true]
  45446.                         ifFalse: [(parseTree checkAtomsAs: #function)
  45447.                                 ~= nil ifTrue: [errors := true]]]].
  45448.     ^errors! !
  45449.  
  45450. !ParseTree class methodsFor: 'string syntax check'!
  45451. guardSyntaxCheck: aString from: currentTTM 
  45452.     "Fission the string into components, then order 
  45453.     
  45454.     them by creating a parse tree. Finally, examine 
  45455.     
  45456.     each expression to see that it is valid. Returns 
  45457.     
  45458.     true if an error is found."
  45459.  
  45460.     | errors components parseTree |
  45461.     errors := false.
  45462.     components := ParseTree fission: aString definedAs: #guard.
  45463.     components = nil
  45464.         ifTrue: 
  45465.             [TTMList speak: 'illegal symbol(s)'.
  45466.             errors := true]
  45467.         ifFalse: 
  45468.             [parseTree := ParseTree orderIntoTree: components from: currentTTM.
  45469.             parseTree = nil
  45470.                 ifTrue: 
  45471.                     [TTMList speak: 'error in parsing guard'.
  45472.                     errors := true]
  45473.                 ifFalse: [parseTree extraLefts
  45474.                         ifTrue: [errors := true]
  45475.                         ifFalse: [(parseTree checkAtomsAs: #guard) isNil ifFalse: [errors := true]]]].
  45476.     ^errors! !
  45477.  
  45478. !ParseTree class methodsFor: 'construction'!
  45479. fission: aString definedAs: stringType 
  45480.     "Divide aString into its components which are either numbers      
  45481.     (as strings), variables or operators. Returns nil if error      
  45482.     otherwise      
  45483.     returns components as an OrderedCollection."
  45484.  
  45485.     | components position currentLeft letter errors legalSymbols set |
  45486.     errors := false.
  45487.     stringType = #guard
  45488.         ifTrue: [legalSymbols := #($+ $- $* $/ $% $> $< $= $# $, $; $( $) )]
  45489.         ifFalse: [legalSymbols := #($+ $- $* $/  $% $: $!! $? $, )].
  45490.     components := OrderedCollection new.
  45491.     set := Incrementer new.
  45492.     set startWith: aString.
  45493.     currentLeft := 1.
  45494.     aString size = 0
  45495.         ifTrue: [errors := true]
  45496.         ifFalse: 
  45497.             [letter := set currentLetter.
  45498.             [letter = $@ | errors]
  45499.                 whileFalse: 
  45500.                     [letter isDigit
  45501.                         ifTrue: [[letter ~= $@ & letter isDigit]
  45502.                                 whileTrue: [letter := set nextLetter]]
  45503.                         ifFalse: [letter isAlphaNumeric | (letter = $_)
  45504.                                 ifTrue: [[letter ~= $@ & (letter isAlphaNumeric | (letter = $_))]
  45505.                                         whileTrue: [letter := set nextLetter]]
  45506.                                 ifFalse: [letter isSeparator
  45507.                                         ifTrue: [[letter ~= $@ & letter isSeparator]
  45508.                                                 whileTrue: [letter := set nextLetter]]
  45509.                                         ifFalse: [(legalSymbols includes: letter)
  45510.                                                 ifTrue: [letter := set nextLetter]
  45511.                                                 ifFalse: [errors := true]]]].
  45512.                     position := set currentPosition.
  45513.                     (aString at: currentLeft) isSeparator | errors ifFalse: [components add: (aString copyFrom: currentLeft to: position - 1)].
  45514.                     currentLeft := position]].
  45515.     errors
  45516.         ifTrue: [^nil]
  45517.         ifFalse: [^components]! !
  45518.  
  45519. !ParseTree class methodsFor: 'construction'!
  45520. orderIntoTree: components from: currentTTM 
  45521.     "Given a set of components that have just been 
  45522.     
  45523.     fissioned, we put them into a parse tree. Expressions 
  45524.     
  45525.     and statements are bound into ordered collections 
  45526.     
  45527.     called 'atoms'. Returns nil if there was an error. Else 
  45528.     
  45529.     it returns the parse tree."
  45530.  
  45531.     | currentStatement parseTree error set current |
  45532.     error := nil.
  45533.     parseTree := ParseTree new.
  45534.     parseTree initializeWith: currentTTM.
  45535.     set := Incrementer new.
  45536.     set startWith: components.
  45537.     current := set currentLetter.
  45538.     [current ~= $@ & (error = nil)]
  45539.         whileTrue: 
  45540.             [(parseTree isNotAtom: current)
  45541.                 ifFalse: 
  45542.                     [currentStatement := OrderedCollection new.
  45543.                     [current = $@ | (parseTree isNotAtom: current)]
  45544.                         whileFalse: 
  45545.                             [currentStatement add: current.
  45546.                             current := set nextLetter].
  45547.                     parseTree atom: currentStatement.
  45548.                     "error := parseTree error"].
  45549.             current ~= $@ & (error = nil)
  45550.                 ifTrue: 
  45551.                     [currentStatement := OrderedCollection new.
  45552.                     currentStatement add: current.
  45553.                     parseTree chooseEventFor: currentStatement.
  45554.                     "error := parseTree error."
  45555.                     current := set nextLetter]].
  45556.     error = nil
  45557.         ifTrue: [^parseTree]
  45558.         ifFalse: [^nil]! !
  45559.  
  45560. !ParseTree class methodsFor: 'construction'!
  45561. orderIntoTreeOld: components from: currentTTM 
  45562.     "Given a set of components that have just been 
  45563.     
  45564.     fissioned, we put them into a parse tree. Expressions 
  45565.     
  45566.     and statements are bound into ordered collections 
  45567.     
  45568.     called 'atoms'. Returns nil if there was an error. Else 
  45569.     
  45570.     it returns the parse tree."
  45571.  
  45572.     | currentStatement parseTree error set current |
  45573.     error := nil.
  45574.     parseTree := ParseTree new.
  45575.     parseTree initializeWith: currentTTM.
  45576.     set := Incrementer new.
  45577.     set startWith: components.
  45578.     current := set currentLetter.
  45579.     [current ~= $@ & (error = nil)]
  45580.         whileTrue: 
  45581.             [(parseTree isNotAtom: current)
  45582.                 ifFalse: 
  45583.                     [currentStatement := OrderedCollection new.
  45584.                     [current = $@ | (parseTree isNotAtom: current)]
  45585.                         whileFalse: 
  45586.                             [currentStatement add: current.
  45587.                             current := set nextLetter].
  45588.                     parseTree atom: currentStatement.
  45589.                     error := parseTree error].
  45590.             current ~= $@ & (error = nil)
  45591.                 ifTrue: 
  45592.                     [currentStatement := OrderedCollection new.
  45593.                     currentStatement add: current.
  45594.                     parseTree chooseEventFor: currentStatement.
  45595.                     error := parseTree error.
  45596.                     current := set nextLetter]].
  45597.     error = nil
  45598.         ifTrue: [^parseTree]
  45599.         ifFalse: [^nil]! !
  45600.  
  45601. SequenceableCollection subclass: #ActivityTree
  45602.     instanceVariableNames: 'root parent '
  45603.     classVariableNames: ''
  45604.     poolDictionaries: ''
  45605.     category: 'Build'!
  45606.  
  45607. !ActivityTree methodsFor: 'testing'!
  45608. ancestorOf: lower onLevelOf: upper 
  45609.     | ancestorList count found |
  45610.     ancestorList := self ancestorListOf: lower.
  45611.     count := ancestorList size.
  45612.     found := false.
  45613.     [count > 0 & (found = false)]
  45614.         whileTrue: 
  45615.             [found := self is: upper aBrotherOf: (ancestorList at: count).
  45616.             found = false ifTrue: [count := count - 1]].
  45617.     found = true ifTrue: [^ancestorList at: count].
  45618.     ^nil! !
  45619.  
  45620. !ActivityTree methodsFor: 'testing'!
  45621. is: activity1 above: activity2 
  45622.  
  45623.      ^(self ancestorListOf: activity1) size < (self
  45624.  
  45625. ancestorListOf: activity2) size! !
  45626.  
  45627. !ActivityTree methodsFor: 'testing'!
  45628. is: activity1 aBrotherOf: activity2 
  45629.     | sibling |
  45630.     activity1 = activity2 ifTrue: [^true].
  45631.     sibling := (self parentOf: activity1) left.
  45632.     [sibling notNil]
  45633.         whileTrue: 
  45634.             [sibling = activity2 ifTrue: [^true].
  45635.             sibling := sibling right].
  45636.     ^false! !
  45637.  
  45638. !ActivityTree methodsFor: 'testing'!
  45639. is: aPossibleParent anAncestorOf: anActivity 
  45640.  
  45641.      (self isRoot: anActivity)
  45642.  
  45643.           ifTrue: [^false]
  45644.  
  45645.           ifFalse: [^(self ancestorListOf: anActivity)
  45646.  
  45647.                     includes: aPossibleParent]! !
  45648.  
  45649. !ActivityTree methodsFor: 'testing'!
  45650. is: activity1 concurrentWith: activity2 
  45651.     "Return true if the two activities run 
  45652.     
  45653.     concurrently with each other."
  45654.  
  45655.     | ancestorsOf1 ancestorsOf2 count1 currentAncestor1 |
  45656.     ancestorsOf1 := self ancestorListOf: activity1.
  45657.     ancestorsOf1 removeLast.
  45658.     ancestorsOf2 := self ancestorListOf: activity2.
  45659.     ancestorsOf2 removeLast.
  45660.     ancestorsOf1 size = 0 | (ancestorsOf2 size = 0) ifTrue: [^false].
  45661.     count1 := ancestorsOf1 size.
  45662.     [count1 > 0]
  45663.         whileTrue: 
  45664.             [currentAncestor1 := ancestorsOf1 at: count1.
  45665.             (ancestorsOf2 includes: currentAncestor1)
  45666.                 & (currentAncestor1 collectionType ~= #cluster) ifTrue: [^true].
  45667.             (ancestorsOf2 includes: currentAncestor1)
  45668.                 & (currentAncestor1 collectionType = #cluster) ifTrue: [^false].
  45669.             count1 := count1 - 1].
  45670.     ^false! !
  45671.  
  45672. !ActivityTree methodsFor: 'testing'!
  45673. isConcurrentProcess: activity1 
  45674.     "Return true if the activity1 is a concurrent 
  45675.     
  45676.     process; that is, it possibly has cousins 
  45677.     
  45678.     running at the same time as it. Does NOT 
  45679.     
  45680.     look at itself."
  45681.  
  45682.     | ancestorsOf1 count1 currentAncestor1 |
  45683.     ancestorsOf1 := self ancestorListOf: activity1.
  45684.     ancestorsOf1 removeLast.
  45685.     ancestorsOf1 size = 0 ifTrue: [^false].
  45686.     count1 := ancestorsOf1 size.
  45687.     [count1 > 0]
  45688.         whileTrue: 
  45689.             [currentAncestor1 := ancestorsOf1 at: count1.
  45690.             currentAncestor1 collectionType ~= #cluster ifTrue: [^true].
  45691.             count1 := count1 - 1].
  45692.     ^false! !
  45693.  
  45694. !ActivityTree methodsFor: 'testing'!
  45695. isEmpty
  45696.     "Is the tree empty?"
  45697.  
  45698.     ^root isNil! !
  45699.  
  45700. !ActivityTree methodsFor: 'testing'!
  45701. isRoot: candidate
  45702.  
  45703.      "Is the given activity the root?"
  45704.  
  45705.  
  45706.  
  45707.      ^root = candidate! !
  45708.  
  45709. !ActivityTree methodsFor: 'accessing'!
  45710. activityNames
  45711.     ^self listOfActivities collect: [:x | x myName]! !
  45712.  
  45713. !ActivityTree methodsFor: 'accessing'!
  45714. allImmediateChildrenOf: anActivity 
  45715.     | temp sibling |
  45716.     temp := OrderedCollection new.
  45717.     sibling := anActivity left.
  45718.     [sibling notNil]
  45719.         whileTrue: 
  45720.             [temp add: sibling.
  45721.             sibling := sibling right].
  45722.     ^temp! !
  45723.  
  45724. !ActivityTree methodsFor: 'accessing'!
  45725. allSiblingsOf: anActivity 
  45726.     "inclusive"
  45727.  
  45728.     | temp sibling p |
  45729.     temp := OrderedCollection new.
  45730.     p := self parentOf: anActivity.
  45731.     sibling := p left.
  45732.     [sibling notNil]
  45733.         whileTrue: 
  45734.             [temp add: sibling.
  45735.             sibling := sibling right].
  45736.     ^temp! !
  45737.  
  45738. !ActivityTree methodsFor: 'accessing'!
  45739. ancestorListOf: anActivity 
  45740.     | current ancestors temp |
  45741.     current := anActivity.
  45742.     ancestors := OrderedCollection new.
  45743.     [current notNil]
  45744.         whileTrue: 
  45745.             [temp := current.
  45746.             current := self parentOf: temp.
  45747.             current notNil ifTrue: [current collectionType = #cluster ifTrue: [ancestors addFirst: temp]]].
  45748.     ^ancestors! !
  45749.  
  45750. !ActivityTree methodsFor: 'accessing'!
  45751. ancestorListOfsafe: anActivity 
  45752.     | current ancestors |
  45753.     current := anActivity.
  45754.     ancestors := OrderedCollection new.
  45755.     [current notNil]
  45756.         whileTrue: 
  45757.             [ancestors addFirst: current.
  45758.             current := self parentOf: current].
  45759.     ^ancestors! !
  45760.  
  45761. !ActivityTree methodsFor: 'accessing'!
  45762. currentDefaultOf: parentActivity 
  45763.     "Return the current default of the given activity"
  45764.  
  45765.     | default child |
  45766.     default := nil.
  45767.     child := parentActivity left.
  45768.     [child notNil]
  45769.         whileTrue: 
  45770.             [child default = true ifTrue: [default := child].
  45771.             child := child right].
  45772.     ^default! !
  45773.  
  45774. !ActivityTree methodsFor: 'accessing'!
  45775. getRoot
  45776.  
  45777.      self emptyCheck.
  45778.  
  45779.      ^root! !
  45780.  
  45781. !ActivityTree methodsFor: 'accessing'!
  45782. listChildrenOf: aParent 
  45783.     "Return an OrderedCollection of activities 
  45784.     
  45785.     stemming from aParent & incl. aParent"
  45786.  
  45787.     parent := OrderedCollection new.
  45788.     parent add: aParent.
  45789.     aParent left notNil ifTrue: [self listChildrenFrom: aParent left].
  45790.     ^parent! !
  45791.  
  45792. !ActivityTree methodsFor: 'accessing'!
  45793. listOfActivities
  45794.     parent := OrderedCollection new.
  45795.     self copyList: self getRoot.
  45796.     ^parent! !
  45797.  
  45798. !ActivityTree methodsFor: 'accessing'!
  45799. listOnlyChildrenOf: aParent 
  45800.     "Return an OrderedCollection of activities 
  45801.     
  45802.     stemming from aParent & incl. aParent"
  45803.  
  45804.     parent := OrderedCollection new.
  45805.     
  45806.     aParent left notNil ifTrue: [self listChildrenFrom: aParent left].
  45807.     ^parent! !
  45808.  
  45809. !ActivityTree methodsFor: 'accessing'!
  45810. newRoot: myroot 
  45811.  
  45812.      root := myroot! !
  45813.  
  45814. !ActivityTree methodsFor: 'accessing'!
  45815. parentOf: currentElement 
  45816.     | brother |
  45817.     root = nil
  45818.         ifTrue: [^nil]
  45819.         ifFalse: 
  45820.             [parent := nil.
  45821.             currentElement = root
  45822.                 ifTrue: [^nil]
  45823.                 ifFalse: 
  45824.                     [self parentOf: currentElement startingAt: root.
  45825.                     parent right = currentElement
  45826.                         ifTrue: 
  45827.                             [brother := parent.
  45828.                             parent := nil.
  45829.                             self parentOf: brother startingAt: root.
  45830.                             [parent right = brother]
  45831.                                 whileTrue: 
  45832.                                     [brother := parent.
  45833.                                     parent := nil.
  45834.                                     self parentOf: brother startingAt: root].
  45835.                             ^parent]
  45836.                         ifFalse: [^parent]]]! !
  45837.  
  45838. !ActivityTree methodsFor: 'accessing'!
  45839. relateLevelOf: activity1 to: activity2 
  45840.     "Given two activities return level relation 
  45841.     
  45842.     between them; activity 1 is either ABOVE 
  45843.     
  45844.     activity2, BELOW activity2, or SAME as 
  45845.     
  45846.     activity2"
  45847.  
  45848.     | ancestorsOf1 ancestorsOf2 |
  45849.     ancestorsOf1 := self ancestorListOf: activity1.
  45850.     ancestorsOf2 := self ancestorListOf: activity2.
  45851.     ancestorsOf1 size = ancestorsOf2 size ifTrue: [^'SAME'].
  45852.     ancestorsOf1 size < ancestorsOf2 size ifTrue: [^'ABOVE'].
  45853.     ancestorsOf1 size > ancestorsOf2 size ifTrue: [^'BELOW']! !
  45854.  
  45855. !ActivityTree methodsFor: 'accessing'!
  45856. size
  45857.     "Return the size of the tree. If the tree is empty, return      
  45858.     zero, else      
  45859.     get the size using the root as the current Node and the Node      
  45860.     method      
  45861.     called, size."
  45862.  
  45863.     self isEmpty
  45864.         ifTrue: [^0]
  45865.         ifFalse: [^root size]! !
  45866.  
  45867. !ActivityTree methodsFor: 'adding'!
  45868. addChildTo: existingNode 
  45869.     "Make the newNode a child of the existing node. If the 
  45870.     
  45871.     existing node 
  45872.     
  45873.     already has children, we make the new node the rightmost 
  45874.     
  45875.     sibling of the existing children."
  45876.  
  45877.     | child activityName newNode |
  45878.     activityName := DialogView request: 'New activity name?'.
  45879.     activityName isEmpty
  45880.         ifTrue: [^nil]
  45881.         ifFalse: 
  45882.             [newNode := Activity
  45883.                         name: activityName
  45884.                         collectAs: #cluster
  45885.                         left: nil
  45886.                         right: nil.
  45887.             newNode parent: existingNode.
  45888.             child := existingNode left.
  45889.             child isNil
  45890.                 ifTrue: [existingNode left: newNode]
  45891.                 ifFalse: [self addSibling: newNode to: child].
  45892.             ^newNode]! !
  45893.  
  45894. !ActivityTree methodsFor: 'adding'!
  45895. addChildTo: existingNode withName: activityName 
  45896.     "Make the newNode a child of the existing node. If the 
  45897.     
  45898.     existing node 
  45899.     
  45900.     already has children, we make the new node the rightmost 
  45901.     
  45902.     sibling of the existing children."
  45903.  
  45904.     | child newNode |
  45905.     newNode := Activity
  45906.                 name: activityName
  45907.                 collectAs: #cluster
  45908.                 left: nil
  45909.                 right: nil.
  45910.      newNode parent: existingNode.
  45911.     child := existingNode left.
  45912.     child isNil
  45913.         ifTrue: 
  45914.             [newNode default: true.
  45915.             existingNode left: newNode]
  45916.         ifFalse: [self addSibling: newNode to: child].
  45917.     ^newNode! !
  45918.  
  45919. !ActivityTree methodsFor: 'adding'!
  45920. addCreatedNode: newNode to: existingNode 
  45921.     "Make the newNode a child of the existing node. If the 
  45922.     
  45923.     existing node 
  45924.     
  45925.     already has children, we make the new node the rightmost 
  45926.     
  45927.     sibling of the existing children."
  45928.  
  45929.     | child |
  45930.     child := existingNode left.
  45931.     child isNil
  45932.         ifTrue: 
  45933.             [existingNode left: newNode.
  45934.             newNode default: true]
  45935.         ifFalse: [self addSibling: newNode to: child].
  45936.     newNode parent: existingNode.
  45937.     ^newNode! !
  45938.  
  45939. !ActivityTree methodsFor: 'adding'!
  45940. createRoot: ttmname 
  45941.     "The collection is empty, so make the argument, ttmname, 
  45942.     
  45943.     the name of the new root. There are no children and the 
  45944.     
  45945.     collection type (either cluster or parallel) is defaulted 
  45946.     
  45947.     to 
  45948.     
  45949.     cluster."
  45950.  
  45951.     ^root := Activity
  45952.                 name: ttmname
  45953.                 collectAs: #cluster
  45954.                 left: nil
  45955.                 right: nil! !
  45956.  
  45957. !ActivityTree methodsFor: 'removing'!
  45958. removeActivity: target 
  45959.     "Remove the target and all its children and modify pointer 
  45960.     
  45961.     from 
  45962.     
  45963.     father or elder brother."
  45964.  
  45965.     | father elderBrother youngerBrother |
  45966.     self isEmpty ifFalse: [root = target
  45967.             ifTrue: []
  45968.             ifFalse: 
  45969.                 [youngerBrother := target right.
  45970.                 father := self parentOf: target.
  45971.                 elderBrother := father elderBrotherOf: target.
  45972.                 elderBrother = nil
  45973.                     ifTrue: [father left: youngerBrother]
  45974.                     ifFalse: [elderBrother right: youngerBrother]]]! !
  45975.  
  45976. !ActivityTree methodsFor: 'copying'!
  45977. buildTree: anActivity 
  45978.     | newActivity |
  45979.     newActivity := anActivity makeCopy.
  45980.     anActivity right notNil ifTrue: [newActivity right: (self buildTree: anActivity right)].
  45981.     anActivity left notNil ifTrue: [newActivity left: (self buildTree: anActivity left)].
  45982.     ^newActivity! !
  45983.  
  45984. !ActivityTree methodsFor: 'copying'!
  45985. makeCopy
  45986.     root notNil
  45987.         ifTrue: [^self buildTree: root]
  45988.         ifFalse: [^nil]! !
  45989.  
  45990. !ActivityTree methodsFor: 'private'!
  45991. addSibling: newNode to: existingNode 
  45992.     "Make the newNode the rightmost sibling of the existing 
  45993.     
  45994.     node."
  45995.  
  45996.     existingNode lastSibling: newNode.
  45997.     ^newNode! !
  45998.  
  45999. !ActivityTree methodsFor: 'private'!
  46000. copyList: start 
  46001.     start left ~= nil ifTrue: [self copyList: start left].
  46002.     start right ~= nil ifTrue: [self copyList: start right].
  46003.     parent add: start! !
  46004.  
  46005. !ActivityTree methodsFor: 'private'!
  46006. listChildrenFrom: start 
  46007.     start left ~= nil ifTrue: [self listChildrenFrom: start left].
  46008.     start right ~= nil ifTrue: [self listChildrenFrom: start right].
  46009.     parent add: start! !
  46010.  
  46011. !ActivityTree methodsFor: 'private'!
  46012. parentOf: target startingAt: start 
  46013.     "A recursive search called by method 'parentOf:'. 
  46014.     
  46015.     Once the parent is found; i.e. no longer = nil, the 
  46016.     
  46017.     search is ended as quickly as possible."
  46018.  
  46019.     start left ~= nil & parent isNil
  46020.         ifTrue: [self parentOf: target startingAt: start left]
  46021.         ifFalse: [].
  46022.     parent isNil
  46023.         ifTrue: [start left = target | (start right = target)
  46024.                 ifTrue: [parent := start]
  46025.                 ifFalse: []]
  46026.         ifFalse: [].
  46027.     start right ~= nil & parent isNil
  46028.         ifTrue: [self parentOf: target startingAt: start right]
  46029.         ifFalse: []! !
  46030.  
  46031. Model subclass: #QueryWindow
  46032.     instanceVariableNames: 'currentTTM table tableEntry tabs myCondition myTrList conditionList '
  46033.     classVariableNames: ''
  46034.     poolDictionaries: ''
  46035.     category: 'Build'!
  46036.  
  46037. !QueryWindow methodsFor: 'table access'!
  46038. addEntry
  46039.  
  46040.     table add: tableEntry! !
  46041.  
  46042. !QueryWindow methodsFor: 'table access'!
  46043. atTab: tabNumber put: aString 
  46044.  
  46045.     "At the supplied tab position insert aString into 
  46046.  
  46047.     the tableEntry."
  46048.  
  46049.  
  46050.  
  46051.     | start length allowedLength newString |
  46052.  
  46053.     start := tabs at: tabNumber.
  46054.  
  46055.     length := aString size.
  46056.  
  46057.     allowedLength := (tabs at: tabNumber + 1)
  46058.  
  46059.                 - (start + 1).
  46060.  
  46061.     length > allowedLength
  46062.  
  46063.         ifTrue: 
  46064.  
  46065.             [newString := aString copyFrom: 1 to: allowedLength.
  46066.  
  46067.             tableEntry
  46068.  
  46069.                 replaceFrom: start
  46070.  
  46071.                 to: start + allowedLength - 1
  46072.  
  46073.                 with: newString]
  46074.  
  46075.         ifFalse: [tableEntry
  46076.  
  46077.                 replaceFrom: start
  46078.  
  46079.                 to: start + length - 1
  46080.  
  46081.                 with: aString]! !
  46082.  
  46083. !QueryWindow methodsFor: 'table access'!
  46084. tableList
  46085.  
  46086.     "Return a list of the transition entries."
  46087.  
  46088.  
  46089.  
  46090.     ^table collect: [:currentEntry | currentEntry]! !
  46091.  
  46092. !QueryWindow methodsFor: 'initialize-release'!
  46093. initializeEntry
  46094.     tableEntry := ''.
  46095.     80 timesRepeat: [tableEntry := tableEntry , ' ']! !
  46096.  
  46097. !QueryWindow methodsFor: 'initialize-release'!
  46098. initializeTrList
  46099.  
  46100.     ^currentTTM transitionlist collect: [:item | item]! !
  46101.  
  46102. !QueryWindow methodsFor: 'initialize-release'!
  46103. initializeTTM: instanceOfTTM 
  46104.     "Prepare the TTM for displaying by initializing the 
  46105.     
  46106.     variables."
  46107.  
  46108.     currentTTM := instanceOfTTM.
  46109.     myCondition := String new.
  46110.     conditionList := OrderedCollection new.
  46111.     myTrList := self initializeTrList.
  46112.     table := OrderedCollection new.
  46113.     tabs := OrderedCollection new.
  46114.     tabs add: 1; add: 14; add: 39; add: 64; add: 72; add: 82.
  46115.     self initializeEntry.
  46116.     self processTransitions! !
  46117.  
  46118. !QueryWindow methodsFor: 'processing'!
  46119. breakdown: aGuard atTab: tabNumber 
  46120.  
  46121.     "We return a table of lines of the prescribed length."
  46122.  
  46123.  
  46124.  
  46125.     | guard prescribedLines allowedLength segment |
  46126.  
  46127.     guard := aGuard.
  46128.  
  46129.     prescribedLines := OrderedCollection new.
  46130.  
  46131.     allowedLength := (tabs at: tabNumber + 1)
  46132.  
  46133.                 - (tabs at: tabNumber) - 2.
  46134.  
  46135.     [guard size > allowedLength]
  46136.  
  46137.         whileTrue: 
  46138.  
  46139.             [segment := guard copyFrom: 1 to: allowedLength.
  46140.  
  46141.             prescribedLines add: segment.
  46142.  
  46143.             guard := guard copyFrom: allowedLength + 1 to: guard size].
  46144.  
  46145.     prescribedLines add: guard.
  46146.  
  46147.     ^prescribedLines! !
  46148.  
  46149. !QueryWindow methodsFor: 'processing'!
  46150. processTransitions
  46151.     | guard transformation guardLines functionLines extraLines name lower upper aTransitionCollection |
  46152.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  46153.     aTransitionCollection
  46154.         do: 
  46155.             [:x | 
  46156.             self initializeEntry.
  46157.             name := x myName.
  46158.             guard := x myGuard.
  46159.             transformation := x myAction.
  46160.             lower := x boundLower.
  46161.             upper := x boundUpper.
  46162.             self atTab: 1 put: name.
  46163.             guardLines := self breakdown: guard atTab: 2.
  46164.             self atTab: 2 put: (guardLines at: 1).
  46165.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  46166.             self atTab: 3 put: (functionLines at: 1).
  46167.             self atTab: 4 put: lower.
  46168.             self atTab: 5 put: upper.
  46169.             self addEntry.
  46170.             extraLines := 2.
  46171.             [extraLines > functionLines size & (extraLines > guardLines size)]
  46172.                 whileFalse: 
  46173.                     [self initializeEntry.
  46174.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  46175.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  46176.                     self addEntry.
  46177.                     extraLines := extraLines + 1]]! !
  46178.  
  46179. !QueryWindow methodsFor: 'processing'!
  46180. processTransitionsNew
  46181.     | guard transformation guardLines functionLines extraLines name lower upper aTransitionCollection |
  46182.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  46183.     aTransitionCollection
  46184.         do: 
  46185.             [:x | 
  46186.             self initializeEntry.
  46187.             name := x myName.
  46188.             guard := x myGuard.
  46189.             transformation := x myAction.
  46190.             lower := x boundLower.
  46191.             upper := x boundUpper.
  46192.             self atTab: 1 put: name.
  46193.             guardLines := self breakdown: guard atTab: 2.
  46194.             self atTab: 2 put: (guardLines at: 1).
  46195.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  46196.             self atTab: 3 put: (functionLines at: 1).
  46197.             self atTab: 4 put: lower.
  46198.             self atTab: 5 put: upper.
  46199.             self addEntry.
  46200.             extraLines := 2.
  46201.             [extraLines > functionLines size & (extraLines > guardLines size)]
  46202.                 whileFalse: 
  46203.                     [self initializeEntry.
  46204.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  46205.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  46206.                     self addEntry.
  46207.                     extraLines := extraLines + 1]]! !
  46208.  
  46209. !QueryWindow methodsFor: 'processing'!
  46210. processTransitionsOld
  46211.     | guard transformation trList guardLines functionLines extraLines shared count set name lower upper |
  46212.     trList := myTrList collect: [:element | element].
  46213.     [trList size > 0]
  46214.         whileTrue: 
  46215.             [shared := currentTTM transitionlist sharedTransitionsNamed: trList first myName.
  46216.             count := 1.
  46217.             [count > shared size]
  46218.                 whileFalse: 
  46219.                     [trList remove: (shared at: count)
  46220.                         ifAbsent: [].
  46221.                     count := count + 1].
  46222.             self initializeEntry.
  46223.             set := currentTTM processSharedTransitions: shared.
  46224.             name := set at: 1.
  46225.             guard := set at: 2.
  46226.             transformation := set at: 3.
  46227.             lower := set at: 4.
  46228.             upper := set at: 5.
  46229.             self atTab: 1 put: name.
  46230.             guardLines := self breakdown: guard atTab: 2.
  46231.             self atTab: 2 put: (guardLines at: 1).
  46232.             functionLines := self breakdown: '[' , transformation , ']' atTab: 3.
  46233.             self atTab: 3 put: (functionLines at: 1).
  46234.             self atTab: 4 put: lower.
  46235.             self atTab: 5 put: upper.
  46236.             self addEntry.
  46237.             extraLines := 2.
  46238.             [extraLines > functionLines size & (extraLines > guardLines size)]
  46239.                 whileFalse: 
  46240.                     [self initializeEntry.
  46241.                     extraLines > guardLines size ifFalse: [self atTab: 2 put: (guardLines at: extraLines)].
  46242.                     extraLines > functionLines size ifFalse: [self atTab: 3 put: (functionLines at: extraLines)].
  46243.                     self addEntry.
  46244.                     extraLines := extraLines + 1]]! !
  46245.  
  46246. !QueryWindow methodsFor: 'file out'!
  46247. openFileForWrite
  46248.     "Returns the stream in append mode or 
  46249.     
  46250.     returns nil if file could not be opened."
  46251.  
  46252.     | defaultName fileName aStream fullPath |
  46253.     defaultName := currentTTM named asString , '.qry'.
  46254.     fileName := DialogView request: 'file name to write out as?' initialAnswer: defaultName.
  46255.     fileName isEmpty
  46256.         ifTrue: 
  46257.             [TTMList speak: 'No filename given - generation aborted.'.
  46258.             aStream := nil]
  46259.         ifFalse: 
  46260.             [fullPath := (Filename named: currentTTM getDirectory)
  46261.                         constructString: fileName.
  46262.             aStream := (Filename named: fullPath) appendStream].
  46263.     ^aStream! !
  46264.  
  46265. !QueryWindow methodsFor: 'constraints'!
  46266. commandFor: operator with: argument 
  46267.  
  46268.     "We determine if it is a valid operator, o, and a 
  46269.  
  46270.     valid argument. If so, we do the command."
  46271.  
  46272.  
  46273.  
  46274.     | c newList n o |
  46275.  
  46276.     c := nil.
  46277.  
  46278.     o := operator asLowercase.
  46279.  
  46280.     o = 'named' | (o = 'n')
  46281.  
  46282.         ifTrue: 
  46283.  
  46284.             [c := 'named'.
  46285.  
  46286.             newList := self wildcardSearch: myTrList for: argument].
  46287.  
  46288.     o = 'sourcein' | (o = 'si')
  46289.  
  46290.         ifTrue: 
  46291.  
  46292.             [c := 'source within'.
  46293.  
  46294.             newList := self
  46295.  
  46296.                         transitionsOf: myTrList
  46297.  
  46298.                         within: argument
  46299.  
  46300.                         usedAs: #source].
  46301.  
  46302.     o = 'destinationin' | (o = 'destin' | (o = 'di'))
  46303.  
  46304.         ifTrue: 
  46305.  
  46306.             [c := 'destination within'.
  46307.  
  46308.             newList := self
  46309.  
  46310.                         transitionsOf: myTrList
  46311.  
  46312.                         within: argument
  46313.  
  46314.                         usedAs: #destination].
  46315.  
  46316.     o = 'source' | (o = 's')
  46317.  
  46318.         ifTrue: 
  46319.  
  46320.             [c := 'source'.
  46321.  
  46322.             newList := myTrList select: [:transition | transition startingAt myName = argument]].
  46323.  
  46324.     o = 'destination' | (o = 'dest' | (o = 'd'))
  46325.  
  46326.         ifTrue: 
  46327.  
  46328.             [c := 'destination'.
  46329.  
  46330.             newList := myTrList select: [:transition | transition endingAt myName = argument]].
  46331.  
  46332.     o = 'lower' | (o = 'l') ifTrue: [(TTMList aValidNumber: argument)
  46333.  
  46334.             & (argument ~= 'infinity')
  46335.  
  46336.             ifTrue: 
  46337.  
  46338.                 [c := 'lower'.
  46339.  
  46340.                 n := TTMList convertToNumber: argument.
  46341.  
  46342.                 newList := myTrList select: [:transition | (TTMList convertToNumber: transition boundLower asString)
  46343.  
  46344.                                 >= n]]].
  46345.  
  46346.     o = 'upper' | (o = 'u') ifTrue: [(TTMList aValidNumber: argument)
  46347.  
  46348.             ifTrue: 
  46349.  
  46350.                 [c := 'upper'.
  46351.  
  46352.                 argument = 'infinity'
  46353.  
  46354.                     ifTrue: [newList := myTrList]
  46355.  
  46356.                     ifFalse: 
  46357.  
  46358.                         [n := TTMList convertToNumber: argument.
  46359.  
  46360.                         newList := myTrList select: [:transition | transition boundUpper asString ~= 'infinity' & ((TTMList convertToNumber: transition boundUpper asString)
  46361.  
  46362.                                             <= n)]]]].
  46363.  
  46364.     o = 'finite' | (o = 'f')
  46365.  
  46366.         ifTrue: 
  46367.  
  46368.             [c := 'finite upper bounds'.
  46369.  
  46370.             newList := myTrList select: [:transition | transition boundUpper asString ~= 'infinity']].
  46371.  
  46372.     o = 'infinite' | (o = 'i')
  46373.  
  46374.         ifTrue: 
  46375.  
  46376.             [c := 'infinite upper bounds'.
  46377.  
  46378.             newList := myTrList select: [:transition | transition boundUpper asString = 'infinity']].
  46379.  
  46380.     o = 'contains' | (o = 'c')
  46381.  
  46382.         ifTrue: 
  46383.  
  46384.             [c := 'contains'.
  46385.  
  46386.             newList := myTrList select: [:transition | transition containsThis: argument]].
  46387.  
  46388.     c notNil
  46389.  
  46390.         ifTrue: [^newList]
  46391.  
  46392.         ifFalse: [^nil]! !
  46393.  
  46394. !QueryWindow methodsFor: 'constraints'!
  46395. parseConstraint
  46396.     "Remove extraneous characters from constraint, 
  46397.     
  46398.     break it into component predicates, then evaluate 
  46399.     
  46400.     each of the predicates."
  46401.  
  46402.     | pieces candidate current logicalOr newTrList count err currentCommand supplement c |
  46403.     pieces := OrderedCollection new.
  46404.     newTrList := OrderedCollection new.
  46405.     candidate := TTMList removeAllBlanksFrom: myCondition.
  46406.     candidate isEmpty
  46407.         ifFalse: 
  46408.             [current := 1.
  46409.             logicalOr := candidate findString: ';' startingAt: current.
  46410.             [logicalOr ~= 0 & (current > candidate size) not]
  46411.                 whileTrue: 
  46412.                     [pieces add: (candidate copyFrom: current to: logicalOr - 1).
  46413.                     current := logicalOr + 1.
  46414.                     current > candidate size ifFalse: [logicalOr := candidate findString: ';' startingAt: current]].
  46415.             current > candidate size ifFalse: [pieces add: (candidate copyFrom: current to: candidate size)]].
  46416.     count := 1.
  46417.     err := false.
  46418.     pieces size ~= 0
  46419.         ifTrue: 
  46420.             [[count <= pieces size & (err = false)]
  46421.                 whileTrue: 
  46422.                     [currentCommand := pieces at: count.
  46423.                     supplement := self processConstraint: currentCommand.
  46424.                     supplement isNil
  46425.                         ifTrue: [err := true]
  46426.                         ifFalse: 
  46427.                             [c := 1.
  46428.                             [c > supplement size]
  46429.                                 whileFalse: 
  46430.                                     [(newTrList includes: (supplement at: c))
  46431.                                         ifFalse: [newTrList add: (supplement at: c)].
  46432.                                     c := c + 1]].
  46433.                     count := count + 1].
  46434.             err = false
  46435.                 ifTrue: 
  46436.                     [myTrList := newTrList.
  46437.                     conditionList add: candidate.
  46438.                     table := OrderedCollection new.
  46439.                     self processTransitions.
  46440.                     self changed: #tableTransaction]]! !
  46441.  
  46442. !QueryWindow methodsFor: 'constraints'!
  46443. processConstraint: candidate 
  46444.  
  46445.     | err start end operator argument newList |
  46446.  
  46447.     err := false.
  46448.  
  46449.     start := candidate findString: '(' startingAt: 1.
  46450.  
  46451.     end := candidate findString: ')' startingAt: 1.
  46452.  
  46453.     start >= end | (start = 0 | (end = 0 | (end ~= candidate size))) ifTrue: [err := true].
  46454.  
  46455.     err = false
  46456.  
  46457.         ifTrue: 
  46458.  
  46459.             [operator := (candidate copyFrom: 1 to: start - 1) asString.
  46460.  
  46461.             operator = 'finite' | (operator = 'f' | (operator = 'infinite' | (operator = 'i')))
  46462.  
  46463.                 ifTrue: [argument := '']
  46464.  
  46465.                 ifFalse: [end - 1 >= (start + 1)
  46466.  
  46467.                         ifTrue: [argument := (candidate copyFrom: start + 1 to: end - 1) asString]
  46468.  
  46469.                         ifFalse: [err := true]].
  46470.  
  46471.             err = false
  46472.  
  46473.                 ifTrue: 
  46474.  
  46475.                     [newList := self commandFor: operator with: argument.
  46476.  
  46477.                     newList isNil
  46478.  
  46479.                         ifTrue: [err := true]
  46480.  
  46481.                         ifFalse: [^newList]]].
  46482.  
  46483.     err = true
  46484.  
  46485.         ifTrue: 
  46486.  
  46487.             [TTMList speak: 'Syntax error in constraint'.
  46488.  
  46489.             ^nil]! !
  46490.  
  46491. !QueryWindow methodsFor: 'private'!
  46492. setOfActivitiesFrom: activityName 
  46493.  
  46494.      "Return the set of all activities that have an 
  46495.  
  46496.      ancestor activity with the name, activityName."
  46497.  
  46498.  
  46499.  
  46500.      | total count focus c s |
  46501.  
  46502.      total := currentTTM activitytree listOfActivities.
  46503.  
  46504.      focus := OrderedCollection new.
  46505.  
  46506.      count := 1.
  46507.  
  46508.      [count > total size]
  46509.  
  46510.           whileFalse: 
  46511.  
  46512.                [(total at: count) myName = activityName
  46513.  
  46514.                     ifTrue: 
  46515.  
  46516.                          [s := currentTTM activitytree
  46517.  
  46518. listChildrenOf: (total at: count).
  46519.  
  46520.                          c := 1.
  46521.  
  46522.                          [c > s size]
  46523.  
  46524.                               whileFalse: 
  46525.  
  46526.                                    [focus add: (s at: c).
  46527.  
  46528.                                    c := c + 1]].
  46529.  
  46530.                count := count + 1].
  46531.  
  46532.      ^focus! !
  46533.  
  46534. !QueryWindow methodsFor: 'private'!
  46535. transitionsOf: aList within: activity usedAs: directionType 
  46536.  
  46537.     | set newList count node s c |
  46538.  
  46539.     set := self setOfActivitiesFrom: activity.
  46540.  
  46541.     newList := OrderedCollection new.
  46542.  
  46543.     set size ~= 0
  46544.  
  46545.         ifTrue: 
  46546.  
  46547.             [count := 1.
  46548.  
  46549.             [count > set size]
  46550.  
  46551.                 whileFalse: 
  46552.  
  46553.                     [node := set at: count.
  46554.  
  46555.                     directionType = #source ifTrue: [s := aList select: [:transition | transition startingAt = node]].
  46556.  
  46557.                     directionType = #destination ifTrue: [s := aList select: [:transition | transition endingAt = node]].
  46558.  
  46559.                     directionType = #both ifTrue: [s := aList select: [:transition | transition startingAt = node | (transition endingAt = node)]].
  46560.  
  46561.                     c := 1.
  46562.  
  46563.                     [c > s size]
  46564.  
  46565.                         whileFalse: 
  46566.  
  46567.                             [newList isEmpty
  46568.  
  46569.                                 ifTrue: [newList add: (s at: c)]
  46570.  
  46571.                                 ifFalse: [(newList includes: (s at: c))
  46572.  
  46573.                                         ifFalse: [newList add: (s at: c)]].
  46574.  
  46575.                             c := c + 1].
  46576.  
  46577.                     count := count + 1]].
  46578.  
  46579.     newList isEmpty
  46580.  
  46581.         ifTrue: [^nil]
  46582.  
  46583.         ifFalse: [^newList]! !
  46584.  
  46585. !QueryWindow methodsFor: 'private'!
  46586. wildcardSearch: aList for: argument 
  46587.  
  46588.     | newList asterix1 a |
  46589.  
  46590.     newList := OrderedCollection new.
  46591.  
  46592.     asterix1 := argument findString: '*' startingAt: 1.
  46593.  
  46594.     asterix1 = 0
  46595.  
  46596.         ifTrue: [newList := aList select: [:transition | transition myName = argument]]
  46597.  
  46598.         ifFalse: 
  46599.  
  46600.             [argument size = 1 ifTrue: [^aList].
  46601.  
  46602.             asterix1 = 1
  46603.  
  46604.                 ifTrue: 
  46605.  
  46606.                     [a := argument copyFrom: 2 to: argument size.
  46607.  
  46608.                     newList := aList select: [:transition | (transition myName copyFrom: transition myName size - a size + 1 to: transition myName size)
  46609.  
  46610.                                     = a]].
  46611.  
  46612.             asterix1 = argument size
  46613.  
  46614.                 ifTrue: 
  46615.  
  46616.                     [a := argument copyFrom: 1 to: argument size - 1.
  46617.  
  46618.                     newList := aList select: [:transition | (transition myName copyFrom: 1 to: a size)
  46619.  
  46620.                                     = a]]].
  46621.  
  46622.     newList isEmpty
  46623.  
  46624.         ifTrue: [^nil]
  46625.  
  46626.         ifFalse: [^newList]! !
  46627.  
  46628. !QueryWindow methodsFor: 'button access'!
  46629. doAddConstraint
  46630.  
  46631.     | candidate |
  46632.  
  46633.     candidate := DialogView request: 'Type in a constraint on the table:'.
  46634.  
  46635.     candidate isEmpty ifTrue: [^self].
  46636.  
  46637.     myCondition := candidate asString.
  46638.  
  46639.     self parseConstraint! !
  46640.  
  46641. !QueryWindow methodsFor: 'button access'!
  46642. doClearConstraints
  46643.     table := OrderedCollection new.
  46644.     myTrList := self initializeTrList.
  46645.     self processTransitions.
  46646.     conditionList := OrderedCollection new.
  46647.     myCondition := String new.
  46648.     self changed: #cList.
  46649.     self changed: #tableTransaction! !
  46650.  
  46651. !QueryWindow methodsFor: 'button access'!
  46652. doListConstraints
  46653.  
  46654.     conditionList isEmpty ifFalse: [(PopUpMenu labelList: (Array with: conditionList)) startUp]! !
  46655.  
  46656. !QueryWindow methodsFor: 'button access'!
  46657. doOutput
  46658.     | aStream myTable low high ans1 ans3 ans2 c currentIC |
  46659.     aStream := self openFileForWrite.
  46660.     aStream isNil ifTrue: [^nil].
  46661.     ans1 := DialogView confirm: 'Include title and notepad?'.
  46662.     ans1 = true
  46663.         ifTrue: 
  46664.             [currentTTM fileTitle: 'Description of TTM: ' , currentTTM named on: aStream.
  46665.             currentTTM fileNotePadOn: aStream].
  46666.     conditionList isEmpty
  46667.         ifTrue: [ans2 := false]
  46668.         ifFalse: 
  46669.             [ans2 := DialogView confirm: 'Include constraints used?'.
  46670.             ans2 = true
  46671.                 ifTrue: 
  46672.                     [currentTTM fileHeading: 'Constraints used:' on: aStream.
  46673.                     currentTTM fileThis: conditionList on: aStream]].
  46674.     ans3 := DialogView confirm: 'Include additional info?'.
  46675.     ans3 = true | (ans2 = true) ifTrue: [currentTTM fileHeading: 'List Of Transitions:' on: aStream].
  46676.     table := OrderedCollection new.
  46677.     self initializeEntry.
  46678.     self atTab: 1 put: 'Transition:'.
  46679.     self atTab: 2 put: 'Guard:'.
  46680.     self atTab: 3 put: 'Function:'.
  46681.     self atTab: 4 put: 'Lower:'.
  46682.     self atTab: 5 put: 'Upper:'.
  46683.     self addEntry.
  46684.     self initializeEntry.
  46685.     self atTab: 1 put: '-----------'.
  46686.     self atTab: 2 put: '------'.
  46687.     self atTab: 3 put: '---------'.
  46688.     self atTab: 4 put: '------'.
  46689.     self atTab: 5 put: '------'.
  46690.     self addEntry.
  46691.     currentTTM fileThis: table on: aStream.
  46692.     table := OrderedCollection new.
  46693.     self processTransitions.
  46694.     currentTTM fileThis: table on: aStream.
  46695.     ans3 = true
  46696.         ifTrue: 
  46697.             [currentTTM fileHeading: 'Activity Variables:' on: aStream.
  46698.             myTable := currentTTM activityvariable collect: [:existingAV | ' ' , (existingAV at: 1)].
  46699.             currentTTM fileThis: myTable on: aStream.
  46700.             currentTTM fileHeading: 'Data Variables:' on: aStream.
  46701.             low := ' low: '.
  46702.             high := ' high: '.
  46703.             myTable := currentTTM datavariable collect: [:existingDV | ' ' , (existingDV at: 1) , low , (existingDV at: 2) , high , (existingDV at: 3)].
  46704.             currentTTM fileThis: myTable on: aStream.
  46705.             currentTTM fileHeading: 'Communication Channels:' on: aStream.
  46706.             myTable := currentTTM commchannel collect: [:existingCH | ' ' , (existingCH at: 1)].
  46707.             currentTTM fileThis: myTable on: aStream.
  46708.             currentTTM fileHeading: 'Initial Condition:' on: aStream.
  46709.             myTable := OrderedCollection new.
  46710.             c := TTMList removeAllBlanksFrom: currentTTM initialcondition.
  46711.             myTable add: ' ' , c.
  46712.             currentTTM fileThis: myTable on: aStream.
  46713.             currentTTM specificIC size ~= 0
  46714.                 ifTrue: 
  46715.                     [currentTTM fileHeading: 'Specific Initial Conditions:' on: aStream.
  46716.                     c := 1.
  46717.                     [c > currentTTM specificIC size]
  46718.                         whileFalse: 
  46719.                             [myTable := OrderedCollection new.
  46720.                             myTable add: ' Initial Condition # ' , ((currentTTM specificIC at: c)
  46721.                                         at: 1).
  46722.                             currentTTM fileThis: myTable on: aStream.
  46723.                             currentIC := (currentTTM specificIC at: c)
  46724.                                         at: 2.
  46725.                             currentTTM fileThis: (currentIC collect: [:item | ' ' , (item at: 1) , '=' , (item at: 2)])
  46726.                                 on: aStream.
  46727.                             c := c + 1]]].
  46728.                 aStream close! !
  46729.  
  46730. !QueryWindow methodsFor: 'closing'!
  46731. removeDependent: aDependent 
  46732.  
  46733.     currentTTM openWindows at: 3 put: 0.
  46734.  
  46735.     super removeDependent: aDependent! !
  46736.  
  46737. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  46738.  
  46739. QueryWindow class
  46740.     instanceVariableNames: ''!
  46741.  
  46742. !QueryWindow class methodsFor: 'instance creation'!
  46743. newTable: ttm
  46744.  
  46745.  
  46746.  
  46747.    ^super new initializeTTM: ttm! !
  46748.  
  46749. !QueryWindow class methodsFor: 'instance creation'!
  46750. openTable: ttm
  46751.  
  46752.  
  46753.  
  46754.    self openTable: (self newTable: ttm) for: ttm! !
  46755.  
  46756. !QueryWindow class methodsFor: 'instance creation'!
  46757. openTable: aTransitionTable for: ttm 
  46758.     | window container tableView tempString tableLabel left top hsize vsize iButton myWrapper cButton aButton heButton lButton qButton |
  46759.     window := ScheduledWindow new.
  46760.     tableLabel := 'Querying TTM: ' , ttm named.
  46761.     window label: tableLabel.
  46762.     window minimumSize: 600 @ 400.
  46763.     window insideColor: ColorValue white.
  46764.     container := CompositePart new.
  46765.     (container add: ' ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  46766.         insideColor: ColorValue white.
  46767.     tableView := AlteredTableView
  46768.                 on: aTransitionTable
  46769.                 aspect: #tableTransaction
  46770.                 list: #tableList.
  46771.     myWrapper := self wrap: (LookPreferences edgeDecorator on: tableView).
  46772.     container add: myWrapper borderedIn: (0.0 @ 0.05 extent: 1.0 @ 0.9).
  46773.     tempString := ComposedText withText: ' Transition:  Guard:                   Function:                   Lower:     Upper:' style: (TextAttributes styleNamed: #fixed).
  46774.     self labelWrap: (container add: tempString borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05)).
  46775.     left := 0.
  46776.     top := 0.95.
  46777.     hsize := 0.2133.
  46778.     vsize := 0.05.
  46779.     aButton := PushButton named: 'Add A Constraint'.
  46780.     aButton model: ((PluggableAdaptor on: aTransitionTable)
  46781.             getBlock: [:model | false]
  46782.             putBlock: [:model :value | model doAddConstraint]
  46783.             updateBlock: [:model :value :parameter | false]).
  46784.     (container add: aButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  46785.         insideColor: ColorValue white.
  46786.     left := left + hsize.
  46787.     cButton := PushButton named: 'Clear Constraints'.
  46788.     cButton model: ((PluggableAdaptor on: aTransitionTable)
  46789.             getBlock: [:model | false]
  46790.             putBlock: [:model :value | model doClearConstraints]
  46791.             updateBlock: [:model :value :parameter | false]).
  46792.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  46793.         insideColor: ColorValue white.
  46794.     left := left + hsize.
  46795.     lButton := PushButton named: 'List Constraints'.
  46796.     lButton model: ((PluggableAdaptor on: aTransitionTable)
  46797.             getBlock: [:model | false]
  46798.             putBlock: [:model :value | model doListConstraints]
  46799.             updateBlock: [:model :value :parameter | false]).
  46800.     (container add: lButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  46801.         insideColor: ColorValue white.
  46802.     left := left + hsize.
  46803.     iButton := PushButton named: 'File Out'.
  46804.     iButton model: ((PluggableAdaptor on: aTransitionTable)
  46805.             getBlock: [:model | false]
  46806.             putBlock: [:model :value | model doOutput]
  46807.             updateBlock: [:model :value :parameter | false]).
  46808.     (container add: iButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  46809.         insideColor: ColorValue white.
  46810.     left := left + 0.12.
  46811.     qButton := PushButton named: 'Exit'.
  46812.     qButton model: ((PluggableAdaptor on: aTransitionTable)
  46813.             getBlock: [:model | false]
  46814.             putBlock: [:model :value | TTMList closeWindow: 3 in: ttm]
  46815.             updateBlock: [:model :value :parameter | false]).
  46816.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  46817.         insideColor: ColorValue white.
  46818.     left := left + 0.12.
  46819.     heButton := PushButton named: 'Help' asText allBold.
  46820.     heButton model: ((PluggableAdaptor on: aTransitionTable)
  46821.             getBlock: [:model | false]
  46822.             putBlock: [:model :value | HelpScreens openHelp: 'querying']
  46823.             updateBlock: [:model :value :parameter | false]).
  46824.     (container add: heButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + 0.12; bottomFraction: top + vsize))
  46825.         insideColor: ColorValue white.
  46826.     window component: container.
  46827.     window open! !
  46828.  
  46829. !QueryWindow class methodsFor: 'decoration'!
  46830. labelWrap: aLabel 
  46831.  
  46832.      | newLabel |
  46833.  
  46834.      newLabel := aLabel.
  46835.  
  46836.      newLabel insideColor: ColorValue white.
  46837.  
  46838.      newLabel borderColor: ColorValue black.
  46839.  
  46840.      newLabel borderWidth: 1.
  46841.  
  46842.      ^newLabel! !
  46843.  
  46844. !QueryWindow class methodsFor: 'decoration'!
  46845. wrap: aWrapper 
  46846.  
  46847.      | newWrapper |
  46848.  
  46849.      newWrapper := aWrapper.
  46850.  
  46851.      newWrapper noMenuBar.
  46852.  
  46853.      "newWrapper borderColor: ColorValue black."
  46854.  
  46855.      "newWrapper borderWidth: 1."
  46856.  
  46857.      "newWrapper insideColor: ColorValue white."
  46858.  
  46859.      ^newWrapper! !
  46860.  
  46861. SortedCollection variableSubclass: #TransitionList
  46862.     instanceVariableNames: ''
  46863.     classVariableNames: ''
  46864.     poolDictionaries: ''
  46865.     category: 'Build'!
  46866.  
  46867. !TransitionList methodsFor: 'removing'!
  46868. reassessDefaultsForDeletedActivity: anActivity 
  46869.     | av |
  46870.     av := anActivity av at: 1.
  46871.     self
  46872.         do: 
  46873.             [:x | 
  46874.             x defaultDestinationAssignments isNil ifFalse: [(x defaultDestinationAssignments includesKey: av) isNil ifFalse: [x defaultDestinationAssignments: nil]].
  46875.             x defaultSourceAssignments isNil ifFalse: [(x defaultSourceAssignments includesKey: av) isNil ifFalse: [x defaultSourceAssignments: nil]]]! !
  46876.  
  46877. !TransitionList methodsFor: 'removing'!
  46878. remove: aTransition
  46879.  
  46880.      "Remove a Transition from the transition list, self, of a
  46881.  
  46882. TTM."
  46883.  
  46884.  
  46885.  
  46886.      | location |
  46887.  
  46888.      location := (self indexOf: aTransition).
  46889.  
  46890.       self removeAtIndex: location.! !
  46891.  
  46892. !TransitionList methodsFor: 'removing'!
  46893. removeMyTransitions: pointed 
  46894.     "Removes all transitions of the activity, pointed."
  46895.  
  46896.     | deleteList supplement count |
  46897.     deleteList := self TransitionsStartingAt: pointed.
  46898.     supplement := self TransitionsEndingAt: pointed.
  46899.     count := 1.
  46900.     [count > supplement size]
  46901.         whileFalse: 
  46902.             [(deleteList includes: (supplement at: count))
  46903.                 ifFalse: [self remove: (supplement at: count)].
  46904.             count := count + 1].
  46905.     count := 1.
  46906.     [count > deleteList size]
  46907.         whileFalse: 
  46908.             [self remove: (deleteList at: count).
  46909.             count := count + 1]! !
  46910.  
  46911. !TransitionList methodsFor: 'removing'!
  46912. removeSubtreeTrsFrom: start 
  46913.  
  46914.     "Remove all transitions from the activity subtree starting 
  46915.  
  46916.     at and including start."
  46917.  
  46918.  
  46919.  
  46920.     start left ~= nil ifTrue: [self removeSubtreeTrsFrom: start left].
  46921.  
  46922.     start right ~= nil ifTrue: [self removeSubtreeTrsFrom: start right].
  46923.  
  46924.     self removeMyTransitions: start! !
  46925.  
  46926. !TransitionList methodsFor: 'accessing'!
  46927. sharedTransitionsNamed: anActivityName 
  46928.     "Returns the set of SHARED transitions (incl. branches 
  46929.  
  46930.  of the same 
  46931.     transition) of the given name. Note that
  46932.  
  46933.  if you remove the last line and 
  46934.     the two double quotes
  46935.  
  46936.  below, this routine will only return non-branch 
  46937.     shared
  46938.  
  46939.  transitions."
  46940.  
  46941.     | sameNames |
  46942.     sameNames := self TransitionsNamed: anActivityName.
  46943.     ^sameNames"set := OrderedCollection new.
  46944.  
  46945.  existingSources := OrderedCollection 
  46946.     new.
  46947.  
  46948.  count := 1.
  46949.  
  46950.  [count > sameNames size]
  46951.  
  46952.  whileFalse: 
  46953.  
  46954.  
  46955.     [current := sameNames at: count.
  46956.  
  46957.  existingSources size ~= 0
  46958.  
  46959.  ifTrue: 
  46960.     [(existingSources includes: current
  46961.  
  46962. startingAt)
  46963.  
  46964.  ifFalse: 
  46965.  
  46966.  
  46967.     [existingSources add: current
  46968.  
  46969. startingAt.
  46970.  
  46971.  set add: current]]
  46972.  
  46973.  
  46974.     ifFalse: 
  46975.  
  46976.  [existingSources add: current
  46977.  
  46978. startingAt.
  46979.  
  46980.  set add: 
  46981.     current].
  46982.  
  46983.  count := count + 1].
  46984.  
  46985.  ^set"! !
  46986.  
  46987. !TransitionList methodsFor: 'accessing'!
  46988. TransitionsEndingAt: anActivity
  46989.  
  46990.      "Return the set of Transitions with anActivity as the ending
  46991.  
  46992. activity"
  46993.  
  46994.  
  46995.  
  46996.       ^self select: [:transition | (transition endingAt) =
  46997.  
  46998. anActivity].! !
  46999.  
  47000. !TransitionList methodsFor: 'accessing'!
  47001. TransitionsNamed: anActivityName 
  47002.     "Return the set of Transitions with anActivityName as the
  47003.  
  47004. name."
  47005.  
  47006.     ^self select: [:transition | transition myName = anActivityName]! !
  47007.  
  47008. !TransitionList methodsFor: 'accessing'!
  47009. TransitionsStartingAt: anActivity
  47010.  
  47011.      "Return the set of Transitions with anActivity as the
  47012.  
  47013. starting activity"
  47014.  
  47015.  
  47016.  
  47017.       ^self select: [:transition | (transition startingAt) =
  47018.  
  47019. anActivity].! !
  47020.  
  47021. !TransitionList methodsFor: 'adding'!
  47022. addTransitionFrom: activity1 to: activity2 withName: transitionName 
  47023.     "Create a new transition"
  47024.  
  47025.     | lowerBound upperBound guard action element |
  47026.     lowerBound := '0'.
  47027.     upperBound := 'infinity'.
  47028.     guard := 'nil'.
  47029.     action := 'nil'.
  47030.     element := Transition
  47031.                 name: transitionName
  47032.                 startAt: activity1
  47033.                 endAt: activity2
  47034.                 upper: upperBound
  47035.                 lower: lowerBound
  47036.                 guard: guard
  47037.                 action: action.
  47038.     self add: element.
  47039.     ^element! !
  47040.  
  47041. !TransitionList methodsFor: 'initialization'!
  47042. initialize
  47043.  
  47044.      self sortBlock: [:a :b | a myName <= b myName]! !
  47045.  
  47046. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  47047.  
  47048. TransitionList class
  47049.     instanceVariableNames: ''!
  47050.  
  47051. !TransitionList class methodsFor: 'instance creation'!
  47052. new
  47053.     ^super new initialize! !
  47054.  
  47055. Object subclass: #Activity
  47056.     instanceVariableNames: 'activityName type default av selfAV leftNode rightNode box exposedAncestor exposed parent graphicsInfo parentBox hasSubstructure avFlag '
  47057.     classVariableNames: ''
  47058.     poolDictionaries: ''
  47059.     category: 'Build'!
  47060.  
  47061. !Activity methodsFor: 'update'!
  47062. updateStatus
  47063.     rightNode notNil
  47064.         ifTrue: [hasSubstructure := true]
  47065.         ifFalse: [hasSubstructure := false]! !
  47066.  
  47067. !Activity methodsFor: 'accessing'!
  47068. av
  47069.  
  47070.      ^av! !
  47071.  
  47072. !Activity methodsFor: 'accessing'!
  47073. av: newAv
  47074.  
  47075.      av := newAv! !
  47076.  
  47077. !Activity methodsFor: 'accessing'!
  47078. avFlag: aBoolean 
  47079.     avFlag := aBoolean! !
  47080.  
  47081. !Activity methodsFor: 'accessing'!
  47082. collectionType
  47083.     "return the collection type for the immediate children of 
  47084.     
  47085.     the current Activity"
  47086.  
  47087.     ^type! !
  47088.  
  47089. !Activity methodsFor: 'accessing'!
  47090. collectionType: newType
  47091.  
  47092.      "Assign the collection type for the immediate children of
  47093.  
  47094. the current Activity"
  47095.  
  47096.  
  47097.  
  47098.      type := newType.! !
  47099.  
  47100. !Activity methodsFor: 'accessing'!
  47101. default
  47102.     ^default! !
  47103.  
  47104. !Activity methodsFor: 'accessing'!
  47105. default: newDefault
  47106.  
  47107.      default := newDefault! !
  47108.  
  47109. !Activity methodsFor: 'accessing'!
  47110. elderBrotherOf: target 
  47111.  
  47112.      "self is the father of target. Return the immediate 
  47113.  
  47114.      elder brother of target."
  47115.  
  47116.  
  47117.  
  47118.      | father brother |
  47119.  
  47120.      father := self.
  47121.  
  47122.      father left = target
  47123.  
  47124.           ifTrue: [^nil]
  47125.  
  47126.           ifFalse: 
  47127.  
  47128.                [brother := father left.
  47129.  
  47130.                [brother right = target] whileFalse: [brother :=
  47131.  
  47132. brother right].
  47133.  
  47134.                ^brother]! !
  47135.  
  47136. !Activity methodsFor: 'accessing'!
  47137. exposed
  47138.  
  47139.      ^exposed! !
  47140.  
  47141. !Activity methodsFor: 'accessing'!
  47142. exposed: aBoolean 
  47143.  
  47144.      exposed := aBoolean! !
  47145.  
  47146. !Activity methodsFor: 'accessing'!
  47147. exposedAncestor
  47148.  
  47149.      ^exposedAncestor! !
  47150.  
  47151. !Activity methodsFor: 'accessing'!
  47152. exposedAncestor: anActivity 
  47153.  
  47154.      exposedAncestor := anActivity! !
  47155.  
  47156. !Activity methodsFor: 'accessing'!
  47157. graphicsInfo
  47158.  
  47159.      ^graphicsInfo! !
  47160.  
  47161. !Activity methodsFor: 'accessing'!
  47162. graphicsInfo: info 
  47163.  
  47164.      graphicsInfo := info! !
  47165.  
  47166. !Activity methodsFor: 'accessing'!
  47167. hasAV
  47168.     ^avFlag! !
  47169.  
  47170. !Activity methodsFor: 'accessing'!
  47171. hasAV: aBoolean 
  47172.     avFlag := aBoolean! !
  47173.  
  47174. !Activity methodsFor: 'accessing'!
  47175. hasSubstructure
  47176.     ^hasSubstructure! !
  47177.  
  47178. !Activity methodsFor: 'accessing'!
  47179. lastSibling
  47180.     "Return the rightmost sibling of the current Node. If there 
  47181.     
  47182.     is none 
  47183.     
  47184.     then it returns the current node."
  47185.  
  47186.     | lastBrother |
  47187.     lastBrother := self.
  47188.     [lastBrother right isNil]
  47189.         whileFalse: [lastBrother := lastBrother right].
  47190.     ^lastBrother! !
  47191.  
  47192. !Activity methodsFor: 'accessing'!
  47193. lastSibling: newNode
  47194.  
  47195.      "Assign newNode as the rightmost sibling of the current
  47196.  
  47197. Node, self." 
  47198.  
  47199.        
  47200.  
  47201.  
  47202.  
  47203.      | lastBrother |
  47204.  
  47205.      lastBrother := self lastSibling.
  47206.  
  47207.      lastBrother right: newNode.! !
  47208.  
  47209. !Activity methodsFor: 'accessing'!
  47210. left
  47211.  
  47212.      "return the left child of the current Activity"
  47213.  
  47214.  
  47215.  
  47216.      ^leftNode! !
  47217.  
  47218. !Activity methodsFor: 'accessing'!
  47219. left: aNode 
  47220.  
  47221.      "Assign aNode as the left child of the current Activity."
  47222.  
  47223.  
  47224.  
  47225.      leftNode := aNode! !
  47226.  
  47227. !Activity methodsFor: 'accessing'!
  47228. myBox
  47229.  
  47230.      ^box! !
  47231.  
  47232. !Activity methodsFor: 'accessing'!
  47233. myBox: newBox
  47234.  
  47235.      box := newBox! !
  47236.  
  47237. !Activity methodsFor: 'accessing'!
  47238. myName
  47239.  
  47240.      "Return the name of the current Activity."
  47241.  
  47242.  
  47243.  
  47244.      ^activityName! !
  47245.  
  47246. !Activity methodsFor: 'accessing'!
  47247. myName: givenName
  47248.  
  47249.      "Assign the given name to the current Activity."
  47250.  
  47251.  
  47252.  
  47253.      activityName := givenName.! !
  47254.  
  47255. !Activity methodsFor: 'accessing'!
  47256. parent
  47257.     ^parent! !
  47258.  
  47259. !Activity methodsFor: 'accessing'!
  47260. parent: anActivity 
  47261.     parent := anActivity! !
  47262.  
  47263. !Activity methodsFor: 'accessing'!
  47264. parentBox
  47265.  
  47266.      ^parentBox! !
  47267.  
  47268. !Activity methodsFor: 'accessing'!
  47269. parentBox: aBox
  47270.  
  47271.      parentBox := aBox! !
  47272.  
  47273. !Activity methodsFor: 'accessing'!
  47274. right
  47275.  
  47276.      "Return the next right sibling of the current Activity."
  47277.  
  47278.  
  47279.  
  47280.      ^rightNode! !
  47281.  
  47282. !Activity methodsFor: 'accessing'!
  47283. right: aNode 
  47284.  
  47285.      "Assign aNode as the next right sibling of the current
  47286.  
  47287. Activity."
  47288.  
  47289.  
  47290.  
  47291.      rightNode := aNode! !
  47292.  
  47293. !Activity methodsFor: 'accessing'!
  47294. selfAV
  47295.  
  47296.      ^selfAV! !
  47297.  
  47298. !Activity methodsFor: 'accessing'!
  47299. selfAV: temp
  47300.  
  47301.      selfAV := temp! !
  47302.  
  47303. !Activity methodsFor: 'accessing'!
  47304. size
  47305.  
  47306.      "Return the size of the subtree starting at the current
  47307.  
  47308. Node."
  47309.  
  47310.  
  47311.  
  47312.      ^1 + (leftNode isNil
  47313.  
  47314.                ifTrue: [0]
  47315.  
  47316.                ifFalse: [leftNode size]) + (rightNode isNil
  47317.  
  47318.                ifTrue: [0]
  47319.  
  47320.                ifFalse: [rightNode size])! !
  47321.  
  47322. !Activity methodsFor: 'copying'!
  47323. makeCopy
  47324.     | temp |
  47325.     temp := self copy.
  47326.     temp selfAV: self selfAV copy.
  47327.     self myBox notNil ifTrue: [temp myBox: self myBox makeCopy].
  47328.     ^temp! !
  47329.  
  47330. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  47331.  
  47332. Activity class
  47333.     instanceVariableNames: ''!
  47334.  
  47335. !Activity class methodsFor: 'instance creation'!
  47336. name: givenName collectAs: newType left: lNode right: rNode 
  47337.     "Create an instance of an activity. It has a name, a type 
  47338.     
  47339.     (either 
  47340.     
  47341.     #cluster or #parallel) for its immediate children, a left 
  47342.     
  47343.     pointer to 
  47344.     
  47345.     its leftmost child and a right pointer to its next sibling."
  47346.  
  47347.     | newActivity |
  47348.     newActivity := self new.
  47349.     newActivity myName: givenName.
  47350.     newActivity collectionType: newType.
  47351.     newActivity left: lNode.
  47352.     newActivity right: rNode.
  47353.     newActivity myBox: nil.
  47354.     newActivity default: false.
  47355.     newActivity av: nil.
  47356.     newActivity updateStatus.
  47357.     newActivity avFlag: false.
  47358.     newActivity selfAV: (Array with: '' with: '').
  47359.     ^newActivity! !
  47360.  
  47361. View subclass: #EditingView
  47362.     instanceVariableNames: 'aspect exposedActs displayFlag '
  47363.     classVariableNames: ''
  47364.     poolDictionaries: ''
  47365.     category: 'Build'!
  47366.  
  47367. !EditingView methodsFor: 'accessing'!
  47368. aspect: aSymbol 
  47369.     "Register the message that is to be used for accessing the model's 
  47370.     dictionary of 
  47371.     
  47372.     chartable values."
  47373.  
  47374.     aspect := aSymbol! !
  47375.  
  47376. !EditingView methodsFor: 'accessing'!
  47377. boundary
  47378.     ^Rectangle
  47379.         left: self bounds left + 10
  47380.         right: self bounds right - 10
  47381.         top: self bounds top + 40
  47382.         bottom: self bounds bottom - 10! !
  47383.  
  47384. !EditingView methodsFor: 'accessing'!
  47385. defaultControllerClass
  47386.  
  47387.      ^EditingController! !
  47388.  
  47389. !EditingView methodsFor: 'accessing'!
  47390. displayFlag: aBoolean 
  47391.  
  47392.      displayFlag := aBoolean! !
  47393.  
  47394. !EditingView methodsFor: 'accessing'!
  47395. labelBoundary
  47396.     | labelWidth labelWindow |
  47397.     labelWidth := self boundary top - (self bounds top + 20).
  47398.     labelWindow := Rectangle
  47399.                 left: self boundary left
  47400.                 right: self boundary right
  47401.                 top: self bounds top + 20
  47402.                 bottom: self bounds top + 20 + labelWidth.
  47403.     ^labelWindow! !
  47404.  
  47405. !EditingView methodsFor: 'activity drawing'!
  47406. boxForNewActivity: aLabel at: cursorPosition 
  47407.     | hsize vsize maxRight maxBottom activityDim intersection locationBox child siblingBox |
  47408.     activityDim := self newActivityBox: aLabel.
  47409.     hsize := activityDim right.
  47410.     vsize := activityDim bottom.
  47411.     maxRight := self boundary right.
  47412.     maxBottom := self boundary bottom.
  47413.     cursorPosition x + hsize <= maxRight & (cursorPosition y + vsize <= maxBottom)
  47414.         ifTrue: 
  47415.             [intersection := false.
  47416.             locationBox := activityDim copy moveBy: cursorPosition.
  47417.             child := model mynode left.
  47418.             [child notNil & (intersection = false)]
  47419.                 whileTrue: 
  47420.                     [child myBox notNil
  47421.                         ifTrue: 
  47422.                             [siblingBox := child myBox dimensions copy moveBy: child myBox location.
  47423.                             intersection := locationBox intersects: siblingBox].
  47424.                     child := child right].
  47425.             intersection ifFalse: [^activityDim]].
  47426.     ^nil! !
  47427.  
  47428. !EditingView methodsFor: 'activity drawing'!
  47429. drawActivity: aRectangle at: aPoint withLabel: aLabel isDefault: aBoolean collect: collectionType 
  47430.     | labelPoint newLabel whiteBox newRect |
  47431.     labelPoint := aPoint translatedBy: 3 @ 2.
  47432.     whiteBox := aRectangle copy.
  47433.     whiteBox bottom: 20.
  47434.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; displayRectangle: whiteBox at: aPoint.
  47435.     collectionType = #cluster
  47436.         ifTrue: [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; lineWidth: 1; displayRectangularBorder: aRectangle at: aPoint]
  47437.         ifFalse: 
  47438.             [newRect := aRectangle copy moveBy: aPoint.
  47439.             self dashedLineFrom: newRect topLeft to: newRect topRight.
  47440.             self dashedLineFrom: newRect topRight to: newRect bottomRight.
  47441.             self dashedLineFrom: newRect topLeft to: newRect bottomLeft.
  47442.             self dashedLineFrom: newRect bottomLeft to: newRect bottomRight].
  47443.     aBoolean = true
  47444.         ifTrue: [newLabel := self style: aLabel asText allBold]
  47445.         ifFalse: [newLabel := self style: aLabel asText].
  47446.     (self graphicsContext) clippingRectangle: self boundary; display: newLabel at: labelPoint.
  47447.     ^aRectangle! !
  47448.  
  47449. !EditingView methodsFor: 'activity drawing'!
  47450. newActivityBox: aLabel 
  47451.     | hsize vsize activityDim |
  47452.     hsize := ((aLabel size + 1) * 8) ceiling + 5.
  47453.     vsize := 20.
  47454.     activityDim := Rectangle
  47455.                 left: 0
  47456.                 right: hsize
  47457.                 top: 0
  47458.                 bottom: vsize.
  47459.     ^activityDim! !
  47460.  
  47461. !EditingView methodsFor: 'transition drawing'!
  47462. drawTransitionArcFor: aTransition 
  47463.     | m s e count tr style |
  47464.     count := 1.
  47465.     [count > model ttm transitionlist size]
  47466.         whileFalse: 
  47467.             [tr := model ttm transitionlist at: count.
  47468.             aTransition = tr
  47469.                 ifTrue: 
  47470.                     [(model visibleSourceFor: tr)
  47471.                         ifTrue: 
  47472.                             [style := tr myArc sourceArrow.
  47473.                             s := tr myArc sourceStart.
  47474.                             m := tr myArc sourceMid.
  47475.                             e := tr myArc sourceEnd]
  47476.                         ifFalse: 
  47477.                             [style := tr myArc destArrow.
  47478.                             s := tr myArc destStart.
  47479.                             m := tr myArc destMid.
  47480.                             e := tr myArc destEnd].
  47481.                     self
  47482.                         drawTransitionArcFrom: s
  47483.                         to: e
  47484.                         via: m
  47485.                         inStyle: style.
  47486.                     self labelTransition: aTransition at: m.
  47487.                     ^nil].
  47488.             count := count + 1]! !
  47489.  
  47490. !EditingView methodsFor: 'transition drawing'!
  47491. labelTransition: aTransition at: middle 
  47492.     | msg2 msg3 u msg box m temp defaultSource defaultDest |
  47493.     temp := ''.
  47494.     defaultSource := ''.
  47495.     aTransition defaultSourceAssignments isNil ifFalse: [aTransition defaultSourceAssignments isEmpty ifFalse: [defaultSource := '<']].
  47496.     defaultDest := ''.
  47497.     aTransition defaultDestinationAssignments isNil ifFalse: [aTransition defaultDestinationAssignments isEmpty ifFalse: [defaultDest := '>']].
  47498.     aTransition shared = true ifTrue: [temp := '#'].
  47499.     m := middle copy.
  47500.     msg2 := '(' , aTransition myGuard , ')->'.
  47501.     msg3 := '[' , aTransition myAction , ']'.
  47502.     aTransition boundUpper = 'infinity'
  47503.         ifTrue: [u := '*']
  47504.         ifFalse: [u := aTransition boundUpper].
  47505.     msg := defaultSource , aTransition myName , defaultDest , ' [' , aTransition boundLower , '|' , u , ']' , temp.
  47506.     box := aTransition myArc dimensions copy.
  47507.     box right: (msg size * 7.5) ceiling.
  47508.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47509.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg)
  47510.         at: (m translatedBy: 2 @ 2).
  47511.     aTransition depth = #exposed
  47512.         ifTrue: 
  47513.             [aTransition myGuard = 'nil'
  47514.                 ifFalse: 
  47515.                     [m y: m y + 17.
  47516.                     box right: (msg2 size * 7.5) ceiling.
  47517.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47518.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg2)
  47519.                         at: (m translatedBy: 1 @ 2)].
  47520.             aTransition myAction = 'nil' & (aTransition myGuard = 'nil')
  47521.                 ifFalse: 
  47522.                     [m y: m y + 17.
  47523.                     box right: (msg3 size * 7.5) ceiling.
  47524.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47525.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg3)
  47526.                         at: (m translatedBy: 1 @ 2)]]! !
  47527.  
  47528. !EditingView methodsFor: 'transition drawing'!
  47529. labelTransitionOld: aTransition at: middle 
  47530.     | msg2 msg3 u msg box m temp |
  47531.       temp := ''.
  47532.       aTransition shared = true ifTrue: [ temp := '#'].
  47533.     m := middle copy.
  47534.     msg2 := '(' , aTransition myGuard , ')->'.
  47535.     msg3 := '[' , aTransition myAction , ']'.
  47536.     aTransition boundUpper = 'infinity'
  47537.         ifTrue: [u := '*']
  47538.         ifFalse: [u := aTransition boundUpper].
  47539.     msg := aTransition myName , ' [' , aTransition boundLower , '|' , u , ']',temp.
  47540.     box := aTransition myArc dimensions copy.
  47541.     box right: (msg size * 7.5) ceiling.
  47542.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47543.     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg)
  47544.         at: (m translatedBy: 2 @ 2).
  47545.     aTransition depth = #exposed
  47546.         ifTrue: 
  47547.             [aTransition myGuard = 'nil'
  47548.                 ifFalse: 
  47549.                     [m y: m y + 17.
  47550.                     box right: (msg2 size * 7.5) ceiling.
  47551.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47552.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg2)
  47553.                         at: (m translatedBy: 1 @ 2)].
  47554.             aTransition myAction = 'nil' & (aTransition myGuard = 'nil')
  47555.                 ifFalse: 
  47556.                     [m y: m y + 17.
  47557.                     box right: (msg3 size * 7.5) ceiling.
  47558.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black; displayRectangle: box at: m.
  47559.                     (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue white; display: (self style: msg3)
  47560.                         at: (m translatedBy: 1 @ 2)]]! !
  47561.  
  47562. !EditingView methodsFor: 'displaying'!
  47563. dashedLineFrom: a to: b 
  47564.     "p1 and p2 should either be on same vertical or horizontal line at least 10 
  47565.     
  47566.     pixels apart."
  47567.  
  47568.     | interval current complete next draw p1 p2 |
  47569.     a x > b x | (a y > b y)
  47570.         ifTrue: 
  47571.             [p1 := b.
  47572.             p2 := a]
  47573.         ifFalse: 
  47574.             [p1 := a.
  47575.             p2 := b].
  47576.     interval := 10.
  47577.     draw := true.
  47578.     current := p1 copy.
  47579.     complete := false.
  47580.     [complete = false]
  47581.         whileTrue: 
  47582.             [p1 x < p2 x
  47583.                 ifTrue: 
  47584.                     [next := current x + interval @ current y.
  47585.                     next x > p2 x
  47586.                         ifTrue: 
  47587.                             [next x: p2 x.
  47588.                             complete := true]]
  47589.                 ifFalse: 
  47590.                     [next := current x @ (current y + interval).
  47591.                     next y > p2 y
  47592.                         ifTrue: 
  47593.                             [next y: p2 y.
  47594.                             complete := true]].
  47595.             draw = true
  47596.                 ifTrue: 
  47597.                     [draw := false.
  47598.                     interval := 5.
  47599.                     (self graphicsContext) paint: ColorValue black; lineWidth: 2; displayLineFrom: current to: next]
  47600.                 ifFalse: 
  47601.                     [draw := true.
  47602.                     interval := 10].
  47603.             current := next copy]! !
  47604.  
  47605. !EditingView methodsFor: 'displaying'!
  47606. displayOn2: ignored 
  47607.     "Override the parent's displaying method. Note that this is an 
  47608.     automatic redisplay. When the window has been written over, this 
  47609.     method is called. The view can access the model's methods by using 
  47610.     the prefix 'model' just as with the controller."
  47611.  
  47612.     | child titleText cCount temp theDefault |
  47613.     model isNil ifTrue: [^nil].
  47614.     model myview: self.
  47615.     ignored = #noUpdate ifFalse: [model updateDisplayedActs].
  47616.     (self graphicsContext) paint: ColorValue lightGray; displayRectangle: self boundary.
  47617.     (self graphicsContext) paint: ColorValue white; displayRectangle: self labelBoundary.
  47618.     model mynode hasAV
  47619.         ifTrue: [temp := model mynode selfAV at: 1]
  47620.         ifFalse: [temp := ''].
  47621.     titleText := model mynode myName , ' ( ' , temp , ' )'.
  47622.     self graphicsContext display: titleText at: self boundary left + 5 @ (self labelBoundary top + 17).
  47623.     (self graphicsContext) paint: ColorValue black; lineWidth: 2; displayRectangularBorder: (self boundary copy top: self labelBoundary top).
  47624.     child := model mynode left.
  47625.     cCount := 1.
  47626.     model waitingFor notNil ifTrue: [self pending].
  47627.     [cCount > model displayedActs size]
  47628.         whileFalse: 
  47629.             [child := model displayedActs at: cCount.
  47630.             child myBox isNil
  47631.                 ifFalse: 
  47632.                     [temp := ''.
  47633.                     child left notNil ifTrue: [temp := '@'].
  47634.                     model mynode collectionType = #cluster
  47635.                         ifTrue: [theDefault := child default]
  47636.                         ifFalse: [theDefault := false].
  47637.                     self
  47638.                         drawActivity: child myBox dimensions
  47639.                         at: child myBox location
  47640.                         withLabel: child myName , temp
  47641.                         isDefault: theDefault
  47642.                         collect: model mynode collectionType].
  47643.             cCount := cCount + 1].
  47644.     model ttm markActivitiesUnexposed.
  47645.     self displayAllExposedActivities! !
  47646.  
  47647. !EditingView methodsFor: 'displaying'!
  47648. displayOn: ingnored 
  47649.     displayFlag = True
  47650.         ifTrue: 
  47651.             [displayFlag := False.
  47652.             
  47653.             [(Delay forMilliseconds: 150) wait.
  47654.             self displayOn2: nil.
  47655.             displayFlag := True] fork]! !
  47656.  
  47657. !EditingView methodsFor: 'displaying'!
  47658. pending
  47659.     "Pending message displaying"
  47660.  
  47661.     | wait aBox msg |
  47662.     wait := model waitingFor.
  47663.     aBox := Rectangle
  47664.                 left: self bounds left
  47665.                 right: self bounds right
  47666.                 top: self bounds top
  47667.                 bottom: self labelBoundary top - 1.
  47668.     wait notNil
  47669.         ifTrue: 
  47670.             [(self graphicsContext) paint: ColorValue white; displayRectangle: aBox.
  47671.             wait = #addActivity | (wait = #moveActivity)
  47672.                 ifTrue: [msg := 'to position top left corner of activity']
  47673.                 ifFalse: [wait = #resizeActivity
  47674.                         ifTrue: [msg := 'to mark bottom right corner of activity']
  47675.                         ifFalse: [wait = #addTransition | (wait = #changeDestination)
  47676.                                 ifTrue: [msg := 'to select destination activity']
  47677.                                 ifFalse: [wait = #moveTransition
  47678.                                         ifTrue: [msg := 'to position mid point of transition']
  47679.                                         ifFalse: [wait = #addTransition1
  47680.                                                 ifTrue: [msg := 'to select source activity']
  47681.                                                 ifFalse: [wait = #zoomin
  47682.                                                         ifTrue: [msg := 'to zoom in on an activity']
  47683.                                                         ifFalse: [wait = #setDefault
  47684.                                                                 ifTrue: [msg := 'to select new default activity']
  47685.                                                                 ifFalse: [wait = #inConcurrently | (wait = #inSerially)
  47686.                                                                         ifTrue: [msg := 'to position top left corner of ttm']
  47687.                                                                         ifFalse: [wait = #selfloop | (wait = #changeselfloop)
  47688.                                                                                 ifTrue: [msg := 'to select selfloop midpt']
  47689.                                                                                 ifFalse: []]]]]]]]].
  47690.             msg := '>>Click left mouse button ' , msg , '<<'.
  47691.             msg := msg asText allBold.
  47692.             self graphicsContext display: msg at: aBox left + 3 @ (aBox top + 14)]
  47693.         ifFalse: [(self graphicsContext) paint: ColorValue lightGray; displayRectangle: aBox]! !
  47694.  
  47695. !EditingView methodsFor: 'displaying'!
  47696. style: aText 
  47697.  
  47698.     ^ComposedText withText: aText style: (TextAttributes styleNamed: #fixed)! !
  47699.  
  47700. !EditingView methodsFor: 'displaying'!
  47701. update: aParameter 
  47702.     "If the aspect of the model that this view cares about has changed, 
  47703.     redisplay."
  47704.  
  47705.     aParameter = aspect ifTrue: [self invalidate]! !
  47706.  
  47707. !EditingView methodsFor: 'calculations'!
  47708. borderPointFrom: s through: m 
  47709.     m x > s x
  47710.         ifTrue: [m y > s y
  47711.                 ifTrue: [^self boundary bottomRight]
  47712.                 ifFalse: [^self boundary topRight]]
  47713.         ifFalse: [m y > s y
  47714.                 ifTrue: [^self boundary bottomLeft]
  47715.                 ifFalse: [^self boundary topLeft]]! !
  47716.  
  47717. !EditingView methodsFor: 'calculations'!
  47718. boxPoints: box1 to: box2 
  47719.     "Compute which two points on the two boxes are closest together and 
  47720.     return 
  47721.  
  47722.     them both. The boxes are Box dimensions moved by their 
  47723.     locations."
  47724.  
  47725.     | sideBox2 sideBox1 point1 point2 beginPt endPt |
  47726.     beginPt := 1.
  47727.     endPt := 2.
  47728.     sideBox1 := self findSideOf: box2 facing: box1.
  47729.     sideBox2 := self findSideOf: box1 facing: box2.
  47730.     point1 := box1 center nearestPointOnLineFrom: (sideBox2 at: beginPt)
  47731.                 to: (sideBox2 at: endPt).
  47732.     point2 := box2 center nearestPointOnLineFrom: (sideBox1 at: beginPt)
  47733.                 to: (sideBox1 at: endPt).
  47734.     ^Array with: point1 with: point2! !
  47735.  
  47736. !EditingView methodsFor: 'calculations'!
  47737. boxPoints: box1 to: box2 via: middle 
  47738.     "Compute which two points on the two boxes are closest together and 
  47739.     return 
  47740.  
  47741.     them both."
  47742.  
  47743.     | sideBox2 sideBox1 beginPt endPt point1 point2 |
  47744.     beginPt := 1.
  47745.     endPt := 2.
  47746.     sideBox1 := self findSideOf: box2 face: middle.
  47747.     sideBox2 := self findSideOf: box1 face: middle.
  47748.     point1 := self midPointOf: (sideBox2 at: beginPt)
  47749.                 and: (sideBox2 at: endPt).
  47750.     point2 := self midPointOf: (sideBox1 at: beginPt)
  47751.                 and: (sideBox1 at: endPt).
  47752.     ^Array with: point1 with: point2! !
  47753.  
  47754. !EditingView methodsFor: 'calculations'!
  47755. boxPoints: box1 toPoint: end via: middle 
  47756.     "Compute which two points on the two boxes are closest together and 
  47757.     return 
  47758.     
  47759.     them both."
  47760.  
  47761.     | sideBox2 beginPt endPt point1 point2 |
  47762.     beginPt := 1.
  47763.     endPt := 2.
  47764.     sideBox2 := self findSideOf: box1 face: middle.
  47765.     point1 := self midPointOf: (sideBox2 at: beginPt)
  47766.                 and: (sideBox2 at: endPt).
  47767.     point2 := end copy.
  47768.     ^Array with: point1 with: point2! !
  47769.  
  47770. !EditingView methodsFor: 'calculations'!
  47771. boxPointsPoint: start to: box2 via: middle 
  47772.     "Compute which two points on the two boxes are closest together and 
  47773.     return 
  47774.     
  47775.     them both."
  47776.  
  47777.     | sideBox1 beginPt endPt point1 point2 |
  47778.     beginPt := 1.
  47779.     endPt := 2.
  47780.     sideBox1 := self findSideOf: box2 face: middle.
  47781.     point1 := start copy.
  47782.     point2 := self midPointOf: (sideBox1 at: beginPt)
  47783.                 and: (sideBox1 at: endPt).
  47784.     ^Array with: point1 with: point2! !
  47785.  
  47786. !EditingView methodsFor: 'calculations'!
  47787. findSideOf: box1 face: pt 
  47788.     "Find which side of box1 faces box2. I will try to match the best face of the 
  47789.     box 
  47790.  
  47791.     possible. Return the line representing the facing side."
  47792.  
  47793.     | diag1 diag2 side beginPt endPt |
  47794.     diag1 := OrderedCollection new: 2.
  47795.     diag1 add: 0 @ 0; add: 0 @ 0.
  47796.     diag2 := OrderedCollection new: 2.
  47797.     diag2 add: 0 @ 0; add: 0 @ 0.
  47798.     side := OrderedCollection new: 2.
  47799.     side add: 0 @ 0; add: 0 @ 0.
  47800.     beginPt := 1.
  47801.     endPt := 2.
  47802.     diag1 at: beginPt put: box1 topLeft.
  47803.     diag1 at: endPt put: box1 bottomRight.
  47804.     diag2 at: beginPt put: box1 bottomLeft.
  47805.     diag2 at: endPt put: box1 topRight.
  47806.     (self
  47807.         is: box1 topRight
  47808.         onSameSideAs: pt
  47809.         of: diag1)
  47810.         ifTrue: [side at: beginPt put: box1 topRight]
  47811.         ifFalse: [side at: beginPt put: box1 bottomLeft].
  47812.     (self
  47813.         is: box1 topLeft
  47814.         onSameSideAs: pt
  47815.         of: diag2)
  47816.         ifTrue: [side at: endPt put: box1 topLeft]
  47817.         ifFalse: [side at: endPt put: box1 bottomRight].
  47818.     ^side! !
  47819.  
  47820. !EditingView methodsFor: 'calculations'!
  47821. findSideOf: box1 facing: box2 
  47822.     "Find which side of box1 faces box2. I will try to match the best face of the 
  47823.     box 
  47824.  
  47825.     possible. Return the line representing the facing side. The line 
  47826.     returned is an 
  47827.  
  47828.     OrderedCollection of 2 points."
  47829.  
  47830.     | diag1 diag2 side beginPt endPt |
  47831.     diag1 := OrderedCollection new: 2.
  47832.     diag1 add: 0 @ 0; add: 0 @ 0.
  47833.     diag2 := OrderedCollection new: 2.
  47834.     diag2 add: 0 @ 0; add: 0 @ 0.
  47835.     side := OrderedCollection new: 2.
  47836.     side add: 0 @ 0; add: 0 @ 0.
  47837.     beginPt := 1.
  47838.     endPt := 2.
  47839.     diag1 at: beginPt put: box1 topLeft.
  47840.     diag1 at: endPt put: box1 bottomRight.
  47841.     diag2 at: beginPt put: box1 bottomLeft.
  47842.     diag2 at: endPt put: box1 topRight.
  47843.     (self
  47844.         is: box1 topRight
  47845.         onSameSideAs: box2 bottomLeft
  47846.         of: diag1)
  47847.         ifTrue: [side at: beginPt put: box1 topRight]
  47848.         ifFalse: [side at: beginPt put: box1 bottomLeft].
  47849.     (self
  47850.         is: box1 topLeft
  47851.         onSameSideAs: box2 bottomRight
  47852.         of: diag2)
  47853.         ifTrue: [side at: endPt put: box1 topLeft]
  47854.         ifFalse: [side at: endPt put: box1 bottomRight].
  47855.     ^side! !
  47856.  
  47857. !EditingView methodsFor: 'calculations'!
  47858. is: point1 onSameSideAs: point2 of: aLine 
  47859.     "Answer true if the two points are on the same side of the given line. The 
  47860.     line is 
  47861.  
  47862.     an ordered collection of two points."
  47863.  
  47864.     | dx dy dx1 dx2 dy1 dy2 beginPt endPt |
  47865.     beginPt := 1.
  47866.     endPt := 2.
  47867.     dx := (aLine at: endPt) x - (aLine at: beginPt) x.
  47868.     dy := (aLine at: endPt) y - (aLine at: beginPt) y.
  47869.     dx1 := point1 x - (aLine at: beginPt) x.
  47870.     dy1 := point1 y - (aLine at: beginPt) y.
  47871.     dx2 := point2 x - (aLine at: endPt) x.
  47872.     dy2 := point2 y - (aLine at: endPt) y.
  47873.     dx * dy1 - (dy * dx1) * (dx * dy2 - (dy * dx2)) > 0
  47874.         ifTrue: [^true]
  47875.         ifFalse: [^false]! !
  47876.  
  47877. !EditingView methodsFor: 'calculations'!
  47878. midPointOf: pt1 and: pt2 
  47879.     | midx midy newMidPoint |
  47880.     midx := pt1 x + pt2 x.
  47881.     midx := (midx / 2) truncated.
  47882.     midy := pt1 y + pt2 y.
  47883.     midy := (midy / 2) truncated.
  47884.     newMidPoint := Point x: midx y: midy.
  47885.     ^newMidPoint! !
  47886.  
  47887. !EditingView methodsFor: 'arrow drawing'!
  47888. arrowheadFrom: p2 to: p1 
  47889.     "This routine was supplied by Don Laws."
  47890.     "Compressed & renamed by Tim Field."
  47891.     "h = height, b = base."
  47892.  
  47893.     | b h halfBase x1 y1 x2 y2 x4 x5 y5 y4 m rm cx1 cy1 cx2 cy2 x3 y3 p4 p5 arrow |
  47894.     b := 12.
  47895.     h := 12.
  47896.     halfBase := b / 2.
  47897.     x1 := p1 x.
  47898.     y1 := p1 y.
  47899.     x2 := p2 x.
  47900.     y2 := p2 y.
  47901.     x1 = x2
  47902.         ifTrue: 
  47903.             [x4 := x1 - halfBase.
  47904.             x5 := x1 + halfBase.
  47905.             y1 > y2
  47906.                 ifTrue: [y5 := y1 - h]
  47907.                 ifFalse: [y5 := y1 + h].
  47908.             y4 := y5]
  47909.         ifFalse: [y1 = y2
  47910.                 ifTrue: 
  47911.                     [y4 := y1 - halfBase.
  47912.                     y5 := y1 + halfBase.
  47913.                     x1 > x2
  47914.                         ifTrue: [x5 := x1 - h]
  47915.                         ifFalse: [x5 := x1 + h].
  47916.                     x4 := x5]
  47917.                 ifFalse: 
  47918.                     [m := y1 - y2 / (x1 - x2).
  47919.                     rm := m reciprocal.
  47920.                     cx1 := h * (1 + m squared) reciprocal sqrt.
  47921.                     cy1 := h * (1 + m squared reciprocal) reciprocal sqrt.
  47922.                     cx2 := halfBase * (1 + rm squared) reciprocal sqrt.
  47923.                     cy2 := halfBase * (1 + rm squared reciprocal) reciprocal sqrt.
  47924.                     x1 < x2
  47925.                         ifTrue: [x3 := x1 + cx1]
  47926.                         ifFalse: [x3 := x1 - cx1].
  47927.                     y1 > y2
  47928.                         ifTrue: [y3 := y1 - cy1]
  47929.                         ifFalse: [y3 := y1 + cy1].
  47930.                     x1 < x2
  47931.                         ifTrue: 
  47932.                             [y4 := y3 + cy2.
  47933.                             y5 := y3 - cy2]
  47934.                         ifFalse: 
  47935.                             [y4 := y3 - cy2.
  47936.                             y5 := y3 + cy2].
  47937.                     y1 < y2
  47938.                         ifTrue: 
  47939.                             [x4 := x3 - cx2.
  47940.                             x5 := x3 + cx2]
  47941.                         ifFalse: 
  47942.                             [x4 := x3 + cx2.
  47943.                             x5 := x3 - cx2]]].
  47944.     p4 := Point x: x4 y: y4.
  47945.     p5 := Point x: x5 y: y5.
  47946.     arrow := OrderedCollection new.
  47947.     arrow add: p1.
  47948.     arrow add: p4.
  47949.     arrow add: p5.
  47950.     self graphicsContext displayPolygon: arrow! !
  47951.  
  47952. !EditingView methodsFor: 'arrow drawing'!
  47953. dot: p2 color: mycolor 
  47954.     mycolor = #black
  47955.         ifTrue: [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black;
  47956.                 displayWedgeBoundedBy: (Rectangle
  47957.                         left: 0
  47958.                         right: 10
  47959.                         top: 0
  47960.                         bottom: 10)
  47961.                 startAngle: 0
  47962.                 sweepAngle: 359
  47963.                 at: p2 x - 5 @ (p2 y - 5)]
  47964.         ifFalse: 
  47965.             [(self graphicsContext) clippingRectangle: self boundary; paint: ColorValue black;
  47966.                 displayWedgeBoundedBy: (Rectangle
  47967.                         left: 0
  47968.                         right: 10
  47969.                         top: 0
  47970.                         bottom: 10)
  47971.                 startAngle: 0
  47972.                 sweepAngle: 359
  47973.                 at: p2 x - 5 @ (p2 y - 5).
  47974.             (self graphicsContext) clippingRectangle: self boundary; paint: ColorValue gray;
  47975.                 displayWedgeBoundedBy: (Rectangle
  47976.                         left: 0
  47977.                         right: 8
  47978.                         top: 0
  47979.                         bottom: 8)
  47980.                 startAngle: 0
  47981.                 sweepAngle: 359
  47982.                 at: p2 x - 4 @ (p2 y - 4)]! !
  47983.  
  47984. !EditingView methodsFor: 'arrow drawing'!
  47985. drawTransitionArcFrom: p1 to: p2 via: midPt inStyle: case 
  47986.     "Use a spline to draw on current graphics context"
  47987.     "style case1 = no start dot or end dot. 
  47988.     
  47989.     case2 = no start dot with black disc for end dot. 
  47990.     
  47991.     case3 = white disc for start dot with no end dot. 
  47992.     
  47993.     case4 = white disc for start dot with arrow head end. 
  47994.     
  47995.     case5 = no start dot with arrow head end. 
  47996.     
  47997.     case6 = thinner lineWidth with arrow head end"
  47998.  
  47999.     | aSpline arrowPt |
  48000.     aSpline := Spline2 new.
  48001.     aSpline add: p1.
  48002.     aSpline add: midPt.
  48003.     aSpline add: p2.
  48004.     aSpline computeCurve.
  48005.     case = 6
  48006.         ifTrue: [arrowPt := aSpline displayArcOnContext2: self graphicsContext onView: self]
  48007.         ifFalse: [arrowPt := aSpline displayArcOnContext: self graphicsContext onView: self].
  48008.     case = 1 ifTrue: [^nil].
  48009.     case = 2
  48010.         ifTrue: 
  48011.             [self dot: p2 color: #black.
  48012.             ^nil].
  48013.     case = 3
  48014.         ifTrue: 
  48015.             [self dot: p1 color: #white.
  48016.             ^nil].
  48017.     case = 4 ifTrue: [self dot: p1 color: #white].
  48018.     self arrowheadFrom: arrowPt to: p2! !
  48019.  
  48020. !EditingView methodsFor: 'exposed activities'!
  48021. determineExposedAncestors
  48022.     "Inform every activity of which ancestor closest to itself is exposed"
  48023.  
  48024.     | actPointer temp |
  48025.     actPointer := model ttm activitytree getRoot.
  48026.     [actPointer notNil]
  48027.         whileTrue: 
  48028.             [actPointer exposed == True
  48029.                 ifTrue: 
  48030.                     [actPointer exposedAncestor: True.
  48031.                     temp := actPointer]
  48032.                 ifFalse: 
  48033.                     [actPointer exposedAncestor: nil.
  48034.                     temp := nil].
  48035.             self doChildren: actPointer exposed: temp.
  48036.             actPointer := actPointer right]! !
  48037.  
  48038. !EditingView methodsFor: 'exposed activities'!
  48039. displayAllExposedActivities
  48040.     | count anActivity graphicsInfo child |
  48041.     count := 1.
  48042.     exposedActs := OrderedCollection new.
  48043.     [count > model displayedActs size]
  48044.         whileFalse: 
  48045.             [anActivity := model displayedActs at: count.
  48046.             anActivity exposed: True.
  48047.             (self shouldDisplayChildrenOf: anActivity)
  48048.                 ifTrue: 
  48049.                     [graphicsInfo := self graphicsForChildrenOf: anActivity.
  48050.                     graphicsInfo notNil
  48051.                         ifTrue: 
  48052.                             [child := anActivity left.
  48053.                             [child notNil]
  48054.                                 whileTrue: 
  48055.                                     [exposedActs add: child.
  48056.                                     child parentBox: anActivity myBox.
  48057.                                     child exposed: True.
  48058.                                     child := child right].
  48059.                             self drawBoxesUsing: graphicsInfo from: anActivity]].
  48060.             count := count + 1].
  48061.     self determineExposedAncestors.
  48062.     self drawTransitions! !
  48063.  
  48064. !EditingView methodsFor: 'exposed activities'!
  48065. doChildren: anActivity exposed: eActivity 
  48066.     "Recusively determine the topmost exposed ancestor for each activity. If 
  48067.     activity 
  48068.  
  48069.     is itself exposed then set the exposedAncestor of that 
  48070.     activity to TRUE"
  48071.  
  48072.     | sibling temp |
  48073.     sibling := anActivity left.
  48074.     [sibling notNil]
  48075.         whileTrue: 
  48076.             [sibling exposed == True
  48077.                 ifTrue: 
  48078.                     [sibling exposedAncestor: True.
  48079.                     temp := sibling]
  48080.                 ifFalse: 
  48081.                     [sibling exposedAncestor: eActivity.
  48082.                     temp := eActivity].
  48083.             self doChildren: sibling exposed: temp.
  48084.             sibling := sibling right]! !
  48085.  
  48086. !EditingView methodsFor: 'exposed activities'!
  48087. drawArcsUsing: graphicsInfo from: anActivity 
  48088.     "Given the graphics info generated by the function called 
  48089.     
  48090.     'graphicsForChildrenOf:', draw the trs on the screen."
  48091.  
  48092.     | count tr style s m e index box points |
  48093.     count := 1.
  48094.     style := 5.
  48095.     [count > model ttm transitionlist size]
  48096.         whileFalse: 
  48097.             [tr := model ttm transitionlist at: count.
  48098.             (model displayedActs includes: tr startingAt)
  48099.                 & (exposedActs includes: tr endingAt)
  48100.                 ifTrue: 
  48101.                     [s := tr myArc sourceStart.
  48102.                     m := tr myArc sourceMid.
  48103.                     index := self indexOfExposedAct: tr endingAt.
  48104.                     box := ((graphicsInfo at: index)
  48105.                                 at: 1) copy moveBy: ((graphicsInfo at: index)
  48106.                                     at: 2).
  48107.                     points := self findSideOf: box face: m.
  48108.                     e := self midPointOf: (points at: 1)
  48109.                                 and: (points at: 2).
  48110.                     self
  48111.                         drawTransitionArcFrom: s
  48112.                         to: e
  48113.                         via: m
  48114.                         inStyle: style.
  48115.                     self labelTransition: tr at: m]
  48116.                 ifFalse: [].
  48117.             (exposedActs includes: tr startingAt)
  48118.                 & (model displayedActs includes: tr endingAt)
  48119.                 ifTrue: 
  48120.                     [e := tr myArc destEnd.
  48121.                     m := tr myArc destMid.
  48122.                     index := self indexOfExposedAct: tr startingAt.
  48123.                     box := ((graphicsInfo at: index)
  48124.                                 at: 1) copy moveBy: ((graphicsInfo at: index)
  48125.                                     at: 2).
  48126.                     points := self findSideOf: box face: m.
  48127.                     s := self midPointOf: (points at: 1)
  48128.                                 and: (points at: 2).
  48129.                     self
  48130.                         drawTransitionArcFrom: s
  48131.                         to: e
  48132.                         via: m
  48133.                         inStyle: style.
  48134.                     self labelTransition: tr at: m]
  48135.                 ifFalse: [].
  48136.             count := count + 1]! !
  48137.  
  48138. !EditingView methodsFor: 'exposed activities'!
  48139. drawBoxesUsing: graphicsInfo from: anActivity 
  48140.     "Given the graphics info generated by the function called 
  48141.     
  48142.     
  48143.     'graphicsForChildrenOf:', draw them on the screen."
  48144.  
  48145.     | count graphicsElement d |
  48146.     count := 1.
  48147.     [count > graphicsInfo size]
  48148.         whileFalse: 
  48149.             [graphicsElement := graphicsInfo at: count.
  48150.             anActivity collectionType = #parallel
  48151.                 ifTrue: [d := false]
  48152.                 ifFalse: [d := graphicsElement at: 4].
  48153.             self
  48154.                 drawActivity: (graphicsElement at: 1)
  48155.                 at: (graphicsElement at: 2)
  48156.                 withLabel: (graphicsElement at: 3)
  48157.                 isDefault: d
  48158.                 collect: anActivity collectionType.
  48159.             count := count + 1]! !
  48160.  
  48161. !EditingView methodsFor: 'exposed activities'!
  48162. drawTransitions
  48163.     "Draw all transitions - work in progress"
  48164.  
  48165.     | sourceAct destAct es ed allTransitions graphicsInfo style s m points box e box1 box2 |
  48166.     style := 5.
  48167.     allTransitions := model ttm transitionlist.
  48168.     allTransitions
  48169.         do: 
  48170.             [:aTransition | 
  48171.             sourceAct := aTransition startingAt.
  48172.             destAct := aTransition endingAt.
  48173.             es := sourceAct exposedAncestor.
  48174.             es == True ifTrue: [es := sourceAct].
  48175.             ed := destAct exposedAncestor.
  48176.             ed == True ifTrue: [ed := destAct].
  48177.             es isNil & ed isNil
  48178.                 ifFalse: 
  48179.                     [es isNil & ed notNil
  48180.                         ifTrue: 
  48181.                             [m := aTransition myArc sourceMid.
  48182.                             (model displayedActs includes: ed)
  48183.                                 ifTrue: [aTransition endingAt exposed = True
  48184.                                         ifTrue: [e := aTransition myArc destEnd]
  48185.                                         ifFalse: 
  48186.                                             [box := ed myBox dimensions copy moveBy: ed myBox location.
  48187.                                             points := self findSideOf: box face: m.
  48188.                                             e := self midPointOf: (points at: 1)
  48189.                                                         and: (points at: 2)]]
  48190.                                 ifFalse: [(exposedActs includes: ed)
  48191.                                         ifTrue: 
  48192.                                             [graphicsInfo := ed graphicsInfo.
  48193.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48194.                                             points := self findSideOf: box face: m.
  48195.                                             e := self midPointOf: (points at: 1)
  48196.                                                         and: (points at: 2)]].
  48197.                             s := self borderPointFrom: e through: m.
  48198.                             self
  48199.                                 drawTransitionArcFrom: s
  48200.                                 to: e
  48201.                                 via: m
  48202.                                 inStyle: 6.
  48203.                             self labelTransition: aTransition at: m].
  48204.                     es notNil & ed isNil
  48205.                         ifTrue: 
  48206.                             [s := aTransition myArc sourceStart.
  48207.                             m := aTransition myArc sourceMid.
  48208.                             e := self borderPointFrom: s through: m.
  48209.                             self
  48210.                                 drawTransitionArcFrom: s
  48211.                                 to: e
  48212.                                 via: m
  48213.                                 inStyle: 2.
  48214.                             self labelTransition: aTransition at: m].
  48215.                     es notNil & ed notNil
  48216.                         ifTrue: 
  48217.                             [(model displayedActs includes: aTransition startingAt)
  48218.                                 & (model displayedActs includes: aTransition endingAt)
  48219.                                 ifTrue: [self drawTransitionArcFor: aTransition]
  48220.                                 ifFalse: [(model displayedActs includes: es)
  48221.                                         & (model displayedActs includes: ed) & (es ~= ed)
  48222.                                         ifTrue: 
  48223.                                             [m := aTransition myArc sourceMid.
  48224.                                             (exposedActs includes: es)
  48225.                                                 ifTrue: [s := aTransition myArc sourceStart]
  48226.                                                 ifFalse: 
  48227.                                                     [box := es myBox dimensions copy moveBy: es myBox location.
  48228.                                                     points := self findSideOf: box face: m.
  48229.                                                     s := self midPointOf: (points at: 1)
  48230.                                                                 and: (points at: 2)].
  48231.                                             (exposedActs includes: ed)
  48232.                                                 ifTrue: [e := aTransition myArc sourceEnd]
  48233.                                                 ifFalse: 
  48234.                                                     [box := ed myBox dimensions copy moveBy: ed myBox location.
  48235.                                                     points := self findSideOf: box face: m.
  48236.                                                     e := self midPointOf: (points at: 1)
  48237.                                                                 and: (points at: 2)].
  48238.                                             self
  48239.                                                 drawTransitionArcFrom: s
  48240.                                                 to: e
  48241.                                                 via: m
  48242.                                                 inStyle: 6.
  48243.                                             self labelTransition: aTransition at: m]].
  48244.                             (model displayedActs includes: es)
  48245.                                 & (exposedActs includes: ed)
  48246.                                 ifTrue: 
  48247.                                     [s := aTransition myArc sourceStart.
  48248.                                     m := aTransition myArc sourceMid.
  48249.                                     graphicsInfo := ed graphicsInfo.
  48250.                                     box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48251.                                     points := self findSideOf: box face: m.
  48252.                                     e := self midPointOf: (points at: 1)
  48253.                                                 and: (points at: 2).
  48254.                                     self
  48255.                                         drawTransitionArcFrom: s
  48256.                                         to: e
  48257.                                         via: m
  48258.                                         inStyle: style.
  48259.                                     self labelTransition: aTransition at: m].
  48260.                             (model displayedActs includes: ed)
  48261.                                 & (exposedActs includes: es)
  48262.                                 ifTrue: 
  48263.                                     [e := aTransition myArc destEnd.
  48264.                                     m := aTransition myArc destMid.
  48265.                                     graphicsInfo := es graphicsInfo.
  48266.                                     box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48267.                                     points := self findSideOf: box face: m.
  48268.                                     s := self midPointOf: (points at: 1)
  48269.                                                 and: (points at: 2).
  48270.                                     self
  48271.                                         drawTransitionArcFrom: s
  48272.                                         to: e
  48273.                                         via: m
  48274.                                         inStyle: style.
  48275.                                     self labelTransition: aTransition at: m].
  48276.                             (exposedActs includes: es)
  48277.                                 & (exposedActs includes: ed)
  48278.                                 ifTrue: 
  48279.                                     [es parentBox = ed parentBox & (es ~= ed | (sourceAct = destAct & (destAct exposed = True)))
  48280.                                         ifTrue: 
  48281.                                             [m := aTransition myArc sourceMid.
  48282.                                             graphicsInfo := es graphicsInfo.
  48283.                                             m := m - es myBox location + (graphicsInfo at: 2).
  48284.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48285.                                             points := self findSideOf: box face: m.
  48286.                                             es = ed
  48287.                                                 ifTrue: [s := points at: 2]
  48288.                                                 ifFalse: [s := self midPointOf: (points at: 1)
  48289.                                                                 and: (points at: 2)].
  48290.                                             graphicsInfo := ed graphicsInfo.
  48291.                                             box := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48292.                                             points := self findSideOf: box face: m.
  48293.                                             e := self midPointOf: (points at: 1)
  48294.                                                         and: (points at: 2).
  48295.                                             self
  48296.                                                 drawTransitionArcFrom: s
  48297.                                                 to: e
  48298.                                                 via: m
  48299.                                                 inStyle: 6.
  48300.                                             self labelTransition: aTransition at: m].
  48301.                                     es parentBox ~= ed parentBox
  48302.                                         ifTrue: 
  48303.                                             [graphicsInfo := es graphicsInfo.
  48304.                                             box1 := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48305.                                             graphicsInfo := ed graphicsInfo.
  48306.                                             box2 := (graphicsInfo at: 1) copy moveBy: (graphicsInfo at: 2).
  48307.                                             points := self boxPoints: box1 to: box2.
  48308.                                             s := points at: 1.
  48309.                                             e := points at: 2.
  48310.                                             m := self midPointOf: (points at: 1)
  48311.                                                         and: (points at: 2).
  48312.                                             self
  48313.                                                 drawTransitionArcFrom: s
  48314.                                                 to: e
  48315.                                                 via: m
  48316.                                                 inStyle: 6.
  48317.                                             self labelTransition: aTransition at: m]]]]]! !
  48318.  
  48319. !EditingView methodsFor: 'exposed activities'!
  48320. graphicsForChildrenOf: anActivity 
  48321.     "Return the set of graphics info for the children of the given activity 
  48322.     if they 
  48323.     can 
  48324.     
  48325.     all fit inside the given activity, else return NIL. Only call this routine 
  48326.     if 
  48327.     anActivity 
  48328.     
  48329.     is exposed and it has a box and it has a child."
  48330.  
  48331.     | graphicsInfo child graphicsElement left top right bottom currentLeft currentTop currentRight currentBottom deltaX deltaY count location maxRight maxBottom xDim yDim temp |
  48332.     graphicsInfo := OrderedCollection new.
  48333.     left := -1.
  48334.     top := -1.
  48335.     right := -1.
  48336.     bottom := -1.
  48337.     child := anActivity left.
  48338.     [child notNil]
  48339.         whileTrue: 
  48340.             [child myBox isNil ifTrue: [^nil].
  48341.             temp := ''.
  48342.             child left notNil ifTrue: [temp := '@'].
  48343.             graphicsElement := Array
  48344.                         with: (self newActivityBox: child myName)
  48345.                         with: child myBox location copy
  48346.                         with: child myName , temp
  48347.                         with: child default.
  48348.             currentLeft := child myBox location x.
  48349.             currentTop := child myBox location y.
  48350.             currentRight := currentLeft + (graphicsElement at: 1) right.
  48351.             currentBottom := currentTop + (graphicsElement at: 1) bottom.
  48352.             left = -1 | (currentLeft < left) ifTrue: [left := currentLeft].
  48353.             top = -1 | (currentTop < top) ifTrue: [top := currentTop].
  48354.             right = -1 | (currentRight > right) ifTrue: [right := currentRight].
  48355.             bottom = -1 | (currentBottom > bottom) ifTrue: [bottom := currentBottom].
  48356.             child graphicsInfo: graphicsElement.
  48357.             graphicsInfo add: graphicsElement.
  48358.             child := child right].
  48359.     maxRight := anActivity myBox dimensions right.
  48360.     maxBottom := anActivity myBox dimensions bottom - 20.
  48361.     xDim := right - left.
  48362.     yDim := bottom - top.
  48363.     xDim > maxRight | (yDim > maxBottom) ifTrue: [^nil].
  48364.     deltaX := maxRight - xDim.
  48365.     deltaX := (deltaX / 2) rounded + (anActivity myBox location x - left).
  48366.     deltaY := maxBottom - yDim.
  48367.     deltaY := (deltaY / 2) rounded + (anActivity myBox location y - top + 20).
  48368.     count := 1.
  48369.     [count > graphicsInfo size]
  48370.         whileFalse: 
  48371.             [location := (graphicsInfo at: count)
  48372.                         at: 2.
  48373.             location x: location x + deltaX.
  48374.             location y: location y + deltaY.
  48375.             count := count + 1].
  48376.     ^graphicsInfo! !
  48377.  
  48378. !EditingView methodsFor: 'exposed activities'!
  48379. indexOfExposedAct: anActivity 
  48380.     "Return the index number of the activity in the exposedActs collection"
  48381.  
  48382.     | count |
  48383.     count := 1.
  48384.     [count > exposedActs size]
  48385.         whileFalse: 
  48386.             [(exposedActs at: count)
  48387.                 = anActivity ifTrue: [^count].
  48388.             count := count + 1].
  48389.     ^0! !
  48390.  
  48391. !EditingView methodsFor: 'exposed activities'!
  48392. shouldDisplayChildrenOf: anActivity 
  48393.     "return true if the given activity is exposed and 
  48394.  
  48395.     has child activities."
  48396.  
  48397.     anActivity left notNil & anActivity myBox notNil
  48398.         ifTrue: [^anActivity myBox depth = #exposed]
  48399.         ifFalse: [^false]! !
  48400.  
  48401. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  48402.  
  48403. EditingView class
  48404.     instanceVariableNames: ''!
  48405.  
  48406. !EditingView class methodsFor: 'initialization'!
  48407. new
  48408.     ^super new displayFlag: True! !
  48409.  
  48410. Object subclass: #Transition
  48411.     instanceVariableNames: 'transitionName startActivity endActivity lowerBound upperBound guard action arc depth name instanceOfName offspring active hasChannelEvent defaultDestinationAssignments defaultSourceAssignments sourceList destinationList tempResult tempDict detailWindow shared '
  48412.     classVariableNames: ''
  48413.     poolDictionaries: ''
  48414.     category: 'Build'!
  48415.  
  48416. !Transition methodsFor: 'determining function'!
  48417. findAV: anActivity withDefault: aDictionary ofTTM: aTTM 
  48418.     | def defAct children ass |
  48419.     (aTTM activitytree parentOf: anActivity) collectionType = #cluster ifTrue: [tempResult add: anActivity].
  48420.     children := aTTM activitytree allImmediateChildrenOf: anActivity.
  48421.     anActivity collectionType = #parallel
  48422.         ifTrue: [children do: [:act2 | self
  48423.                     findAV: act2
  48424.                     withDefault: aDictionary
  48425.                     ofTTM: aTTM]]
  48426.         ifFalse: [children isEmpty
  48427.                 ifFalse: 
  48428.                     [(defAct := aDictionary at: ((children at: 1) av at: 1)
  48429.                                 ifAbsent: []) isNil
  48430.                         ifTrue: [children do: [:x | x default ifTrue: [def := x]]]
  48431.                         ifFalse: 
  48432.                             [def := defAct.
  48433.                             ass := Association new.
  48434.                             ass key: (def av at: 1)
  48435.                                 value: def.
  48436.                             tempDict add: ass].
  48437.                     def isNil
  48438.                         ifTrue: [^nil]
  48439.                         ifFalse: [self
  48440.                                 findAV: def
  48441.                                 withDefault: aDictionary
  48442.                                 ofTTM: aTTM]]]! !
  48443.  
  48444. !Transition methodsFor: 'determining function'!
  48445. findAVSource: anActivity withDefault: aDictionary ofTTM: aTTM 
  48446.     |  defAct children p flag  |
  48447.     p := aTTM activitytree parentOf: anActivity.
  48448.     p notNil
  48449.         ifTrue: [flag := p collectionType = #cluster]
  48450.         ifFalse: [flag := true].
  48451.     flag = true ifTrue: [tempResult add: anActivity].
  48452.     anActivity collectionType = #cluster
  48453.         ifTrue: [(defAct := aDictionary at: (anActivity selfAV at: 1)
  48454.                         ifAbsent: [^nil]) isNil ifFalse: [self
  48455.                     findAVSource: defAct
  48456.                     withDefault: aDictionary
  48457.                     ofTTM: aTTM]]
  48458.         ifFalse: 
  48459.             [children := aTTM activitytree allImmediateChildrenOf: anActivity.
  48460.             children do: [:act2 | self
  48461.                     findAVSource: act2
  48462.                     withDefault: aDictionary
  48463.                     ofTTM: aTTM]]! !
  48464.  
  48465. !Transition methodsFor: 'determining function'!
  48466. newGuard
  48467.     | temp sList |
  48468.     sList := OrderedCollection new.
  48469.     (defaultSourceAssignments size) = 0
  48470.         ifTrue: [^nil]
  48471.         ifFalse: [sList := defaultSourceAssignments values].
  48472.     temp := ((sList at: 1) av at: 1)
  48473.                 , '=' , (sList at: 1) myName.
  48474.     2 to: sList size do: [:x | temp := temp , ',' , ((sList at: x) av at: 1) , '=' , (sList at: x) myName].
  48475.     ^temp! !
  48476.  
  48477. !Transition methodsFor: 'determining function'!
  48478. transformationFunction! !
  48479.  
  48480. !Transition methodsFor: 'determining function'!
  48481. transformationFunctionInTTM: aTTM 
  48482.     | temp dList |
  48483.     tempResult := OrderedCollection new.
  48484.     tempDict := Dictionary new.
  48485.     defaultDestinationAssignments isNil ifTrue: [defaultDestinationAssignments := Dictionary new].
  48486.     self
  48487.         findAV: endActivity
  48488.         withDefault: defaultDestinationAssignments
  48489.         ofTTM: aTTM.
  48490.     dList := tempResult.
  48491.     temp := ((dList at: 1) av at: 1)
  48492.                 , ':' , (dList at: 1) myName.
  48493.     2 to: dList size do: [:x | temp := temp , ',' , ((dList at: x) av at: 1) , ':' , (dList at: x) myName].
  48494.     ^temp! !
  48495.  
  48496. !Transition methodsFor: 'accessing'!
  48497. activate
  48498.  
  48499.      active := True! !
  48500.  
  48501. !Transition methodsFor: 'accessing'!
  48502. active
  48503.  
  48504.      ^active! !
  48505.  
  48506. !Transition methodsFor: 'accessing'!
  48507. boundLower
  48508.     "Return the lower bound for the transition."
  48509.  
  48510.     ^lowerBound! !
  48511.  
  48512. !Transition methodsFor: 'accessing'!
  48513. boundLower: time 
  48514.     "Assign the lower bound for the transition."
  48515.  
  48516.     lowerBound := time! !
  48517.  
  48518. !Transition methodsFor: 'accessing'!
  48519. boundUpper
  48520.     "Return the upper bound for the transition."
  48521.  
  48522.     ^upperBound! !
  48523.  
  48524. !Transition methodsFor: 'accessing'!
  48525. boundUpper: time 
  48526.     "Assign the upper bound for the transition."
  48527.  
  48528.     upperBound := time! !
  48529.  
  48530. !Transition methodsFor: 'accessing'!
  48531. deactivate
  48532.  
  48533.      active := False! !
  48534.  
  48535. !Transition methodsFor: 'accessing'!
  48536. defaultDestinationAssignments
  48537.     ^defaultDestinationAssignments! !
  48538.  
  48539. !Transition methodsFor: 'accessing'!
  48540. defaultDestinationAssignments: aDictionary 
  48541.     defaultDestinationAssignments := aDictionary! !
  48542.  
  48543. !Transition methodsFor: 'accessing'!
  48544. defaultSourceAssignments
  48545.     ^defaultSourceAssignments! !
  48546.  
  48547. !Transition methodsFor: 'accessing'!
  48548. defaultSourceAssignments: aDictionary 
  48549.     defaultSourceAssignments := aDictionary! !
  48550.  
  48551. !Transition methodsFor: 'accessing'!
  48552. depth
  48553.  
  48554.      ^depth! !
  48555.  
  48556. !Transition methodsFor: 'accessing'!
  48557. depth: newDepth 
  48558.  
  48559.      depth := newDepth! !
  48560.  
  48561. !Transition methodsFor: 'accessing'!
  48562. destinationList
  48563.  
  48564.      ^destinationList! !
  48565.  
  48566. !Transition methodsFor: 'accessing'!
  48567. destinationList: this 
  48568.  
  48569.      destinationList := this! !
  48570.  
  48571. !Transition methodsFor: 'accessing'!
  48572. detailWindow
  48573.     ^detailWindow! !
  48574.  
  48575. !Transition methodsFor: 'accessing'!
  48576. detailWindow: aDetailWindow 
  48577.     detailWindow := aDetailWindow! !
  48578.  
  48579. !Transition methodsFor: 'accessing'!
  48580. endingAt
  48581.  
  48582.      "Return the activity that the transition ends at."
  48583.  
  48584.  
  48585.  
  48586.      ^endActivity! !
  48587.  
  48588. !Transition methodsFor: 'accessing'!
  48589. endingAt: anActivity
  48590.  
  48591.      "Assign the activity that the transition ends at."
  48592.  
  48593.  
  48594.  
  48595.      endActivity := anActivity.! !
  48596.  
  48597. !Transition methodsFor: 'accessing'!
  48598. getDestForAV: anAVName 
  48599.  
  48600.      destinationList do: [:x | (x at: 1)
  48601.  
  48602.                = anAVName ifTrue: [^x at: 2]].
  48603.  
  48604.      ^nil! !
  48605.  
  48606. !Transition methodsFor: 'accessing'!
  48607. instanceOfName
  48608.  
  48609.      ^instanceOfName! !
  48610.  
  48611. !Transition methodsFor: 'accessing'!
  48612. instanceOfName: aNumber 
  48613.  
  48614.      instanceOfName := aNumber! !
  48615.  
  48616. !Transition methodsFor: 'accessing'!
  48617. myAction
  48618.  
  48619.      "Return the action for the current Transition"
  48620.  
  48621.  
  48622.  
  48623.      ^action! !
  48624.  
  48625. !Transition methodsFor: 'accessing'!
  48626. myAction: newAction
  48627.  
  48628.      "Assign the action for the current Transition"
  48629.  
  48630.  
  48631.  
  48632.      action := newAction.! !
  48633.  
  48634. !Transition methodsFor: 'accessing'!
  48635. myArc
  48636.  
  48637.      ^arc! !
  48638.  
  48639. !Transition methodsFor: 'accessing'!
  48640. myArc: newArc 
  48641.  
  48642.      arc := newArc! !
  48643.  
  48644. !Transition methodsFor: 'accessing'!
  48645. myGuard
  48646.  
  48647.      "Return the guard for the current Transition"
  48648.  
  48649.  
  48650.  
  48651.      ^guard! !
  48652.  
  48653. !Transition methodsFor: 'accessing'!
  48654. myGuard: newGuard
  48655.  
  48656.      "Assign the guard for the current Transition"
  48657.  
  48658.  
  48659.  
  48660.      guard := newGuard.! !
  48661.  
  48662. !Transition methodsFor: 'accessing'!
  48663. myName
  48664.  
  48665.      "Return the name of the current Transition"
  48666.  
  48667.  
  48668.  
  48669.      ^transitionName! !
  48670.  
  48671. !Transition methodsFor: 'accessing'!
  48672. myName: givenName
  48673.  
  48674.      "Assign the name of the current Transition"
  48675.  
  48676.  
  48677.  
  48678.      transitionName := givenName.! !
  48679.  
  48680. !Transition methodsFor: 'accessing'!
  48681. shared
  48682.     ^shared! !
  48683.  
  48684. !Transition methodsFor: 'accessing'!
  48685. shared: aBoolean 
  48686.     shared := aBoolean! !
  48687.  
  48688. !Transition methodsFor: 'accessing'!
  48689. sourceList
  48690.  
  48691.      ^sourceList! !
  48692.  
  48693. !Transition methodsFor: 'accessing'!
  48694. sourceList: this 
  48695.  
  48696.      sourceList := this! !
  48697.  
  48698. !Transition methodsFor: 'accessing'!
  48699. startingAt
  48700.  
  48701.      "Return the activity that the transition starts at."
  48702.  
  48703.  
  48704.  
  48705.      ^startActivity! !
  48706.  
  48707. !Transition methodsFor: 'accessing'!
  48708. startingAt: anActivity
  48709.  
  48710.      "Assign the activity that the transition starts at."
  48711.  
  48712.  
  48713.  
  48714.      startActivity := anActivity.! !
  48715.  
  48716. !Transition methodsFor: 'cross product'!
  48717. commonModifiedVariablesWith: aTransition
  48718.     | c1 c2 s1 s2 ind result |
  48719.     result := SortedCollection new.
  48720.     c1 := self modifiedVariables.
  48721.     c2 := aTransition modifiedVariables.
  48722.     s1 := c1 size.
  48723.     s2 := c2 size.
  48724.     s2 == 0 | (s1 == 0) ifTrue: [^nil].
  48725.     ind := 1.
  48726.     c1
  48727.         do: 
  48728.             [:t1 | 
  48729.             [t1 > (c2 at: ind)]
  48730.                 whileTrue: 
  48731.                     [ind := ind + 1.
  48732.                     ind > s2 ifTrue: [^result]].
  48733.             t1 = (c2 at: ind) ifTrue: [result add: t1]].
  48734.     ^result! !
  48735.  
  48736. !Transition methodsFor: 'cross product'!
  48737. crossWith: aTransition 
  48738.     | newGuard newTransformationFunction newName result temp t1 t2 newUp newLow |
  48739.     temp := self commonModifiedVariablesWith: aTransition.
  48740.     newGuard := self myGuard , ',' , aTransition myGuard.
  48741.     newName := 'test'.
  48742.     newTransformationFunction := self myAction , ',' , aTransition myAction.
  48743.     t1 := self boundUpper.
  48744.     t2 := aTransition boundUpper.
  48745.     t1 = 'infinity'
  48746.         ifTrue: [t2 ~= 'infinity'
  48747.                 ifTrue: [newUp := t2]
  48748.                 ifFalse: [newUp := 'infinity']]
  48749.         ifFalse: [t2 = 'infinity'
  48750.                 ifTrue: [newUp := t1]
  48751.                 ifFalse: [t2 < t1
  48752.                         ifTrue: [newUp := t2]
  48753.                         ifFalse: [newUp := t1]]].
  48754.     t1 := self boundLower.
  48755.     t2 := aTransition boundLower.
  48756.     t1 < t2
  48757.         ifTrue: [newLow := t2]
  48758.         ifFalse: [newLow := t1].
  48759.     result := Transition
  48760.                 name: newName
  48761.                 startAt: nil
  48762.                 endAt: nil
  48763.                 upper: newUp
  48764.                 lower: newLow
  48765.                 guard: newGuard
  48766.                 action: newTransformationFunction.
  48767.     self deactivate.
  48768.     aTransition deactivate.
  48769.     ^result! !
  48770.  
  48771. !Transition methodsFor: 'cross product'!
  48772. modifiedVariables
  48773.     "return the names of the modified variables in the 
  48774.     
  48775.     transformation 
  48776.     
  48777.     function"
  48778.  
  48779.     | temp result |
  48780.     result := SortedCollection new.
  48781.     temp := ''.
  48782.     action do: [:x | x == $:
  48783.             ifTrue: 
  48784.                 [result add: temp.
  48785.                 temp := '']
  48786.             ifFalse: [x == $, ifFalse: [temp := temp , x asSymbol asString]
  48787.                     ifTrue: [temp := '']]].
  48788.     ^result! !
  48789.  
  48790. !Transition methodsFor: 'testing'!
  48791. containsThis: argument 
  48792.     | found |
  48793.     found := (self myGuard asString findString: argument startingAt: 1)
  48794.                 ~= 0.
  48795.     found = false ifTrue: [found := (self myAction asString findString: argument startingAt: 1)
  48796.                     ~= 0].
  48797.     ^found! !
  48798.  
  48799. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  48800.  
  48801. Transition class
  48802.     instanceVariableNames: ''!
  48803.  
  48804. !Transition class methodsFor: 'instance creation'!
  48805. name: givenName startAt: activity1 endAt: activity2 upper: uTime lower: lTime guard: newGuard action: newAction 
  48806.     "Create an instance of a Transition with the arguments 
  48807.     
  48808.     name, activity1, and activity2 as the transition name, 
  48809.     
  48810.     starting activity and ending activity respectively. 
  48811.     
  48812.     The upper and lower bounds, the guard and the action 
  48813.     
  48814.     are assigned defaults 
  48815.     
  48816.     for now."
  48817.  
  48818.     | newTransition |
  48819.     newTransition := self new.
  48820.     newTransition myName: givenName.
  48821.     newTransition startingAt: activity1.
  48822.     newTransition endingAt: activity2.
  48823.     newTransition boundLower: lTime.
  48824.     newTransition boundUpper: uTime.
  48825.     newTransition myGuard: newGuard.
  48826.     newTransition myAction: newAction.
  48827.     newTransition myArc: nil.
  48828.     newTransition depth: #hidden.
  48829.     newTransition shared: false.
  48830.     ^newTransition! !
  48831.  
  48832. Model subclass: #HelpScreens
  48833.     instanceVariableNames: 'currentString currentTitle currentTr '
  48834.     classVariableNames: ''
  48835.     poolDictionaries: ''
  48836.     category: 'Build'!
  48837.  
  48838. !HelpScreens methodsFor: 'help access'!
  48839. editInfo
  48840.     self begin: 'Editing A TTM' withCenter: true.
  48841.     self add: '   In this window the activities and transitions that comprise'.
  48842.     self add: 'a TTM can be added, removed, and edited. The window is'.
  48843.     self add: 'made up of fifteen control buttons and a display view.'.
  48844.     self nextln.
  48845.     self add: 'The Control Buttons:'.
  48846.     self add: '---------------'.
  48847.     self nextln.
  48848.     self add: '"Zoom In"'.
  48849.     self add: 'The display always focuses on a particular activity and'.
  48850.     self add: 'displays what is inside of it. When the window is first'.
  48851.     self add: 'opened, this activity is the TTM itself. The focus can be'.
  48852.     self add: 'changed by using "Zoom in" to zoom in on a particular'.
  48853.     self add: 'child activity of the one currently displayed.'.
  48854.     self nextln.
  48855.     self add: '"Zoom Out"'.
  48856.     self add: 'Changes the focus to the parent of the current activity.'.
  48857.     self nextln.
  48858.     self add: '"Hierarchy"'.
  48859.     self add: 'Provides a way of zooming out of several levels at once.'.
  48860.     self add: 'It displays the ancestors of the current activity, then,'.
  48861.     self add: 'by selecting one of them, the user can immediately'.
  48862.     self add: 'jump to that ancestor.'.
  48863.     self nextln.
  48864.     self add: '"Add Activity"'.
  48865.     self add: 'Adding an activity is done by clicking the corresponding'.
  48866.     self add: 'control button. The window will then prompt the user for'.
  48867.     self add: 'the place to put the activity.'.
  48868.     self nextln.
  48869.     self add: '"Expose Acts."'.
  48870.     self add: 'Expose all existing activities at this level so that their'.
  48871.     self add: 'children can be seen. Note that exposed children are'.
  48872.     self add: 'not editable at this level. This function is only for display.'.
  48873.     self add: 'Also note that no transitions at the children level are'.
  48874.     self add: 'displayed unless they have starting or ending activities'.
  48875.     self add: 'at the current level.'.
  48876.     self nextln.
  48877.     self add: '"Hide Acts."'.
  48878.     self add: 'Hide all existing activities at this level so that their'.
  48879.     self add: 'children cannot be seen.'.
  48880.     self nextln.
  48881.     self add: '"Add Transition"'.
  48882.     self add: 'Adding a transition is done similarly except in this case'.
  48883.     self add: 'the window prompts for the source activity and then the'.
  48884.     self add: 'destination activity for the proposed transition. Selecting'.
  48885.     self add: 'an activity to be a source or destination is done by clicking'.
  48886.     self add: 'it with the left mouse button.'.
  48887.     self nextln.
  48888.     self add: '"Expose Trans."'.
  48889.     self add: 'Expose all existing transitions starting or ending at this'.
  48890.     self add: 'level so that their guards and actions can be seen.'.
  48891.     self nextln.
  48892.     self add: '"Hide Trans."'.
  48893.     self add: 'Hide all existing transitions starting or ending at this'.
  48894.     self add: 'level so that their guards and actions can not be seen.'.
  48895.     self nextln.
  48896.     self add: '"Insert TTM"'.
  48897.     self add: 'To insert another TTM into the current one, click this'.
  48898.     self add: 'button. The user will be presented with a list of the'.
  48899.     self add: 'available TTMs from which to choose and a set of options.'.
  48900.     self add: 'These options allow either concurrent or serial insertion and'.
  48901.     self add: 'allow the user to state if all of the duplicate variables and'.
  48902.     self add: 'transitions should be considered shared. Once a TTM has '.
  48903.     self add: 'been chosen and the appropriate options selected, the user'.
  48904.     self add: 'should then click the "accept" button to tell the editor to'.
  48905.     self add: 'perform the insertion or "exit" to exit the insert routine.'.
  48906.     self add: 'Some changes may have to be made to the TTMs in order'.
  48907.     self add: 'to facilitate the insertion. In this event, the editor will'.
  48908.     self add: 'notify the user if and when user input is required. (Please'.
  48909.     self add: 'see the manual for info on concurrency/serial issues.)'.
  48910.     self add: 'After any required changes have been made, simply click'.
  48911.     self add: 'on an area in the display view where the TTM should be'.
  48912.     self add: 'located.'.
  48913.     self nextln.
  48914.     self add: '"Compose TTMs"'.
  48915.     self add: 'This function is for convenient concurrent insertion of'.
  48916.     self add: 'multiple ttms. It is exactly the same as "Insert TTM" except'.
  48917.     self add: 'it is assumed that all insertion is to be concurrent.'.
  48918.     self nextln.
  48919.     self add: '"Reset Default"'.
  48920.     self add: 'Each activity that has children also has a default child that'.
  48921.     self add: 'is shown on the display view in bold letters. The default'.
  48922.     self add: 'is used to determine which activities are activated when'.
  48923.     self add: 'they are not explicitly determined by the user; e.g. a'.
  48924.     self add: 'transition whose destination is X implies that the actual'.
  48925.     self add: 'destination is one or more activities WITHIN X when X has'.
  48926.     self add: 'children. The default is automatically assigned to the first'.
  48927.     self add: 'child that was created in X. The default can be reset,'.
  48928.     self add: 'however, using this button. Simply click it, then click on'.
  48929.     self add: 'the activity that is to be the new default.'.
  48930.     self nextln.
  48931.     self add: '"Cancel"'.
  48932.     self add: 'Clicking this button will cancel any currently pending'.
  48933.     self add: 'operation. If an operation is pending, a prompt line will'.
  48934.     self add: 'be displayed above the display view.'.
  48935.     self nextln.
  48936.     self add: '"Help"'.
  48937.     self add: 'Clicking this button will cause this window to be created.'.
  48938.     self nextln.
  48939.     self add: '"Exit"'.
  48940.     self add: 'Clicking this button will exit the user from the Editor.'.
  48941.     self nextln.
  48942.     self nextln.
  48943.     self add: 'The Display View:'.
  48944.     self add: '-------------'.
  48945.     self add: 'There is a middle mouse button menu associated with'.
  48946.     self add: 'each transition and each activity currently displayed on'.
  48947.     self add: 'the editor. These menus provide ways of manipulating'.
  48948.     self add: 'the transitions and activities. These menus are described'.
  48949.     self add: 'below.'.
  48950.     self nextln.
  48951.     self add: '"Operations On Activities"'.
  48952.     self add: '--------------------'.
  48953.     self add: 'zoom in -- same as control button "Zoom In".'.
  48954.     self add: 'move -- moves the position of the activity. The user'.
  48955.     self add: ' will be prompted for the new position.'.
  48956.     self add: 'resize -- resizes the activity. The user will be'.
  48957.     self add: ' prompted for the new bottom right corner of'.
  48958.     self add: ' the activity.'.
  48959.     self add: 'rename -- renames activity.'.
  48960.     self add: 'expose/ -- exposes the child activities if any.'.
  48961.     self add: '/hide -- hides the child activities if any.'.
  48962.     self add: ' <this feature is not yet implemented>'.
  48963.     self add: 'remove -- removes the activity.'.
  48964.     self add: 'add tr. -- same as control button "Add Transition".'.
  48965.     self nextln.
  48966.     self add: '"Operations On Transitions"'.
  48967.     self add: '---------------------'.
  48968.     self add: 'rename -- renames transition.'.
  48969.     self add: 'lower b. -- changes lower bound of transition.'.
  48970.     self add: 'upper b. -- changes upper bound of transition.'.
  48971.     self add: 'guard -- changes guard of transition. The syntax'.
  48972.     self add: ' required for a guard is explained in the'.
  48973.     self add: ' main help window under "Grammar'.
  48974.     self add: ' Description".'.
  48975.     self add: 'function -- changes function of transition. The'.
  48976.     self add: ' syntax required for a function is ex-'.
  48977.     self add: ' plained in the main help window under'.
  48978.     self add: ' "Grammar Description".'.
  48979.     self add: 'expose/ -- exposes the time bounds, guard and'.
  48980.     self add: ' function so they can be seen.'.
  48981.     self add: '/hide -- hides the above.'.
  48982.     self add: 'move -- moves the midpoint of transition arc.'.
  48983.     self add: ' User is prompted for new position.'.
  48984.     self add: 'dest. -- change destination activity for this'.
  48985.     self add: ' transition. User is prompted for new'.
  48986.     self add: ' destination activity.'.
  48987.     self add: 'remove -- removes transition.'.
  48988.     ^self concludeWithNote: true! !
  48989.  
  48990. !HelpScreens methodsFor: 'help access'!
  48991. helpInfo
  48992.     self begin: ('Welcome to Build V0.984'  ) withCenter: true.
  48993.     self add: '                    Contact: jonathan@cs.yorku.ca' .
  48994.     self add: '                            copyright 1990/94'.
  48995.     self add: ''.
  48996.     self add: ''.
  48997.     self add: ' As you can see, "Build" resides in a window that'.
  48998.     self add: 'consists of seven views and an array of control buttons. '.
  48999.     self add: 'Views are scrollable display areas. Control buttons are'.
  49000.     self add: 'labelled rectangles. To "push" a control button, the user'.
  49001.     self add: 'should move the mouse cursor to the button, then click'.
  49002.     self add: 'the left button on the mouse.'.
  49003.     self nextln.
  49004.     self add: '"List Of Existing TTMs"'.
  49005.     self add: '-----------------'.
  49006.     self add: 'This view contains the list of TTMs already created. When'.
  49007.     self add: 'empty, this list will consist of just the two bounding'.
  49008.     self add: 'dashed lines. To select an existing TTM, move the cursor'.
  49009.     self add: 'to it, then click the left mouse button.'.
  49010.     self add: 'Operations involving a selected TTM are performed by'.
  49011.     self add: 'clicking on one of the control buttons at the bottom of the'.
  49012.     self add: 'window. However, the user can also select these operations'.
  49013.     self add: 'using the middle mouse button menu in this view.'.
  49014.     self add: 'IMPORTANT: Please note that none of the following'.
  49015.     self add: 'views will display information or allow the user to input'.
  49016.     self add: 'information UNLESS a TTM in the list is selected. Also,'.
  49017.     self add: 'all but the "Add TTM", "Help" and "Exit Program" control'.
  49018.     self add: 'buttons require a TTM to be selected to be enabled.'.
  49019.     self nextln.
  49020.     self add: '"Note Pad"'.
  49021.     self add: '--------'.
  49022.     self add: 'This view is just a space for the user to include some'.
  49023.     self add: 'description of the selected TTM. This description can be'.
  49024.     self add: 'edited using the usual text cut & paste features. These'.
  49025.     self add: 'are provided in the middle mouse button menu. They'.
  49026.     self add: 'consist of: "again", "undo", "copy", "cut", "paste", '.
  49027.     self add: '"accept" and "cancel". In order for the description to'.
  49028.     self add: 'be added to the TTM, the "accept" option must be used.'.
  49029.     self nextln.
  49030.     self add: '"Activity Variables"'.
  49031.     self add: '--------------'.
  49032.     self add: 'This view lists the activity variables used in the selected'.
  49033.     self add: 'TTM. Because an activity variable can only be added or'.
  49034.     self add: 'removed when the TTM it belongs to is added or'.
  49035.     self add: 'removed, the only middle mouse button menu option'.
  49036.     self add: 'available to the user is "rename" the selected variable.'.
  49037.     self nextln.
  49038.     self add: '"Data Variables"'.
  49039.     self add: '------------'.
  49040.     self add: 'This view lists the data variables used in the selected'.
  49041.     self add: 'TTM. The middle mouse button menu consists of: "add",'.
  49042.     self add: '"remove", "rename", "new lower limit", and "new upper'.
  49043.     self add: 'limit". These last two are for changing the integer range'.
  49044.     self add: 'of the selected variable.'.
  49045.     self nextln.
  49046.     self add: '"Communication Channels"'.
  49047.     self add: '---------------------'.
  49048.     self add: 'This view lists the communication channels available in'.
  49049.     self add: 'the selected TTM. The middle mouse button menu'.
  49050.     self add: 'consists of: "add", "remove", and "rename".'.
  49051.     self nextln.
  49052.     self add: '"SFs:"'.
  49053.     self add: '----'.
  49054.     self add: 'The state formula numbers for the selected TTM are'.
  49055.     self add: 'listed here. When a particular SF number is selected'.
  49056.     self add: 'its state formula is displayed in the following view.'.
  49057.     self add: 'Middle mouse button menu options are: "add", "copy"'.
  49058.     self add: '"clear", "remove", and "renumber". "clear" will remove'.
  49059.     self add: 'all SFs from the selected TTM.'.
  49060.     self add: ' Note that for verification, the above is sufficient.'.
  49061.     self add: 'However, with controller design, the user needs a set'.
  49062.     self add: 'of SFs for EACH specification. So, after each set is'.
  49063.     self add: 'defined by the user, a file should be generated of it'.
  49064.     self add: 'before clearing it and defining the next set.'.
  49065.     self nextln.
  49066.     self add: '"Current SF:"'.
  49067.     self add: '----------'.
  49068.     self add: 'This view displays the current SF selected in the "SFs:"'.
  49069.     self add: 'view. Initially this is nil. It can be edited using the usual'.
  49070.     self add: 'text cut & paste features. These are described above in'.
  49071.     self add: '"Note Pad". The state formula is defined in the same way'.
  49072.     self add: 'as a transition guard. For an outline of the syntax'.
  49073.     self add: 'required see below under "Grammar Description".'.
  49074.     self nextln.
  49075.     self add: '"Add TTM:"'.
  49076.     self add: 'This will add a "blank" TTM to the list of existing TTMs.'.
  49077.     self add: 'The user will be prompted for a name and an activity'.
  49078.     self add: 'variable. It will contain no transitions and only the root'.
  49079.     self add: 'activity.'.
  49080.     self nextln.
  49081.     self add: '"Remove TTM"'.
  49082.     self add: 'This will remove the selected TTM from the list of'.
  49083.     self add: 'existing TTMs.'.
  49084.     self nextln.
  49085.     self add: '"Rename TTM"'.
  49086.     self add: 'This will rename the selected TTM to one provided by'.
  49087.     self add: 'the user.'.
  49088.     self nextln.
  49089.     self add: '"Copy TTM"'.
  49090.     self add: 'This will copy the selected TTM. The user will be'.
  49091.     self add: 'prompted for a new name for the copy.'.
  49092.     self nextln.
  49093.     self add: '"Edit TTM"'.
  49094.     self add: 'This creates an Editor for the selected TTM. It is here'.
  49095.     self add: 'that the transitions and activities are added to the'.
  49096.     self add: 'TTM. Detailed Help is provided within Editor.'.
  49097.     self nextln.
  49098.     self add: '"Query TTM"'.
  49099.     self add: 'This creates a Query window for the selected TTM.'.
  49100.     self add: 'It is here that the user can examine characteristics'.
  49101.     self add: 'of the TTM using conjunctive queries. Detailed Help'.
  49102.     self add: 'is provided within Query window.'.
  49103.     self nextln.
  49104.     self add: '"Simulate TTM"'.
  49105.     self add: 'This creates a Simulator for the selected TTM. It is'.
  49106.     self add: 'here that the user can simulate the operation of the'.
  49107.     self add: 'TTM and debug. Detailed Help is provided within'.
  49108.     self add: 'Simulator.'.
  49109.     self nextln.
  49110.     self add: '"Specify IC"'.
  49111.     self add: 'This creates a Specifier for the selected TTM. It is'.
  49112.     self add: 'here that the user specifies the initial condition(s)'.
  49113.     self add: 'for the TTM. Detailed Help is provided within.'.
  49114.     self nextln.
  49115.     self add: '"Generate Code"'.
  49116.     self add: 'This will generate Quintus Prolog or Prolog III files'.
  49117.     self add: 'that specify the selected TTM. These files are required'.
  49118.     self add: 'for both verification and controller design.'.
  49119.     self add: 'It will also generate Quintus Prolog or Prolog III files for'.
  49120.     self add: 'the state formulae created in the SF views. These files'.
  49121.     self add: 'are required for both verification and controller design.'.
  49122.     self add: 'There is an option for the user to enumerate the activity'.
  49123.     self add: 'names in the files generated. Using numbers will'.
  49124.     self add: 'generally speed up the verification process.'.
  49125.     self nextln.
  49126.     self add: '"File Access"'.
  49127.     self add: 'Clicking this button creates the interface for loading'.
  49128.     self add: 'and saving individual TTMs. It consists of a scrollable'.
  49129.     self add: 'window displaying the contents of the current directory'.
  49130.     self add: 'and buttons for loading, saving, and exiting.'.
  49131.     self add: 'To load, select a valid file (one ending in ".model") then'.
  49132.     self add: 'click the "load" button. To save, select a TTM in the list'.
  49133.     self add: 'of existing TTMs, then click the "save" button. The user'.
  49134.     self add: 'will then be prompted for a filename. Note that valid'.
  49135.     self add: 'filenames must end in ".model".'.
  49136.     self nextln.
  49137.     self add: '"Help"'.
  49138.     self add: 'Clicking this button will cause this window to be created'.
  49139.     self nextln.
  49140.     self add: '"Exit Program"'.
  49141.     self add: 'Clicking this button will exit the Model Builder program.'.
  49142.     self nextln.
  49143.     self nextln.
  49144.     self add: '"Grammar Description:"'.
  49145.     self add: '=================='.
  49146.     self add: 'The following describes the syntax in which guards,'.
  49147.     self add: 'functions, state formulae, and initial conditions must be'.
  49148.     self add: 'expressed in. In almost all instances, this syntax is the'.
  49149.     self add: 'same as required by the Quintus Prolog programming'.
  49150.     self add: 'language. In the examples, A and B are data variables'.
  49151.     self add: 'while X1 and X2 are activity variables. In instances'.
  49152.     self add: 'where only one of the variable types can be used with'.
  49153.     self add: 'a particular symbol, only that variable type will be used'.
  49154.     self add: 'in the example. In instances where both variable types'.
  49155.     self add: 'can be used, both types will be used in the example.'.
  49156.     self nextln.
  49157.     self add: '-- Arithmetic Operators --'.
  49158.     self add: ' + addition A + B'.
  49159.     self add: ' - subtraction B - A'.
  49160.     self add: ' * multiplication A * B'.
  49161.     self add: ' / integer division A / B'.
  49162.     self add: ' % integer remainder (modulo) A % B'.
  49163.     self add: '-- Unary Operators --'.
  49164.     self add: ' + positive +A +5'.
  49165.     self add: ' - negative -A -2'.
  49166.     self add: '-- Inequality Symbols --'.
  49167.     self add: ' = equal A = B X1 = X2'.
  49168.     self add: ' # not equal A # B X1 # X2'.
  49169.     self add: ' > greater than A > B'.
  49170.     self add: ' >= greater than or equal to A >= B'.
  49171.     self add: ' < less than B < A'.
  49172.     self add: ' =< less than or equal to B =< A'.
  49173.     self add: '-- Assignment --'.
  49174.     self add: ' : assign A : A + 1 X1 : off'.
  49175.     self add: '-- Conjunction Operators --'.
  49176.     self add: ' , logical AND A > 0 , X1 # on'.
  49177.     self add: ' ; logical OR X2 = off ; B =< 100'.
  49178.     self add: ' ( left bracket'.
  49179.     self add: ' ) right bracket (A > 0, B > A) ; (X1 # on)'.
  49180.     self nextln.
  49181.     self add: '== Boolean Expressions and Assignments =='.
  49182.     self nextln.
  49183.     self add: 'All guards, state formulae, and initial conditions are'.
  49184.     self add: 'boolean expressions; that is, they all evaluate to either'.
  49185.     self add: 'TRUE or FALSE. All functions are assignments; that is,'.
  49186.     self add: 'they assign particulars values to variables.'.
  49187.     self add: ' "Boolean expressions" can make use of all of the above'.
  49188.     self add: 'symbols. For example, this is a valid boolean expression:'.
  49189.     self add: ' ((A + 1 > 0, A - 1 =< 10) ; (B > -A , (X1 # on ; X2 = off)))'.
  49190.     self add: 'Arithmetic operators, however, cannot be used on the'.
  49191.     self add: 'right hand side of an expression and inequalities must'.
  49192.     self add: 'not be cascaded; i.e. A > B , B > 10 must be used instead'.
  49193.     self add: 'of A > B > 10.'.
  49194.     self add: ' "Assignments" are restricted to using the arithmetic'.
  49195.     self add: 'operators and the logical AND conjunction operator; i.e.'.
  49196.     self add: 'A : A + 1 , B : B - 1 is valid. A > B + 1 ; (B : B - 1) is not.'.
  49197.     self add: 'For assignments, the right hand side must be a variable'.
  49198.     self add: 'and the left hand side must evaluate to a particular'.
  49199.     self add: 'value. When the variable in question is a data variable'.
  49200.     self add: 'the value must evaluate to an integer within the range'.
  49201.     self add: 'given upon initialization.'.
  49202.     self add: ' Note: that with both expressions and assignments, '.
  49203.     self add: 'cascading arithmetic operators can be used. For example,'.
  49204.     self add: 'A : -A + B - 10 + 3 and (A + B - 10 + 3) > 100 are valid.'.
  49205.     self add: ' Note: the multiplication operator does NOT have'.
  49206.     self add: 'precedence over addition and subtraction. Thus, 5+6*2'.
  49207.     self add: 'equals 22 and NOT 17.'.
  49208.     ^self concludeWithNote: true! !
  49209.  
  49210. !HelpScreens methodsFor: 'help access'!
  49211. icInfo
  49212.     self begin: 'Introduction To Specifying ICs' withCenter: true.
  49213.     self add: 'Prolog III Initial Condition:'.
  49214.     self add: '--------------------'.
  49215.     self add: 'This view contains the initial condition for the selected'.
  49216.     self add: 'TTM. This initial condition is used in the Prolog III Code'.
  49217.     self add: 'Generation. It should be specified in the same format'.
  49218.     self add: 'as a transition guard. The usual cut & paste text editing'.
  49219.     self add: 'features are provided in the middle mouse button'.
  49220.     self add: 'menu. These are: "again", "undo", "copy", "cut", "paste",'.
  49221.     self add: '"accept" and "cancel". To save the initial condition typed'.
  49222.     self add: 'into the view the "accept" option must be selected.'.
  49223.     self add: 'A syntax check will then be run on the condition. '.
  49224.     self add: 'If it is valid, the condition will be added to the TTM.'.
  49225.     self add: 'The syntax required for the initial condition is explained'.
  49226.     self add: 'in the main help window under "Grammar Description".'.
  49227.     self nextln.
  49228.     self add: 'Specific IC LIst:'.
  49229.     self add: '------------'.
  49230.     self add: 'This view and the remaining view together provide the'.
  49231.     self add: 'user with the ability to write SPECIFIC initial conditions.'.
  49232.     self add: 'SPECIFIC initial conditions are those that assign values'.
  49233.     self add: 'to every activity and data variable in the TTM and do'.
  49234.     self add: 'not include inequalities or arithmetic expressions. '.
  49235.     self add: ' Specific Initial Conditions are ONLY required by the'.
  49236.     self add: 'finite-state verification program (running under Quintus'.
  49237.     self add: 'Prolog). For any other code generation, the non-specific'.
  49238.     self add: 'initial condition is used.'.
  49239.     self add: ' This view contains a list of numbers. Each number'.
  49240.     self add: 'refers to a unique specific initial condition. When a'.
  49241.     self add: 'number is selected, its specific i.c. is displayed in the'.
  49242.     self add: 'next view. Middle mouse button menu options are: '.
  49243.     self add: '"add", "copy", "clear", and "remove". "clear" will'.
  49244.     self add: 'remove all ICs.'.
  49245.     self add: '"send" will send the currently selected initial condition'.
  49246.     self add: 'to the Starting Condition subview of the Simulate '.
  49247.     self add: 'Window associated with the current TTM. The current'.
  49248.     self add: 'simulation will terminate as if you had pressed the'.
  49249.     self add: '"Clear" button. '.
  49250.     self nextln.
  49251.     self add: '"Selected Specific Initial Condition"'.
  49252.     self add: ' The values for each activity and data variable are'.
  49253.     self add: 'displayed in this list. To change a value, select the'.
  49254.     self add: 'variable, then the middle mouse button menu option:'.
  49255.     self add: '"new initial value". The Specifier will then prompt for'.
  49256.     self add: 'a new value.'.
  49257.     self nextln.
  49258.     self add: '"Help"'.
  49259.     self add: 'Clicking this button will create this help window.'.
  49260.     self nextln.
  49261.     self add: '"Exit"'.
  49262.     self add: '"Clicking this button will exit the user from the'.
  49263.     self add: 'Initial Condition Specifier.'.
  49264.     ^self concludeWithNote: true! !
  49265.  
  49266. !HelpScreens methodsFor: 'help access'!
  49267. queryInfo
  49268.     self begin: 'Querying A TTM' withCenter: true.
  49269.     self add: ' This window provides tools for asking questions about'.
  49270.     self add: 'the selected TTM. The aim is to allow the user to examine'.
  49271.     self add: 'subsets of the transitions that make up the TTM; e.g. we'.
  49272.     self add: 'may wish to display all transitions within activity X that'.
  49273.     self add: 'perform an operation on data variable C. This can be done'.
  49274.     self add: 'easily with the provided tools.'.
  49275.     self add: ' Initially, all of the transitions within the selected TTM'.
  49276.     self add: 'are displayed. The tool works by applying successive'.
  49277.     self add: 'constraints to this table of transitions. An example of'.
  49278.     self add: 'a constraint could be that all transitions should have X'.
  49279.     self add: 'as their source. Applying this constraint would result in'.
  49280.     self add: 'only those transitions being displayed in the table.'.
  49281.     self nextln.
  49282.     self add: ' "Adding Constraints"'.
  49283.     self add: ' Constraints to the table of transitions currently being'.
  49284.     self add: 'displayed are added using a set of 10 predicates. Clicking'.
  49285.     self add: 'the "Add A Constraint" button will cause the program to'.
  49286.     self add: 'prompt for a constraint. After receiving it, the program'.
  49287.     self add: 'selects those transitions in the current table that satisfy'.
  49288.     self add: 'the new constraint, then displays them in the new table.'.
  49289.     self add: ' These constraints are cumulative so the resulting table'.
  49290.     self add: 'will be composed of transitions that satisfy ALL of the'.
  49291.     self add: 'given constraints.'.
  49292.     self add: ' A constraint can be composed of any number of'.
  49293.     self add: 'predicates as long as they are linked to each other using'.
  49294.     self add: 'the logical OR symbol ";". For example, if the user wished'.
  49295.     self add: 'to examine all transitions that begin in activity X1 or '.
  49296.     self add: 'activity X2, the user should type: "source(X1) ; source(X2)"'.
  49297.     self add: 'as the constraint.'.
  49298.     self nextln.
  49299.     self add: ' The following is a list of the valid predicates:'.
  49300.     self nextln.
  49301.     self add: ' finite() or f() -- '.
  49302.     self add: 'transitions with finite upper time bounds.'.
  49303.     self add: ' infinite() or i() -- '.
  49304.     self add: 'transitions with infinite upper time bounds.'.
  49305.     self add: ' upper(#) or u(#) -- '.
  49306.     self add: 'transitions with upper time bounds =< #.'.
  49307.     self add: ' lower(#) or l(#) -- '.
  49308.     self add: 'transitions with lower time bounds >= #.'.
  49309.     self add: ' named(label) or n(label) -- '.
  49310.     self add: 'transitions named <label>. A wildcard character * can be'.
  49311.     self add: 'be used to proceed or follow <label>.'.
  49312.     self add: ' source(X) or s(X) -- '.
  49313.     self add: 'transitions with source activity X.'.
  49314.     self add: ' destination(X) or dest(X) or d(X) -- '.
  49315.     self add: 'transitions with destination activity X.'.
  49316.     self add: ' sourceIn(X) or si(X) -- '.
  49317.     self add: 'transitions with source activity X or source activity within X.'.
  49318.     self add: ' destinationIn(X) or destIn(X) or di(X) -- '.
  49319.     self add: 'transitions with dest. activity X or dest. activity within X.'.
  49320.     self add: ' contains(E) or c(E) -- '.
  49321.     self add: 'transitions with guards and/or functions with instances of'.
  49322.     self add: 'the expression E.'.
  49323.     self nextln.
  49324.     self add: ' "Clear Constraints"'.
  49325.     self add: ' Clicking this button will remove all preceeding constraints'.
  49326.     self add: 'from the table.'.
  49327.     self nextln.
  49328.     self add: ' "List Constraints"'.
  49329.     self add: ' Clicking this button will display a list of the constraints'.
  49330.     self add: 'currently applied to the transition table being displayed.'.
  49331.     self nextln.
  49332.     self add: ' "File Out"'.
  49333.     self add: ' Clicking this button will output the current table display'.
  49334.     self add: 'to a specified file. The user has the option of including'.
  49335.     self add: 'additional information about the TTM such as, a list of the'.
  49336.     self add: 'activity and data variables and initial condition, the'.
  49337.     self add: 'notepad, and a heading. There is also the option to include'.
  49338.     self add: 'any constraints used to create the table.'.
  49339.     self nextln.
  49340.     self add: ' "Exit"'.
  49341.     self add: ' Clicking this button will exit the user from Query.'.
  49342.     self nextln.
  49343.     self add: ' "Help"'.
  49344.     self add: ' Clicking this button will cause this window to be created.'.
  49345.     ^self concludeWithNote: true! !
  49346.  
  49347. !HelpScreens methodsFor: 'help access'!
  49348. simulateInfo
  49349.     self begin: 'Simulating A TTM' withCenter: true.
  49350.     self add: ' Simulation provides a way of testing the operation of a '.
  49351.     self add: 'selected TTM. The simulation window is comprised of four'.
  49352.     self add: 'views. The largest of these is where the changing values of'.
  49353.     self add: 'the TTM variables are displayed. The most recent state of'.
  49354.     self add: 'these variables is displayed at the top of the view. A'.
  49355.     self add: 'transition from one state to another is displayed as an '.
  49356.     self add: 'upward pointing arrow between the states.'.
  49357.     self nextln.
  49358.     self add: '"Starting Condition"'.
  49359.     self add: '---------------'.
  49360.     self add: ' This view displays the values the variables'.
  49361.     self add: 'are initially given prior to simulation. These can be changed'.
  49362.     self add: 'by selecting a variable and then the middle mouse button'.
  49363.     self add: 'menu option. The user is then prompted for the new value'.
  49364.     self add: 'of the variable. The value of "True" for an activity variable'.
  49365.     self add: 'means here that the variable can be any value. This is useful'.
  49366.     self add: 'when the user does not want to specify a specific initial'.
  49367.     self add: 'activity for the TTM to be in.'.
  49368.     self nextln.
  49369.     self add: '"Stopping Condition"'.
  49370.     self add: '----------------'.
  49371.     self add: ' This view contains the condition for which'.
  49372.     self add: 'the simulation will STOP. After each transition, the simulator'.
  49373.     self add: 'will determine if the condition is met. The condition can be'.
  49374.     self add: 'edited in the same as the initial condition of the Specifying'.
  49375.     self add: 'IC window and should be expressed in the same syntax'.
  49376.     self add: 'as the initial condition.'.
  49377.     self nextln.
  49378.     self add: '"Elapsed Ticks"'.
  49379.     self add: '------------'.
  49380.     self add: ' This view displays the current clock time which is'.
  49381.     self add: 'incremented by the tick transition. There are two buttons'.
  49382.     self add: 'for the clock. One will reset the clock to zero. The other'.
  49383.     self add: 'will allow you to set it to whatever offset you desire.'.
  49384.     self nextln.
  49385.     self add: '"Start/Continue"'.
  49386.     self add: 'The simulation begins by clicking this button. The'.
  49387.     self add: 'user will then be presented with a list of the transitions'.
  49388.     self add: 'enabled in the current state (which is defined by the'.
  49389.     self add: 'current values of the TTM variables). Selecting one of these'.
  49390.     self add: 'causes the transition to be taken and the current state to'.
  49391.     self add: 'be changed. Tacked on to the end of the list of transitions'.
  49392.     self add: 'is the option STOP. By selecting this, the user can exit'.
  49393.     self add: 'gracefully from the current simulation. By clicking the Start/'.
  49394.     self add: 'Continue button again, the simulation can be resumed. If'.
  49395.     self add: 'STOP is not selected and the Stopping Condition is not'.
  49396.     self add: 'satisfied, the simulator will present a new list of transitions'.
  49397.     self add: 'and ask for another selection.'.
  49398.     self nextln.
  49399.     self add: '"Step"'.
  49400.     self add: 'This button allows the user to step through one'.
  49401.     self add: 'transition at a time. It does not consider the Stopping'.
  49402.     self add: 'Condition.'.
  49403.     self nextln.
  49404.     self add: '"Clear"'.
  49405.     self add: 'This button will clear the existing simulation run from'.
  49406.     self add: 'the view and reset the current state to the starting'.
  49407.     self add: 'condition.'.
  49408.     self nextln.
  49409.     self add: '"Status"'.
  49410.     self add: 'Clicking this button will display a list of the current'.
  49411.     self add: 'states of all the transitions in the TTM; that is,'.
  49412.     self add: 'whether they are currently disabled, pending, enabled,'.
  49413.     self add: 'or in a state where they must occur or be disabled'.
  49414.     self add: 'before another clock tick.'.
  49415.     self add: 'Details of a particular transition can be obtained by'.
  49416.     self add: 'selecting one of the transitions in the list displayed.'.
  49417.     self nextln.
  49418.     self add: '"File Out"'.
  49419.     self add: 'A simulation run can be written to a file by clicking this'.
  49420.     self add: 'button. There is also the option of including a title,'.
  49421.     self add: 'the notepad, the stopping and starting conditions used for'.
  49422.     self add: 'the run, and the number of ticks that elapsed during the'.
  49423.     self add: 'run.'.
  49424.     self nextln.
  49425.     self add: '"Exit"'.
  49426.     self add: 'Clicking this button will exit the user from the Simulator.'.
  49427.     self nextln.
  49428.     self add: '"Help"'.
  49429.     self add: 'Clicking this button causes this window to be created'.
  49430.     ^self concludeWithNote: true! !
  49431.  
  49432. !HelpScreens methodsFor: 'make text'!
  49433. add: aLine 
  49434.     | end |
  49435.     end := String with: Character cr.
  49436.     currentString := currentString , end , aLine! !
  49437.  
  49438. !HelpScreens methodsFor: 'make text'!
  49439. begin: aTitle withCenter: aBoolean 
  49440.     | length blanks |
  49441.     currentString := ''.
  49442.     length := aTitle size.
  49443.     blanks := ''.
  49444.     aBoolean = true & (length < 70) ifTrue: [(70 - length / 2) floor timesRepeat: [blanks := blanks , ' ']].
  49445.     currentTitle := blanks , aTitle.
  49446.     self add: currentTitle copy.
  49447.     "self nextln"! !
  49448.  
  49449. !HelpScreens methodsFor: 'make text'!
  49450. concludeWithNote: aBoolean 
  49451.     | end note |
  49452.     end := String with: Character cr.
  49453.     note := ' For more assistance please see the manual'.
  49454.     aBoolean = true
  49455.         ifTrue: 
  49456.             [currentString := currentString , end , end , end , note.
  49457.             currentString := currentString asText
  49458.                         emphasizeFrom: currentString size - note size
  49459.                         to: currentString size
  49460.                         with: #bold].
  49461.     currentString := currentString asText
  49462.                 emphasizeFrom: 1
  49463.                 to: currentTitle size + 1
  49464.                 with: #bold.
  49465.     ^currentString! !
  49466.  
  49467. !HelpScreens methodsFor: 'make text'!
  49468. nextln
  49469.     currentString := currentString , (String with: Character cr)! !
  49470.  
  49471. !HelpScreens methodsFor: 'initialize-release'!
  49472. initialize: aTransition 
  49473.  
  49474.      currentTr := aTransition! !
  49475.  
  49476. !HelpScreens methodsFor: 'transition access'!
  49477. transition
  49478.     | tr |
  49479.     tr := currentTr at: 1.
  49480.     self begin: (tr at: 1)
  49481.         withCenter: false.
  49482.     self add: 'guard: (' , (tr at: 2) , ')'.
  49483.     self add: 'function: [' , (tr at: 3) , ']'.
  49484.     self add: 'lower bound: ' , (tr at: 4).
  49485.     self add: 'upper bound: ' , (tr at: 5).
  49486.     self add: 'time elapsed: ' , (currentTr at: 2).
  49487.     ^self concludeWithNote: false! !
  49488.  
  49489. !HelpScreens methodsFor: 'button access'!
  49490. doEditInfo
  49491.  
  49492.      HelpScreens openHelp: 'editing'! !
  49493.  
  49494. !HelpScreens methodsFor: 'button access'!
  49495. doICInfo
  49496.  
  49497.      HelpScreens openHelp: 'specifying'! !
  49498.  
  49499. !HelpScreens methodsFor: 'button access'!
  49500. doQueryInfo
  49501.  
  49502.      HelpScreens openHelp: 'querying'! !
  49503.  
  49504. !HelpScreens methodsFor: 'button access'!
  49505. doSimulateInfo
  49506.  
  49507.      HelpScreens openHelp: 'simulating'! !
  49508.  
  49509. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  49510.  
  49511. HelpScreens class
  49512.     instanceVariableNames: ''!
  49513.  
  49514. !HelpScreens class methodsFor: 'instance creation'!
  49515. new
  49516.  
  49517.  
  49518.  
  49519.    ^super new! !
  49520.  
  49521. !HelpScreens class methodsFor: 'instance creation'!
  49522. new: aTransition
  49523.  
  49524.      ^super new initialize: aTransition! !
  49525.  
  49526. !HelpScreens class methodsFor: 'instance creation'!
  49527. openHelp: helptype
  49528.  
  49529.  
  49530.  
  49531.    self openHelp: self new which: helptype! !
  49532.  
  49533. !HelpScreens class methodsFor: 'instance creation'!
  49534. openHelp: aHelpScreen which: helptype 
  49535.  
  49536.     | window container noteView qButton left hsize top vsize h1Button h2Button h3Button h4Button |
  49537.  
  49538.     window := ScheduledWindow new.
  49539.  
  49540.     helptype = 'introduction' ifTrue: [window label: 'Introduction To Model Builder'].
  49541.  
  49542.     helptype = 'editing' ifTrue: [window label: 'Introduction To Editing'].
  49543.  
  49544.     helptype = 'querying' ifTrue: [window label: 'Introduction To Querying'].
  49545.  
  49546.     helptype = 'simulating' ifTrue: [window label: 'Introduction To Simulating'].
  49547.  
  49548.     helptype = 'specifying' ifTrue: [window label: 'Introduction To Specifying ICs'].
  49549.  
  49550.     window minimumSize: 400 @ 400.
  49551.  
  49552.     container := CompositePart new.
  49553.  
  49554.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  49555.  
  49556.         insideColor: ColorValue gray.
  49557.  
  49558.     helptype = 'introduction'
  49559.  
  49560.         ifTrue: [noteView := TextView
  49561.  
  49562.                         on: aHelpScreen
  49563.  
  49564.                         aspect: #helpInfo
  49565.  
  49566.                         change: nil
  49567.  
  49568.                         menu: nil]
  49569.  
  49570.         ifFalse: [helptype = 'editing'
  49571.  
  49572.                 ifTrue: [noteView := TextView
  49573.  
  49574.                                 on: aHelpScreen
  49575.  
  49576.                                 aspect: #editInfo
  49577.  
  49578.                                 change: nil
  49579.  
  49580.                                 menu: nil]
  49581.  
  49582.                 ifFalse: [helptype = 'querying'
  49583.  
  49584.                         ifTrue: [noteView := TextView
  49585.  
  49586.                                         on: aHelpScreen
  49587.  
  49588.                                         aspect: #queryInfo
  49589.  
  49590.                                         change: nil
  49591.  
  49592.                                         menu: nil]
  49593.  
  49594.                         ifFalse: [helptype = 'specifying'
  49595.  
  49596.                                 ifTrue: [noteView := TextView
  49597.  
  49598.                                                 on: aHelpScreen
  49599.  
  49600.                                                 aspect: #icInfo
  49601.  
  49602.                                                 change: nil
  49603.  
  49604.                                                 menu: nil]
  49605.  
  49606.                                 ifFalse: [noteView := TextView
  49607.  
  49608.                                                 on: aHelpScreen
  49609.  
  49610.                                                 aspect: #simulateInfo
  49611.  
  49612.                                                 change: nil
  49613.  
  49614.                                                 menu: nil]]]].
  49615.  
  49616.     (container add: (LookPreferences edgeDecorator on: noteView)
  49617.  
  49618.         borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.95))
  49619.  
  49620.         insideColor: ColorValue white.
  49621.  
  49622.     left := 0.0.
  49623.  
  49624.     hsize := 0.195.
  49625.  
  49626.     top := 0.95.
  49627.  
  49628.     vsize := 0.05.    "Button for quitting"
  49629.  
  49630.     qButton := PushButton named: 'Exit Help'.
  49631.  
  49632.     qButton model: ((PluggableAdaptor on: aHelpScreen)
  49633.  
  49634.             getBlock: [:model | false]
  49635.  
  49636.             putBlock: [:model :value | ScheduledControllers activeController close]
  49637.  
  49638.             updateBlock: [:model :value :parameter | false]).
  49639.  
  49640.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  49641.  
  49642.         insideColor: ColorValue white.
  49643.  
  49644.     helptype = 'introduction'
  49645.  
  49646.         ifTrue: 
  49647.  
  49648.             [left := left + hsize.
  49649.  
  49650.             h1Button := PushButton named: 'Help-Edit'.
  49651.  
  49652.             h1Button model: ((PluggableAdaptor on: aHelpScreen)
  49653.  
  49654.                     getBlock: [:model | false]
  49655.  
  49656.                     putBlock: [:model :value | model doEditInfo]
  49657.  
  49658.                     updateBlock: [:model :value :parameter | false]).
  49659.  
  49660.             (container add: h1Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  49661.  
  49662.                 insideColor: ColorValue white.
  49663.  
  49664.             left := left + hsize.
  49665.  
  49666.             h2Button := PushButton named: 'Help-Query'.
  49667.  
  49668.             h2Button model: ((PluggableAdaptor on: aHelpScreen)
  49669.  
  49670.                     getBlock: [:model | false]
  49671.  
  49672.                     putBlock: [:model :value | model doQueryInfo]
  49673.  
  49674.                     updateBlock: [:model :value :parameter | false]).
  49675.  
  49676.             (container add: h2Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize + 0.02; bottomFraction: top + vsize))
  49677.  
  49678.                 insideColor: ColorValue white.
  49679.  
  49680.             left := left + hsize + 0.02.
  49681.  
  49682.             h3Button := PushButton named: 'Help-Sim.'.
  49683.  
  49684.             h3Button model: ((PluggableAdaptor on: aHelpScreen)
  49685.  
  49686.                     getBlock: [:model | false]
  49687.  
  49688.                     putBlock: [:model :value | model doSimulateInfo]
  49689.  
  49690.                     updateBlock: [:model :value :parameter | false]).
  49691.  
  49692.             (container add: h3Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  49693.  
  49694.                 insideColor: ColorValue white.
  49695.  
  49696.             left := left + hsize.
  49697.  
  49698.             h4Button := PushButton named: 'Help-ICs'.
  49699.  
  49700.             h4Button model: ((PluggableAdaptor on: aHelpScreen)
  49701.  
  49702.                     getBlock: [:model | false]
  49703.  
  49704.                     putBlock: [:model :value | model doICInfo]
  49705.  
  49706.                     updateBlock: [:model :value :parameter | false]).
  49707.  
  49708.             (container add: h4Button borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: top; rightFraction: left + hsize; bottomFraction: top + vsize))
  49709.  
  49710.                 insideColor: ColorValue white].
  49711.  
  49712.     window component: container.
  49713.  
  49714.     window open! !
  49715.  
  49716. !HelpScreens class methodsFor: 'instance creation'!
  49717. openTable: aTransition
  49718.  
  49719.  
  49720.  
  49721.    self openTable: (self new: aTransition) for: aTransition! !
  49722.  
  49723. !HelpScreens class methodsFor: 'instance creation'!
  49724. openTable: aTrScreen for: currentTr 
  49725.  
  49726.     | window container noteView qButton |
  49727.  
  49728.     window := ScheduledWindow new.
  49729.  
  49730.     window label: 'Transition Info'.
  49731.  
  49732.     window minimumSize: 300 @ 150.
  49733.  
  49734.     container := CompositePart new.
  49735.  
  49736.     noteView := TextView
  49737.  
  49738.                 on: aTrScreen
  49739.  
  49740.                 aspect: #transition
  49741.  
  49742.                 change: nil
  49743.  
  49744.                 menu: nil.
  49745.  
  49746.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  49747.  
  49748.         insideColor: ColorValue gray.
  49749.  
  49750.     (container add: (LookPreferences edgeDecorator on: noteView)
  49751.  
  49752.         borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.85))
  49753.  
  49754.         insideColor: ColorValue white.    "Button for quitting"
  49755.  
  49756.     qButton := PushButton named: 'Exit Info Display'.
  49757.  
  49758.     qButton model: ((PluggableAdaptor on: aTrScreen)
  49759.  
  49760.             getBlock: [:model | false]
  49761.  
  49762.             putBlock: [:model :value | ScheduledControllers activeController close]
  49763.  
  49764.             updateBlock: [:model :value :parameter | false]).
  49765.  
  49766.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: 0.0; topFraction: 0.85; rightFraction: 0.195; bottomFraction: 1.0))
  49767.  
  49768.         insideColor: ColorValue white.
  49769.  
  49770.     window component: container.
  49771.  
  49772.     window open! !
  49773.  
  49774. !HelpScreens class methodsFor: 'decoration'!
  49775. buttonWrap: aLabel 
  49776.  
  49777.      | newLabel |
  49778.  
  49779.      newLabel := aLabel.
  49780.  
  49781.      newLabel insideColor: ColorValue white.
  49782.  
  49783.      "newLabel borderColor: ColorValue black."
  49784.  
  49785.      "newLabel borderWidth: 1."
  49786.  
  49787.      ^newLabel! !
  49788.  
  49789. Object subclass: #Box
  49790.     instanceVariableNames: 'point rectangle hide '
  49791.     classVariableNames: ''
  49792.     poolDictionaries: ''
  49793.     category: 'Build'!
  49794.  
  49795. !Box methodsFor: 'copying'!
  49796. makeCopy
  49797.     | temp |
  49798.     temp := self copy.
  49799.     temp depth: self depth copy.
  49800.     temp dimensions: self dimensions copy.
  49801.     temp location: self location copy.
  49802.     ^temp! !
  49803.  
  49804. !Box methodsFor: 'accessing'!
  49805. depth
  49806.  
  49807.      ^hide! !
  49808.  
  49809. !Box methodsFor: 'accessing'!
  49810. depth: newDepth 
  49811.  
  49812.      hide := newDepth! !
  49813.  
  49814. !Box methodsFor: 'accessing'!
  49815. dimensions
  49816.  
  49817.      ^rectangle! !
  49818.  
  49819. !Box methodsFor: 'accessing'!
  49820. dimensions: newRectangle
  49821.  
  49822.      rectangle := newRectangle! !
  49823.  
  49824. !Box methodsFor: 'accessing'!
  49825. location
  49826.  
  49827.      ^point! !
  49828.  
  49829. !Box methodsFor: 'accessing'!
  49830. location: newLocation 
  49831.  
  49832.      point := newLocation! !
  49833.  
  49834. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  49835.  
  49836. Box class
  49837.     instanceVariableNames: ''!
  49838.  
  49839. !Box class methodsFor: 'instance creation'!
  49840. point: aPoint rectangle: aRectangle 
  49841.  
  49842.      "default values for shade, depth and insides 
  49843.  
  49844.      are supplied automatically."
  49845.  
  49846.  
  49847.  
  49848.      | aBox |
  49849.  
  49850.      aBox := self new.
  49851.  
  49852.      aBox location: aPoint.
  49853.  
  49854.      aBox dimensions: aRectangle.
  49855.  
  49856.      aBox depth: #hidden.
  49857.  
  49858.      ^aBox! !
  49859.  
  49860. Model subclass: #TTMListWindow
  49861.     instanceVariableNames: ''
  49862.     classVariableNames: ''
  49863.     poolDictionaries: ''
  49864.     category: 'Build'!
  49865.  
  49866. !TTMListWindow methodsFor: 'closing'!
  49867. changeRequest
  49868.     ^DialogView confirm: 'Are you certain you want to quit?'! !
  49869.  
  49870. Model subclass: #TTM
  49871.     instanceVariableNames: 'ttmName note activityTree transitionList activityVariables dataVariables initialCondition specificIC commChannels stateFormulas currentAVCs openWindows temporary currentlyDisplayedSimulateVariables simulateWindow hiddenTransitions tempResult transitionDictionary '
  49872.     classVariableNames: ''
  49873.     poolDictionaries: ''
  49874.     category: 'Build'!
  49875. TTM comment:
  49876. 'Some Notes on the instance variables for this class:
  49877.  
  49878.    currentAVCS = a list used in processing transitions to keep
  49879.  
  49880. track of those
  49881.  
  49882.  guards/functions that have already been used in a previous
  49883.  
  49884. transition of
  49885.  
  49886.  a set of shared transitions. We do this to avoid duplication in
  49887.  
  49888. code
  49889.  
  49890.  generation of certain guard/function elements pertaining to
  49891.  
  49892. activity
  49893.  
  49894.  variables.'!
  49895.  
  49896. TTM comment:
  49897. 'Some Notes on the instance variables for this class:
  49898.  
  49899.    currentAVCS = a list used in processing transitions to keep
  49900.  
  49901. track of those
  49902.  
  49903.  guards/functions that have already been used in a previous
  49904.  
  49905. transition of
  49906.  
  49907.  a set of shared transitions. We do this to avoid duplication in
  49908.  
  49909. code
  49910.  
  49911.  generation of certain guard/function elements pertaining to
  49912.  
  49913. activity
  49914.  
  49915.  variables.'!
  49916.  
  49917. !TTM methodsFor: 'initialize-release'!
  49918. initialize: givenName with: variable 
  49919.     "Initialize the components of the newly created TTM"
  49920.  
  49921.     self named: givenName.
  49922.     activityTree := ActivityTree new.
  49923.     activityTree createRoot: givenName.
  49924.     transitionList := TransitionList new.
  49925.     activityVariables := OrderedCollection new.
  49926.     self activityvariable: variable initial: 'True'.
  49927.     activityTree getRoot av: (self activityvariable at: 1).
  49928.     activityTree getRoot selfAV: (self activityvariable at: 1).
  49929.       activityTree getRoot hasAV: true.
  49930.     self initialcondition: 'nil'.
  49931.     self note: String new.
  49932.     dataVariables := OrderedCollection new.
  49933.     commChannels := OrderedCollection new.
  49934.     stateFormulas := OrderedCollection new.
  49935.     specificIC := OrderedCollection new.
  49936.     openWindows := Array
  49937.                 with: 0
  49938.                 with: 0
  49939.                 with: 0
  49940.                 with: 0! !
  49941.  
  49942. !TTM methodsFor: 'obsolete'!
  49943. avValuesAt: source 
  49944.     "Return the set of activity variables and values for 
  49945.     
  49946.     the given activity called source. There may be 
  49947.     
  49948.     repetitions and there may be multiple values 
  49949.     
  49950.     possible for a given activity variable."
  49951.  
  49952.     | typeOfAV count current ancestorList currentAncestor completeSetOfValues |
  49953.     completeSetOfValues := OrderedCollection new.
  49954.     ancestorList := self activitytree ancestorListOf: source.
  49955.     ancestorList removeLast.
  49956.     count := ancestorList size.
  49957.     [count > 0]
  49958.         whileTrue: 
  49959.             [currentAncestor := ancestorList at: count.
  49960.             typeOfAV := self typeForAV: currentAncestor av.
  49961.             (typeOfAV includes: currentAncestor)
  49962.                 ifTrue: [completeSetOfValues add: (Array with: currentAncestor av with: currentAncestor myName)].
  49963.             count := count - 1].
  49964.     typeOfAV := self typeForAV: source av.
  49965.     (typeOfAV includes: source)
  49966.         ifTrue: [completeSetOfValues add: (Array with: source av with: source myName)]
  49967.         ifFalse: 
  49968.             [count := 1.
  49969.             [count > typeOfAV size]
  49970.                 whileFalse: 
  49971.                     [current := typeOfAV at: count.
  49972.                     (self activitytree is: source anAncestorOf: current)
  49973.                         ifTrue: [completeSetOfValues add: (Array with: source av with: current myName)].
  49974.                     count := count + 1]].
  49975.     ^completeSetOfValues! !
  49976.  
  49977. !TTM methodsFor: 'accessing'!
  49978. activitytree
  49979.  
  49980.      ^activityTree! !
  49981.  
  49982. !TTM methodsFor: 'accessing'!
  49983. activitytree: newTree
  49984.  
  49985.      activityTree := newTree! !
  49986.  
  49987. !TTM methodsFor: 'accessing'!
  49988. activityvariable
  49989.  
  49990.      "Return the activity variable of the TTM, self."
  49991.  
  49992.  
  49993.  
  49994.      ^activityVariables! !
  49995.  
  49996. !TTM methodsFor: 'accessing'!
  49997. activityvariable: wholeSet 
  49998.  
  49999.      activityVariables := wholeSet! !
  50000.  
  50001. !TTM methodsFor: 'accessing'!
  50002. activityvariable: newVariable initial: initialValue 
  50003.     "Assign a activity variable of the TTM, self."
  50004.  
  50005.     activityVariables add: (Array with: newVariable with: initialValue)! !
  50006.  
  50007. !TTM methodsFor: 'accessing'!
  50008. commchannel
  50009.  
  50010.      ^commChannels! !
  50011.  
  50012. !TTM methodsFor: 'accessing'!
  50013. commchannel: newChannel 
  50014.  
  50015.      commChannels add: (Array with: newChannel)! !
  50016.  
  50017. !TTM methodsFor: 'accessing'!
  50018. currentlyDisplayedSimulateVariables
  50019.  
  50020.      ^currentlyDisplayedSimulateVariables! !
  50021.  
  50022. !TTM methodsFor: 'accessing'!
  50023. currentlyDisplayedSimulateVariables: anArray 
  50024.  
  50025.      currentlyDisplayedSimulateVariables := anArray! !
  50026.  
  50027. !TTM methodsFor: 'accessing'!
  50028. datavariable
  50029.  
  50030.      "Return the data variables of the TTM, self."
  50031.  
  50032.  
  50033.  
  50034.      ^dataVariables! !
  50035.  
  50036. !TTM methodsFor: 'accessing'!
  50037. datavariable: wholeSet 
  50038.  
  50039.      dataVariables := wholeSet! !
  50040.  
  50041. !TTM methodsFor: 'accessing'!
  50042. datavariable: newVariable lrange: low hrange: high initial:
  50043.  
  50044. initialValue 
  50045.  
  50046.      "Assign a data variable of the TTM, self."
  50047.  
  50048.  
  50049.  
  50050.      dataVariables add: (Array
  50051.  
  50052.                with: newVariable
  50053.  
  50054.                with: low
  50055.  
  50056.                with: high
  50057.  
  50058.                   with: initialValue)! !
  50059.  
  50060. !TTM methodsFor: 'accessing'!
  50061. defaultOfAV: existingAV 
  50062.     | p |
  50063.     p := self anExistingAVsPosition: existingAV.
  50064.     (self typeForAV: (activityVariables at: p))
  50065.         do: [:x | x default = true ifTrue: [^x myName]].
  50066.     ^nil! !
  50067.  
  50068. !TTM methodsFor: 'accessing'!
  50069. initialcondition
  50070.  
  50071.      ^initialCondition! !
  50072.  
  50073. !TTM methodsFor: 'accessing'!
  50074. initialcondition: newcondition 
  50075.  
  50076.      initialCondition := newcondition! !
  50077.  
  50078. !TTM methodsFor: 'accessing'!
  50079. named
  50080.     "Return the name of the TTM, self."
  50081.  
  50082.     ^ttmName! !
  50083.  
  50084. !TTM methodsFor: 'accessing'!
  50085. named: newName
  50086.  
  50087.      "Assign the name of the TTM, self."
  50088.  
  50089.  
  50090.  
  50091.      ttmName := newName.! !
  50092.  
  50093. !TTM methodsFor: 'accessing'!
  50094. note
  50095.     ^note! !
  50096.  
  50097. !TTM methodsFor: 'accessing'!
  50098. note: aNote 
  50099.  
  50100.      note := aNote! !
  50101.  
  50102. !TTM methodsFor: 'accessing'!
  50103. openWindows
  50104.     ^openWindows! !
  50105.  
  50106. !TTM methodsFor: 'accessing'!
  50107. openWindows: newWindows
  50108.  
  50109.      openWindows := newWindows! !
  50110.  
  50111. !TTM methodsFor: 'accessing'!
  50112. simulateWindow
  50113.  
  50114.      ^simulateWindow! !
  50115.  
  50116. !TTM methodsFor: 'accessing'!
  50117. simulateWindow: aWindow 
  50118.  
  50119.      simulateWindow := aWindow! !
  50120.  
  50121. !TTM methodsFor: 'accessing'!
  50122. specificIC
  50123.  
  50124.      ^specificIC! !
  50125.  
  50126. !TTM methodsFor: 'accessing'!
  50127. specificIC: newIC
  50128.  
  50129.      specificIC := newIC! !
  50130.  
  50131. !TTM methodsFor: 'accessing'!
  50132. stateFormulas
  50133.  
  50134.      ^stateFormulas! !
  50135.  
  50136. !TTM methodsFor: 'accessing'!
  50137. stateFormulas: completelyNew 
  50138.  
  50139.      stateFormulas := completelyNew! !
  50140.  
  50141. !TTM methodsFor: 'accessing'!
  50142. stateFormulas: sfNumber holding: newFormula
  50143.  
  50144.      stateFormulas add: (Array with: sfNumber with: newFormula)! !
  50145.  
  50146. !TTM methodsFor: 'accessing'!
  50147. transitionlist
  50148.  
  50149. ^transitionList! !
  50150.  
  50151. !TTM methodsFor: 'accessing'!
  50152. transitionlist: newList 
  50153.  
  50154.      transitionList := newList! !
  50155.  
  50156. !TTM methodsFor: 'variable maintenance'!
  50157. anExistingActivityName: aString 
  50158.     ^activityTree activityNames includes: aString! !
  50159.  
  50160. !TTM methodsFor: 'variable maintenance'!
  50161. anExistingAV2: aString 
  50162.     "Return true if aString is one of the existing activity 
  50163.     
  50164.     variables of the TTM."
  50165.  
  50166.     self activityvariable do: [:x | aString = (x at: 1) ifTrue: [^true]].
  50167.     ^false! !
  50168.  
  50169. !TTM methodsFor: 'variable maintenance'!
  50170. anExistingAV: aString 
  50171.     "Return true if aString is one of the existing activity 
  50172.     
  50173.     variables of the TTM."
  50174.  
  50175.     | found count existingAV |
  50176.     found := false.
  50177.     self activityvariable size = 0
  50178.         ifFalse: 
  50179.             [count := 1.
  50180.             self activityvariable size
  50181.                 timesRepeat: 
  50182.                     [existingAV := self activityvariable at: count.
  50183.                     aString = (existingAV at: 1) ifTrue: [found := true].
  50184.                     count := count + 1]].
  50185.     ^found! !
  50186.  
  50187. !TTM methodsFor: 'variable maintenance'!
  50188. anExistingAVsPosition: aString 
  50189.     | count existingAV |
  50190.     self activityvariable size = 0
  50191.         ifFalse: 
  50192.             [count := 1.
  50193.             self activityvariable size
  50194.                 timesRepeat: 
  50195.                     [existingAV := self activityvariable at: count.
  50196.                     aString = (existingAV at: 1) ifTrue: [^count].
  50197.                     count := count + 1]].
  50198.     ^nil! !
  50199.  
  50200. !TTM methodsFor: 'variable maintenance'!
  50201. anExistingCh: aString 
  50202.     "Return true if aString is one of the existing comm. 
  50203.     
  50204.     channels of the TTM."
  50205.  
  50206.     | found count existingCh |
  50207.     found := false.
  50208.     self commchannel size = 0
  50209.         ifFalse: 
  50210.             [count := 1.
  50211.             self commchannel size
  50212.                 timesRepeat: 
  50213.                     [existingCh := self commchannel at: count.
  50214.                     aString = (existingCh at: 1) ifTrue: [found := true].
  50215.                     count := count + 1]].
  50216.     ^found! !
  50217.  
  50218. !TTM methodsFor: 'variable maintenance'!
  50219. anExistingDV2: aString 
  50220.     "Return true if aString is one of the existing activity 
  50221.     
  50222.     variables of the TTM."
  50223.  
  50224.     self datavariable do: [:x | aString = (x at: 1) ifTrue: [^true]].
  50225.     ^false! !
  50226.  
  50227. !TTM methodsFor: 'variable maintenance'!
  50228. anExistingDV: aString 
  50229.     "Return true if aString is one of the existing data 
  50230.     
  50231.     variables of the TTM."
  50232.  
  50233.     | found count existingDV |
  50234.     found := false.
  50235.     self datavariable size = 0
  50236.         ifFalse: 
  50237.             [count := 1.
  50238.             self datavariable size
  50239.                 timesRepeat: 
  50240.                     [existingDV := self datavariable at: count.
  50241.                     aString = (existingDV at: 1) ifTrue: [found := true].
  50242.                     count := count + 1]].
  50243.     ^found! !
  50244.  
  50245. !TTM methodsFor: 'variable maintenance'!
  50246. anExistingDVsPosition: aString 
  50247.  
  50248.     "Return position if aString is one of the existing data 
  50249.  
  50250.     variables of the TTM."
  50251.  
  50252.  
  50253.  
  50254.     | count existingDV |
  50255.  
  50256.     self datavariable size = 0
  50257.  
  50258.         ifFalse: 
  50259.  
  50260.             [count := 1.
  50261.  
  50262.             self datavariable size
  50263.  
  50264.                 timesRepeat: 
  50265.  
  50266.                     [existingDV := self datavariable at: count.
  50267.  
  50268.                     aString = (existingDV at: 1) ifTrue: [^count].
  50269.  
  50270.                     count := count + 1]].
  50271.  
  50272.     ^nil! !
  50273.  
  50274. !TTM methodsFor: 'variable maintenance'!
  50275. anExistingSF: aString 
  50276.     | found count existingSF |
  50277.     found := false.
  50278.     self stateFormulas size = 0
  50279.         ifFalse: 
  50280.             [count := 1.
  50281.             self stateFormulas size
  50282.                 timesRepeat: 
  50283.                     [existingSF := self stateFormulas at: count.
  50284.                     aString = (existingSF at: 1) ifTrue: [found := true].
  50285.                     count := count + 1]].
  50286.     ^found! !
  50287.  
  50288. !TTM methodsFor: 'variable maintenance'!
  50289. anExistingV: aString 
  50290.     "Return true if aString is one of the existing 
  50291.     
  50292.     variables of the TTM."
  50293.  
  50294.     (self anExistingAV: aString)
  50295.         ifTrue: [^true]
  50296.         ifFalse: [^self anExistingDV: aString]! !
  50297.  
  50298. !TTM methodsFor: 'variable maintenance'!
  50299. changeAllAVsAt: start from: oldAV to: newAV 
  50300.     "Because each activity has a pointer to an object 
  50301.     
  50302.     and not an object itself, we must replace all of 
  50303.     
  50304.     those pointers."
  50305.  
  50306.     start left ~= nil ifTrue: [self
  50307.             changeAllAVsAt: start left
  50308.             from: oldAV
  50309.             to: newAV].
  50310.     start right ~= nil ifTrue: [self
  50311.             changeAllAVsAt: start right
  50312.             from: oldAV
  50313.             to: newAV].
  50314.     start av = oldAV ifTrue: [start av: newAV]! !
  50315.  
  50316. !TTM methodsFor: 'variable maintenance'!
  50317. changeDefaultForAV: anAV to: anActivity 
  50318.     activityVariables do: [:x | (x at: 1)  = anAV 
  50319.             ifTrue: 
  50320.                 [x at: 2 put: anActivity myName.
  50321.                 ^nil]]! !
  50322.  
  50323. !TTM methodsFor: 'variable maintenance'!
  50324. checkAllAVsStillUsed
  50325.     | count currentAV |
  50326.     count := 1.
  50327.     [count > self activityvariable size]
  50328.         whileFalse: 
  50329.             [currentAV := (self activityvariable at: count)
  50330.                         at: 1.
  50331.             temporary := false.
  50332.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  50333.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  50334.                 ifTrue: [count := count + 1] ]! !
  50335.  
  50336. !TTM methodsFor: 'variable maintenance'!
  50337. checkAllAVsStillUsedNew
  50338.     | count currentAV |
  50339.     count := 1.
  50340.     [count > self activityvariable size]
  50341.         whileFalse: 
  50342.             [currentAV := (self activityvariable at: count)
  50343.                         at: 1.
  50344.             temporary := false.
  50345.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  50346.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  50347.                 ifTrue: [count := count + 1] ]! !
  50348.  
  50349. !TTM methodsFor: 'variable maintenance'!
  50350. checkAllAVsStillUsedOld
  50351.     | count currentAV |
  50352.     count := 1.
  50353.     [count > self activityvariable size]
  50354.         whileFalse: 
  50355.             [currentAV := (self activityvariable at: count)
  50356.                         at: 1.
  50357.             temporary := false.
  50358.             self thisAVIsUsed: currentAV from: self activitytree getRoot.
  50359.             temporary = true ifFalse: [self activityvariable removeAtIndex: count]
  50360.                 ifTrue: [count := count + 1] ]! !
  50361.  
  50362. !TTM methodsFor: 'variable maintenance'!
  50363. isInAVRange: aString of: anAVname 
  50364.  
  50365.     | position |
  50366.  
  50367.     position := self anExistingAVsPosition: anAVname.
  50368.  
  50369.     position notNil ifTrue: [^self name: aString alreadyExistsFor: (self activityvariable at: position)].
  50370.  
  50371.     ^false! !
  50372.  
  50373. !TTM methodsFor: 'variable maintenance'!
  50374. isInDVRange: initial of: aDVname 
  50375.  
  50376.     | position newval lowRange highRange lowval highval |
  50377.  
  50378.     position := self anExistingDVsPosition: aDVname.
  50379.  
  50380.     position notNil ifFalse: [^false]
  50381.  
  50382.         ifTrue: 
  50383.  
  50384.             [initial ~= 'infinity' & (initial ~= '-infinity' & (TTMList aValidNumber: initial)) ifFalse: [^false].
  50385.  
  50386.             newval := TTMList convertToNumber: initial.
  50387.  
  50388.             lowRange := (self datavariable at: position)
  50389.  
  50390.                         at: 2.
  50391.  
  50392.             highRange := (self datavariable at: position)
  50393.  
  50394.                         at: 3.
  50395.  
  50396.             lowRange ~= '-infinity'
  50397.  
  50398.                 ifTrue: 
  50399.  
  50400.                     [lowval := TTMList convertToNumber: lowRange.
  50401.  
  50402.                     lowval > newval ifTrue: [^false]].
  50403.  
  50404.             highRange ~= 'infinity'
  50405.  
  50406.                 ifTrue: 
  50407.  
  50408.                     [highval := TTMList convertToNumber: highRange.
  50409.  
  50410.                     highval < newval ifTrue: [^false]]].
  50411.  
  50412.     ^true! !
  50413.  
  50414. !TTM methodsFor: 'variable maintenance'!
  50415. markActivitiesUnexposed
  50416.  
  50417.     | temp |
  50418.  
  50419.     temp := self activitytree getRoot.
  50420.  
  50421.     [temp notNil]
  50422.  
  50423.         whileTrue: 
  50424.  
  50425.             [temp exposed: False.
  50426.  
  50427.             self markKidsUnexposed: temp.
  50428.  
  50429.             temp := temp right]! !
  50430.  
  50431. !TTM methodsFor: 'variable maintenance'!
  50432. markKidsUnexposed: anActivity 
  50433.  
  50434.     | temp |
  50435.  
  50436.     temp := anActivity left.
  50437.  
  50438.     [temp notNil]
  50439.  
  50440.         whileTrue: 
  50441.  
  50442.             [temp exposed: False.
  50443.  
  50444.             self markSiblingsUnexposed: temp.
  50445.  
  50446.             temp := temp left]! !
  50447.  
  50448. !TTM methodsFor: 'variable maintenance'!
  50449. markSiblingsUnexposed: anActivity 
  50450.  
  50451.     | temp |
  50452.  
  50453.     temp := anActivity right.
  50454.  
  50455.     [temp notNil]
  50456.  
  50457.         whileTrue: 
  50458.  
  50459.             [temp exposed: False.
  50460.  
  50461.             self markKidsUnexposed: temp.
  50462.  
  50463.             temp := temp right]! !
  50464.  
  50465. !TTM methodsFor: 'variable maintenance'!
  50466. removeActivityVariableNamed: aName 
  50467.     | newAVs |
  50468.     aName isNil ifTrue: [^nil].
  50469.     newAVs := OrderedCollection new.
  50470.     activityVariables do: [:x | (x at: 1)
  50471.             ~= aName ifTrue: [newAVs add: x]].
  50472.     activityVariables := newAVs.
  50473.     activityTree listOfActivities do: [:x | ((x selfAV) at: 1) = aName ifTrue: [ x hasAV: false]]! !
  50474.  
  50475. !TTM methodsFor: 'variable maintenance'!
  50476. specificIC: currentIC contains: oldName 
  50477.     "If true, it returns the value. If false 
  50478.     
  50479.     it returns nil"
  50480.  
  50481.     | c found value |
  50482.     c := 1.
  50483.     found := false.
  50484.     [c > currentIC size]
  50485.         whileFalse: 
  50486.             [((currentIC at: c)
  50487.                 at: 1)
  50488.                 = oldName
  50489.                 ifTrue: 
  50490.                     [value := (currentIC at: c)
  50491.                                 at: 2.
  50492.                     found := true].
  50493.             c := c + 1].
  50494.     found = false
  50495.         ifTrue: [^nil]
  50496.         ifFalse: [^value]! !
  50497.  
  50498. !TTM methodsFor: 'variable maintenance'!
  50499. typeForAV: anAV 
  50500.     "Return the set of activities that belong to this AV"
  50501.  
  50502.     | start |
  50503.     temporary := nil.
  50504.     self firstActivitywith: anAV from: self activitytree getRoot.
  50505.     start := temporary.
  50506.     start isNil ifTrue: [^nil].
  50507.     temporary := OrderedCollection new.
  50508.     self avElement: start usingOnly: anAV.
  50509.     temporary size = 0
  50510.         ifTrue: [^nil]
  50511.         ifFalse: [^temporary]! !
  50512.  
  50513. !TTM methodsFor: 'variable maintenance'!
  50514. typeForAVNamed2: aString 
  50515.  
  50516.     "Return the set of activities that belong to this AV"
  50517.  
  50518.  
  50519.  
  50520.     | p t list |
  50521.  
  50522.     list := OrderedCollection new.
  50523.  
  50524.     p := self anExistingAVsPosition: aString.
  50525.  
  50526.     t := self typeForAV: (activityVariables at: p).
  50527.  
  50528.     t do: [:act | list add: act].
  50529.  
  50530.     ^list! !
  50531.  
  50532. !TTM methodsFor: 'variable maintenance'!
  50533. typeForAVNamed3: aString 
  50534.     "Return the set of names of activities that belong to this 
  50535.     
  50536.     AV"
  50537.  
  50538.     | p t list |
  50539.     list := SortedCollection new.
  50540.     list sortBlock: [:x :y | x myName < y myName].
  50541.     p := self anExistingAVsPosition: aString.
  50542.     t := self typeForAV: (activityVariables at: p).
  50543.     t do: [:act | list add: act].
  50544.     ^list! !
  50545.  
  50546. !TTM methodsFor: 'variable maintenance'!
  50547. typeForAVNamed: aString 
  50548.     "Return the set of names of activities that belong to this 
  50549.     
  50550.     AV"
  50551.  
  50552.     | p t list |
  50553.     list := OrderedCollection new.
  50554.     p := self anExistingAVsPosition: aString.
  50555.     t := self typeForAV: (activityVariables at: p).
  50556.     t do: [:act | list add: act myName].
  50557.     ^list! !
  50558.  
  50559. !TTM methodsFor: 'variable maintenance'!
  50560. updateSpecificIC
  50561.     "This is called after deletion or addition of 
  50562.     
  50563.     a variable."
  50564.  
  50565.     | dataCount count currentIC oldName initialValue value actCount newCurrentIC temp |
  50566.     count := 1.
  50567.     [count > self specificIC size]
  50568.         whileFalse: 
  50569.             [currentIC := (self specificIC at: count)
  50570.                         at: 2.
  50571.             newCurrentIC := OrderedCollection new.
  50572.             actCount := 1.
  50573.             [actCount > self activityvariable size]
  50574.                 whileFalse: 
  50575.                     [oldName := (self activityvariable at: actCount)
  50576.                                 at: 1.
  50577.                     (temp := self typeForAV: (self activityvariable at: actCount)) notNil ifTrue: [initialValue := temp last myName].
  50578.                     value := self specificIC: currentIC contains: oldName.
  50579.                     value isNil ifTrue: [value := initialValue].
  50580.                     newCurrentIC add: (Array with: oldName with: value).
  50581.                     actCount := actCount + 1].
  50582.             dataCount := 1.
  50583.             [dataCount > self datavariable size]
  50584.                 whileFalse: 
  50585.                     [oldName := (self datavariable at: dataCount)
  50586.                                 at: 1.
  50587.                     initialValue := (self datavariable at: dataCount)
  50588.                                 at: 4.
  50589.                     value := self specificIC: currentIC contains: oldName.
  50590.                     value isNil ifTrue: [value := initialValue].
  50591.                     newCurrentIC add: (Array with: oldName with: value).
  50592.                     dataCount := dataCount + 1].
  50593.             (self specificIC at: count)
  50594.                 at: 2 put: newCurrentIC.
  50595.             count := count + 1]! !
  50596.  
  50597. !TTM methodsFor: 'variable maintenance'!
  50598. variableIsBeingUsed: vName 
  50599.  
  50600.     "Return true if the given variable is used within 
  50601.  
  50602.     initial condition, guard, or function of the TTM."
  50603.  
  50604.  
  50605.  
  50606.     | result count currentTr currentSF |
  50607.  
  50608.     result := false.
  50609.  
  50610.     (self initialcondition asString findString: vName startingAt: 1)
  50611.  
  50612.         ~= 0 ifTrue: [result := true].
  50613.  
  50614.     result = false
  50615.  
  50616.         ifTrue: 
  50617.  
  50618.             [count := 1.
  50619.  
  50620.             [count > self stateFormulas size]
  50621.  
  50622.                 whileFalse: 
  50623.  
  50624.                     [currentSF := (self stateFormulas at: count)
  50625.  
  50626.                                 at: 2.
  50627.  
  50628.                     (currentSF findString: vName startingAt: 1)
  50629.  
  50630.                         ~= 0 ifTrue: [result := true].
  50631.  
  50632.                     count := count + 1]].
  50633.  
  50634.     result = false
  50635.  
  50636.         ifTrue: 
  50637.  
  50638.             [count := 1.
  50639.  
  50640.             [count > self transitionlist size]
  50641.  
  50642.                 whileFalse: 
  50643.  
  50644.                     [currentTr := self transitionlist at: count.
  50645.  
  50646.                     (currentTr myGuard asString findString: vName startingAt: 1)
  50647.  
  50648.                         ~= 0 ifTrue: [result := true].
  50649.  
  50650.                     (currentTr myAction asString findString: vName startingAt: 1)
  50651.  
  50652.                         ~= 0 ifTrue: [result := true].
  50653.  
  50654.                     count := count + 1]].
  50655.  
  50656.     ^result! !
  50657.  
  50658. !TTM methodsFor: 'renaming support'!
  50659. collectTokensFrom: aString usingParser: aParser 
  50660.     | x t r |
  50661.     r := OrderedCollection new.
  50662.     x := aParser.
  50663.     x initScannerSource: aString.
  50664.     [(t := x nextTokenValue) ~= x endOfInputToken]
  50665.         whileTrue: 
  50666.             [r add: t.
  50667.             x scanner scanToken].
  50668.     ^r! !
  50669.  
  50670. !TTM methodsFor: 'ttm copier'!
  50671. aCopy
  50672.     | newTTM reformattedlist count dict currentTr newStart newEnd newTr newTree newAVs currentAV newAV newSIC temp1 temp2 |
  50673.     newTTM := self copy.
  50674.     newTree := self activitytree copy.
  50675.     newTree newRoot: self activitytree makeCopy.
  50676.     dict := newTree listOfActivities.
  50677.     temporary := self activitytree listOfActivities.
  50678.     newAVs := self copyActivityVariables.
  50679.     count := 1.
  50680.     [count > self activityvariable size]
  50681.         whileFalse: 
  50682.             [currentAV := self activityvariable at: count.
  50683.             newAV := newAVs at: count.
  50684.             self
  50685.                 change: currentAV
  50686.                 to: newAV
  50687.                 inSetOf: dict.
  50688.             count := count + 1].
  50689.     reformattedlist := TransitionList new.
  50690.     count := 1.
  50691.     [count > self transitionlist size]
  50692.         whileFalse: 
  50693.             [currentTr := self transitionlist at: count.
  50694.             newStart := dict at: (self copyNumberFor: currentTr startingAt).
  50695.             newEnd := dict at: (self copyNumberFor: currentTr endingAt).
  50696.             newTr := Transition
  50697.                         name: currentTr myName copy
  50698.                         startAt: newStart
  50699.                         endAt: newEnd
  50700.                         upper: currentTr boundUpper copy
  50701.                         lower: currentTr boundLower copy
  50702.                         guard: currentTr myGuard copy
  50703.                         action: currentTr myAction copy.
  50704.             newTr myArc: currentTr myArc makeCopy.
  50705.             newTr depth: currentTr depth copy.
  50706.             newTr shared: currentTr shared copy.
  50707.             newTr defaultDestinationAssignments: Dictionary new.
  50708.             newTr defaultSourceAssignments: Dictionary new.
  50709.             currentTr defaultDestinationAssignments notNil ifTrue: [currentTr defaultDestinationAssignments associations do: [:x | newTr defaultDestinationAssignments add: x key -> (dict at: (self copyNumberFor: x value))]].
  50710.             currentTr defaultSourceAssignments notNil ifTrue: [currentTr defaultSourceAssignments associations do: [:x | newTr defaultSourceAssignments add: x key -> (dict at: (self copyNumberFor: x value))]].
  50711.             reformattedlist add: newTr.
  50712.             count := count + 1].
  50713.     newTTM named: newTTM named copy.
  50714.     newTTM transitionlist: reformattedlist.
  50715.     newTTM activitytree: newTree.
  50716.     newTTM activityvariable: newAVs.
  50717.     newTTM datavariable: self copyDataVariables.
  50718.     newTTM initialcondition: self initialcondition copy.
  50719.     newTTM note: self note copy.
  50720.     newSIC := OrderedCollection new.
  50721.     self specificIC
  50722.         do: 
  50723.             [:x | 
  50724.             temp1 := Array new: 2.
  50725.             temp1 at: 1 put: (x at: 1) copy.
  50726.             temp2 := OrderedCollection new.
  50727.             (x at: 2)
  50728.                 do: [:y | temp2 add: y copy].
  50729.             temp1 at: 2 put: temp2.
  50730.             newSIC add: temp1].
  50731.     newTTM specificIC: newSIC.
  50732.     ^newTTM! !
  50733.  
  50734. !TTM methodsFor: 'ttm copier'!
  50735. change: oldav to: newav inSetOf: activities 
  50736.     | count current |
  50737.     count := 1.
  50738.     [count > activities size]
  50739.         whileFalse: 
  50740.             [current := activities at: count.
  50741.             (current av at: 1)
  50742.                 = (oldav at: 1) ifTrue: [current av: newav].
  50743.             count := count + 1]! !
  50744.  
  50745. !TTM methodsFor: 'ttm copier'!
  50746. copyActivityVariables
  50747.     "Return a new set of activity variables"
  50748.  
  50749.     | oldset count newset current e1 e2 element |
  50750.     oldset := self activityvariable.
  50751.     count := 1.
  50752.     newset := OrderedCollection new.
  50753.     [count > oldset size]
  50754.         whileFalse: 
  50755.             [current := oldset at: count.
  50756.             e1 := (current at: 1) copy.
  50757.             e2 := (current at: 2) copy.
  50758.             element := Array with: e1 with: e2.
  50759.             newset add: element.
  50760.             count := count + 1].
  50761.     ^newset! !
  50762.  
  50763. !TTM methodsFor: 'ttm copier'!
  50764. copyDataVariables
  50765.     "Return a new set of data variables"
  50766.  
  50767.     | oldset count newset current e1 e2 e3 e4 element |
  50768.     oldset := self datavariable.
  50769.     count := 1.
  50770.     newset := OrderedCollection new.
  50771.     [count > oldset size]
  50772.         whileFalse: 
  50773.             [current := oldset at: count.
  50774.             e1 := (current at: 1) copy.
  50775.             e2 := (current at: 2) copy.
  50776.             e3 := (current at: 3) copy.
  50777.             e4 := (current at: 4) copy.
  50778.             element := Array
  50779.                         with: e1
  50780.                         with: e2
  50781.                         with: e3
  50782.                         with: e4.
  50783.             newset add: element.
  50784.             count := count + 1].
  50785.     ^newset! !
  50786.  
  50787. !TTM methodsFor: 'ttm copier'!
  50788. copyNumberFor: anActivity 
  50789.     "Return the index number for the activity"
  50790.  
  50791.     | count found |
  50792.     count := 1.
  50793.     found := false.
  50794.     [count > temporary size | (found = true)]
  50795.         whileFalse: 
  50796.             [found := (temporary at: count)
  50797.                         = anActivity.
  50798.             found = true ifFalse: [count := count + 1]].
  50799.     found = true
  50800.         ifTrue: [^count]
  50801.         ifFalse: [^0]! !
  50802.  
  50803. !TTM methodsFor: 'ttm copier'!
  50804. renameActivityVariable: avName to: newName 
  50805.     | t1 t2 temp |
  50806.     transitionList
  50807.         do: 
  50808.             [:x | 
  50809.             (t1 := x defaultDestinationAssignments) notNil
  50810.                 ifTrue: 
  50811.                     [temp := t1 removeKey: avName ifAbsent: [nil].
  50812.                     temp notNil ifTrue: [t1 add: newName -> temp]].
  50813.             (t2 := x defaultSourceAssignments) notNil
  50814.                 ifTrue: 
  50815.                     [temp := t2 removeKey: avName ifAbsent: [nil].
  50816.                     temp notNil ifTrue: [t2 add: newName -> temp]]].
  50817.     activityTree listOfActivities do: [:x | x hasAV ifTrue: [(x selfAV at: 1)
  50818.                 = avName ifTrue: [x selfAV at: 1 put: newName]]]! !
  50819.  
  50820. !TTM methodsFor: 'ttm copier'!
  50821. restoreNecessarySelfReferences: aTTMList 
  50822.     | t |
  50823.     t := aTTMList tempStack.
  50824.     simulateWindow := t last! !
  50825.  
  50826. !TTM methodsFor: 'ttm copier'!
  50827. saveNecessarySelfReferences: aTTMList 
  50828.     | t |
  50829.     aTTMList tempStack: OrderedCollection new.
  50830.     t := aTTMList tempStack.
  50831.     t addLast: simulateWindow.
  50832.     simulateWindow := nil! !
  50833.  
  50834. !TTM methodsFor: 'file out'!
  50835. fileHeading: aHeading on: aStream 
  50836.     aStream nextPutAll: '%'; cr; nextPutAll: '%'; cr.
  50837.     aStream nextPutAll: '%  ' , aHeading.
  50838.     aStream cr; nextPutAll: '%'; cr; nextPutAll: '%'; cr! !
  50839.  
  50840. !TTM methodsFor: 'file out'!
  50841. fileLine: current on: aStream 
  50842.  
  50843.      aStream nextPutAll: current.
  50844.  
  50845.      aStream cr! !
  50846.  
  50847. !TTM methodsFor: 'file out'!
  50848. fileNotePadOn: aStream 
  50849.     | noteTable count line noteText location |
  50850.     noteTable := OrderedCollection new.
  50851.     noteText := self note asString.
  50852.     noteText size > 0
  50853.         ifTrue: 
  50854.             [count := 1.
  50855.             location := noteText findString: (String with: Character cr)
  50856.                         startingAt: count.
  50857.             location ~= 0 ifFalse: [noteTable add: '% ' , noteText]
  50858.                 ifTrue: 
  50859.                     [[location ~= 0 & (count > noteText size) not]
  50860.                         whileTrue: 
  50861.                             [line := noteText copyFrom: count to: location - 1.
  50862.                             noteTable add: '% ' , line.
  50863.                             count := location + 1.
  50864.                             count > noteText size ifFalse: [location := noteText findString: (String with: Character cr)
  50865.                                             startingAt: count]].
  50866.                     count >= noteText size
  50867.                         ifFalse: 
  50868.                             [line := noteText copyFrom: count to: noteText size.
  50869.                             noteTable add: '% ' , line]].
  50870.             self fileThis: noteTable on: aStream]! !
  50871.  
  50872. !TTM methodsFor: 'file out'!
  50873. fileThis: aTable on: aStream 
  50874.     "Given a table of lines we want to write them to 
  50875.     
  50876.     the given stream."
  50877.  
  50878.     | count current |
  50879.     count := 1.
  50880.     aTable isNil ifFalse: [[count > aTable size]
  50881.             whileFalse: 
  50882.                 [current := aTable at: count.
  50883.                 aStream nextPutAll: current.
  50884.                 aStream cr.
  50885.                 count := count + 1]]! !
  50886.  
  50887. !TTM methodsFor: 'file out'!
  50888. fileTitle: aHeading on: aStream 
  50889.     | blank newHeading length leftmargin |
  50890.     blank := ''.
  50891.     75
  50892.         timesRepeat: 
  50893.             [aStream nextPutAll: '%'.
  50894.             blank := blank , ' '].
  50895.     aStream cr.
  50896.     blank at: 1 put: $%.
  50897.     blank at: 75 put: $%.
  50898.     aStream nextPutAll: blank; cr; nextPutAll: blank; cr.
  50899.     newHeading := blank copy.
  50900.     length := aHeading size.
  50901.     length <= 70
  50902.         ifTrue: 
  50903.             [leftmargin := (71 - length / 2) floor + 2.
  50904.             newHeading
  50905.                 replaceFrom: leftmargin
  50906.                 to: leftmargin + length - 1
  50907.                 with: aHeading]
  50908.         ifFalse: [newHeading := '%' , aHeading].
  50909.     aStream nextPutAll: newHeading; cr.
  50910.     aStream nextPutAll: blank; cr; nextPutAll: blank; cr.
  50911.     75 timesRepeat: [aStream nextPutAll: '%'].
  50912.     aStream cr! !
  50913.  
  50914. !TTM methodsFor: 'file out'!
  50915. getDirectory
  50916.     | temp |
  50917.     (temp := TTMList currentDirectory) isNil
  50918.         ifTrue: [^Filename currentDirectory]
  50919.         ifFalse: [^temp]! !
  50920.  
  50921. !TTM methodsFor: 'private'!
  50922. avElement: start usingOnly: anAV 
  50923.     start left ~= nil ifTrue: [self avElement: start left usingOnly: anAV].
  50924.     start right ~= nil ifTrue: [self avElement: start right usingOnly: anAV].
  50925.     start left isNil
  50926.         ifTrue: [(start av at: 1)
  50927.                 = (anAV at: 1) ifTrue: [temporary add: start]]
  50928.         ifFalse: [(start av at: 1)
  50929.                 = (anAV at: 1) & ((start left av at: 1)
  50930.                     ~= (anAV at: 1)) ifTrue: [temporary add: start]]! !
  50931.  
  50932. !TTM methodsFor: 'private'!
  50933. firstActivitywith: targetAV from: start 
  50934.     (start av at: 1)
  50935.         = (targetAV at: 1) & temporary isNil ifTrue: [temporary := start].
  50936.     temporary isNil & (start right ~= nil) ifTrue: [self firstActivitywith: targetAV from: start right].
  50937.     temporary isNil & (start left ~= nil) ifTrue: [self firstActivitywith: targetAV from: start left]! !
  50938.  
  50939. !TTM methodsFor: 'private'!
  50940. thisAVIsUsed: currentAV from: start 
  50941.     start left ~= nil & (temporary = false) ifTrue: [self thisAVIsUsed: currentAV from: start left].
  50942.     start right ~= nil & (temporary = false) ifTrue: [self thisAVIsUsed: currentAV from: start right].
  50943.     (start av at: 1)
  50944.         = currentAV & (temporary = false) ifTrue: [temporary := true]! !
  50945.  
  50946. !TTM methodsFor: 'label maintenance'!
  50947. aValidVariableName: aString 
  50948.     "Return true if aString is a valid new variable name."
  50949.  
  50950.     | valid count |
  50951.     valid := false.
  50952.     aString size = 0 ifFalse: [(aString at: 1) isLetter & (aString at: 1) isUppercase
  50953.             ifTrue: 
  50954.                 [valid := true.
  50955.                 count := 1.
  50956.                 aString size
  50957.                     timesRepeat: 
  50958.                         [(aString at: count) isAlphaNumeric | ((aString at: count)
  50959.                                 = $_) ifFalse: [valid := false].
  50960.                         count := count + 1]]].
  50961.     valid = true ifTrue: [(self anExistingV: aString)
  50962.             ifFalse: [(self anExistingCh: aString)
  50963.                     ifFalse: [valid := true]]].
  50964.     ^valid! !
  50965.  
  50966. !TTM methodsFor: 'label maintenance'!
  50967. check: aLabel asNewActivityNameFor: av canBe: old 
  50968.     "Given a label, this checks to see if it already 
  50969.     
  50970.     exists as an activity belonging to the given av. 
  50971.     
  50972.     If so, it makes the user supply another one. 
  50973.     
  50974.     If not, it returns the given label."
  50975.  
  50976.     | newLabel continue errorname aRequest choice |
  50977.     newLabel := aLabel.
  50978.     (self name: newLabel alreadyExistsFor: av)
  50979.         & (newLabel ~= old)
  50980.         ifTrue: 
  50981.             [continue := false.
  50982.             errorname := newLabel.
  50983.             [continue = false]
  50984.                 whileTrue: 
  50985.                     [aRequest := 'An activity named ' , errorname , ' already exists.' , (String with: Character cr) , 'Please supply a new name:'.
  50986.                     choice := DialogView request: aRequest.
  50987.                     choice isEmpty ifFalse: [(TTMList aUsefulActLabel: choice asString)
  50988.                             ifTrue: 
  50989.                                 [continue := (self name: choice alreadyExistsFor: av) not | (choice = old).
  50990.                                 continue = false ifTrue: [errorname := choice]]]].
  50991.             newLabel := choice].
  50992.     ^newLabel! !
  50993.  
  50994. !TTM methodsFor: 'label maintenance'!
  50995. name: aLabel alreadyExistsFor: av 
  50996.     "aLabel is a possible activity name. Is it 
  50997.     
  50998.     already in use?"
  50999.  
  51000.     | set result count currentActivity |
  51001.     set := self activitytree listOfActivities.
  51002.     set isNil ifTrue: [^false].
  51003.     result := false.
  51004.     count := 1.
  51005.     [count > set size]
  51006.         whileFalse: 
  51007.             [currentActivity := set at: count.
  51008.             currentActivity myName = aLabel ifTrue: [result := true].
  51009.             count := count + 1].
  51010.     ^result! !
  51011.  
  51012. !TTM methodsFor: 'label maintenance'!
  51013. name: aLabel isChildOfClusterActivity: anActivity 
  51014.     | set |
  51015.     anActivity collectionType = #parallel ifTrue: [^false].
  51016.     set := self activitytree allImmediateChildrenOf: anActivity.
  51017.     set isNil ifTrue: [^false].
  51018.     set do: [:x | x myName = aLabel ifTrue: [^true]].
  51019.     ^false! !
  51020.  
  51021. !TTM methodsFor: 'label maintenance'!
  51022. renameVariable: oldName to: newName 
  51023.     "change all guards, functions, and initial condition 
  51024.     
  51025.     that refer to this variable so that they now refer to it 
  51026.     
  51027.     with 
  51028.     
  51029.     its real name."
  51030.  
  51031.     | count currentTr guard action currentSF currentIC c found |
  51032.     self initialcondition: (TTMList
  51033.             replace: self initialcondition asString
  51034.             instance: oldName
  51035.             to: newName).
  51036.     count := 1.
  51037.     [count > self specificIC size]
  51038.         whileFalse: 
  51039.             [currentIC := (self specificIC at: count)
  51040.                         at: 2.
  51041.             c := 1.
  51042.             found := false.
  51043.             [c > currentIC size | (found = true)]
  51044.                 whileFalse: 
  51045.                     [((currentIC at: c)
  51046.                         at: 1)
  51047.                         = oldName
  51048.                         ifTrue: 
  51049.                             [(currentIC at: c)
  51050.                                 at: 1 put: newName.
  51051.                             found := true].
  51052.                     c := c + 1].
  51053.             count := count + 1].
  51054.     count := 1.
  51055.     [count > self stateFormulas size]
  51056.         whileFalse: 
  51057.             [currentSF := ((self stateFormulas at: count)
  51058.                         at: 2) asString.
  51059.             (self stateFormulas at: count)
  51060.                 at: 2 put: (TTMList
  51061.                     replace: currentSF
  51062.                     instance: oldName
  51063.                     to: newName).
  51064.             count := count + 1].
  51065.     count := 1.
  51066.     [count > self transitionlist size]
  51067.         whileFalse: 
  51068.             [currentTr := self transitionlist at: count.
  51069.             guard := currentTr myGuard asString.
  51070.             currentTr myGuard: (TTMList
  51071.                     replace: guard
  51072.                     instance: oldName
  51073.                     to: newName).
  51074.             action := currentTr myAction asString.
  51075.             currentTr myAction: (TTMList
  51076.                     replace: action
  51077.                     instance: oldName
  51078.                     to: newName).
  51079.             count := count + 1]! !
  51080.  
  51081. !TTM methodsFor: 'processing trs'!
  51082. avEnablingFor: aTransition 
  51083.     "We keep track of the previous elements 
  51084.     
  51085.     added to currentAVCs to avoid duplication 
  51086.     
  51087.     in code generation."
  51088.  
  51089.     | source typeOfAV enablingStates count current starting ending fullCondition ancestorList currentAncestor element accept |
  51090.     enablingStates := OrderedCollection new.
  51091.     starting := ''.
  51092.     source := aTransition startingAt.
  51093.     ancestorList := self activitytree ancestorListOf: source.
  51094.     ancestorList removeLast.
  51095.     count := ancestorList size.
  51096.     [count > 0]
  51097.         whileTrue: 
  51098.             [currentAncestor := ancestorList at: count.
  51099.             typeOfAV := self typeForAV: currentAncestor av.
  51100.             (typeOfAV includes: currentAncestor)
  51101.                 ifTrue: 
  51102.                     [element := (currentAncestor av at: 1)
  51103.                                 , '=' , currentAncestor myName.
  51104.                     accept := true.
  51105.                     currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  51106.                             ifTrue: [accept := false]].
  51107.                     accept = true
  51108.                         ifTrue: 
  51109.                             [currentAVCs add: element.
  51110.                             starting = ''
  51111.                                 ifTrue: [starting := element]
  51112.                                 ifFalse: [starting := starting , ',' , element]]].
  51113.             count := count - 1].
  51114.     typeOfAV := self typeForAV: source av.
  51115.     (typeOfAV includes: source)
  51116.         ifTrue: [enablingStates add: source]
  51117.         ifFalse: 
  51118.             [count := 1.
  51119.             [count > typeOfAV size]
  51120.                 whileFalse: 
  51121.                     [current := typeOfAV at: count.
  51122.                     (self activitytree is: source anAncestorOf: current)
  51123.                         ifTrue: [enablingStates add: current].
  51124.                     count := count + 1]].
  51125.     enablingStates size = 0 & starting isEmpty
  51126.         ifTrue: [^'nil']
  51127.         ifFalse: 
  51128.             [enablingStates size = 0
  51129.                 ifTrue: [ending := '']
  51130.                 ifFalse: [ending := self translate: enablingStates toStringUsing: source av].
  51131.             starting isEmpty ifFalse: [ending := ',(' , ending , ')'].
  51132.             fullCondition := starting , ending.
  51133.             ^fullCondition]! !
  51134.  
  51135. !TTM methodsFor: 'processing trs'!
  51136. avFunctionFor: aTransition 
  51137.     "We keep track of the previous elements 
  51138.     
  51139.     added to currentAVCs to avoid duplication 
  51140.     
  51141.     in code generation."
  51142.  
  51143.     | dest ancestorList starting count currentAncestor typeOfAV element ending changeState current accept |
  51144.     dest := aTransition endingAt.
  51145.     ancestorList := self activitytree ancestorListOf: dest.
  51146.     ancestorList removeLast.
  51147.     starting := ''.
  51148.     count := ancestorList size.
  51149.     [count > 0]
  51150.         whileTrue: 
  51151.             [currentAncestor := ancestorList at: count.
  51152.             typeOfAV := self typeForAV: currentAncestor av.
  51153.             (typeOfAV includes: currentAncestor)
  51154.                 ifTrue: [(currentAncestor av at: 1)
  51155.                         = ''
  51156.                         ifFalse: 
  51157.                             [element := (currentAncestor av at: 1)
  51158.                                         , ':' , currentAncestor myName.
  51159.                             accept := true.
  51160.                             currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  51161.                                     ifTrue: [accept := false]].
  51162.                             accept = true
  51163.                                 ifTrue: 
  51164.                                     [currentAVCs add: element.
  51165.                                     starting = ''
  51166.                                         ifTrue: [starting := element]
  51167.                                         ifFalse: [starting := starting , ',' , element]]]].
  51168.             count := count - 1].
  51169.     changeState := nil.
  51170.     typeOfAV := self typeForAV: dest av.
  51171.     (typeOfAV includes: dest)
  51172.         ifTrue: [changeState := dest]
  51173.         ifFalse: 
  51174.             [count := 1.
  51175.             [count > typeOfAV size]
  51176.                 whileFalse: 
  51177.                     [current := typeOfAV at: count.
  51178.                     current default = true & (self activitytree is: dest anAncestorOf: current) ifTrue: [changeState := current].
  51179.                     count := count + 1]].
  51180.     ending := (changeState av at: 1)
  51181.                 , ':' , changeState myName.
  51182.     starting = ''
  51183.         ifTrue: [^ending]
  51184.         ifFalse: [^starting , ',' , ending]! !
  51185.  
  51186. !TTM methodsFor: 'processing trs'!
  51187. avFunctionForOld: aTransition 
  51188.  
  51189.     "We keep track of the previous elements 
  51190.  
  51191.     added to currentAVCs to avoid duplication 
  51192.  
  51193.     in code generation."
  51194.  
  51195.  
  51196.  
  51197.     | dest ancestorList starting count currentAncestor typeOfAV element ending changeState current accept |
  51198.  
  51199.     dest := aTransition endingAt.
  51200.  
  51201.     ancestorList := self activitytree ancestorListOf: dest.
  51202.  
  51203.     ancestorList removeLast.
  51204.  
  51205.     starting := ''.
  51206.  
  51207.     count := ancestorList size.
  51208.  
  51209.     [count > 0]
  51210.  
  51211.         whileTrue: 
  51212.  
  51213.             [currentAncestor := ancestorList at: count.
  51214.  
  51215.             typeOfAV := self typeForAV: currentAncestor av.
  51216.  
  51217.             (typeOfAV includes: currentAncestor)
  51218.  
  51219.                 ifTrue: 
  51220.  
  51221.                     [element := (currentAncestor av at: 1)
  51222.  
  51223.                                 , ':' , currentAncestor myName.
  51224.  
  51225.                     accept := true.
  51226.  
  51227.                     currentAVCs size ~= 0 ifTrue: [(currentAVCs includes: element)
  51228.  
  51229.                             ifTrue: [accept := false]].
  51230.  
  51231.                     accept = true
  51232.  
  51233.                         ifTrue: 
  51234.  
  51235.                             [currentAVCs add: element.
  51236.  
  51237.                             starting = ''
  51238.  
  51239.                                 ifTrue: [starting := element]
  51240.  
  51241.                                 ifFalse: [starting := starting , ',' , element]]].
  51242.  
  51243.             count := count - 1].
  51244.  
  51245.     changeState := nil.
  51246.  
  51247.     typeOfAV := self typeForAV: dest av.
  51248.  
  51249.     (typeOfAV includes: dest)
  51250.  
  51251.         ifTrue: [changeState := dest]
  51252.  
  51253.         ifFalse: 
  51254.  
  51255.             [count := 1.
  51256.  
  51257.             [count > typeOfAV size]
  51258.  
  51259.                 whileFalse: 
  51260.  
  51261.                     [current := typeOfAV at: count.
  51262.  
  51263.                     current default = true & (self activitytree is: dest anAncestorOf: current) ifTrue: [changeState := current].
  51264.  
  51265.                     count := count + 1]].
  51266.  
  51267.     ending := (changeState av at: 1)
  51268.  
  51269.                 , ':' , changeState myName.
  51270.  
  51271.     starting = ''
  51272.  
  51273.         ifTrue: [^ending]
  51274.  
  51275.         ifFalse: [^starting , ',' , ending]! !
  51276.  
  51277. !TTM methodsFor: 'processing trs'!
  51278. findAV: anActivity withIndent: anInteger 
  51279.  
  51280.     | def temp |
  51281.  
  51282.     temp := Array new: 2.
  51283.  
  51284.     temp at: 1 put: anActivity.
  51285.  
  51286.     temp at: 2 put: anInteger.
  51287.  
  51288.     tempResult add: temp.
  51289.  
  51290.     anActivity collectionType = #parallel
  51291.  
  51292.         ifTrue: [(self activitytree allImmediateChildrenOf: anActivity)
  51293.  
  51294.                 do: [:act2 | self findAV: act2 withIndent: anInteger + 1]]
  51295.  
  51296.         ifFalse: 
  51297.  
  51298.             [(self activitytree allImmediateChildrenOf: anActivity)
  51299.  
  51300.                 do: [:x | x default ifTrue: [def := x]].
  51301.  
  51302.             def isNil
  51303.  
  51304.                 ifTrue: [^self]
  51305.  
  51306.                 ifFalse: [self findAV: def withIndent: anInteger + 1]]! !
  51307.  
  51308. !TTM methodsFor: 'processing trs'!
  51309. getSubStructureFor: anActivity 
  51310.     tempResult := OrderedCollection new.
  51311.     self findAV: anActivity withIndent: 1.
  51312.     ^tempResult! !
  51313.  
  51314. !TTM methodsFor: 'processing trs'!
  51315. processFunction: aFunction from: aTransition 
  51316.     "Return formatted string"
  51317.  
  51318.     | samplefunction temp |
  51319.     temp := ''.
  51320.     samplefunction := aFunction.    ""
  51321.     temp := aTransition transformationFunctionInTTM: self.
  51322.     samplefunction = 'nil'
  51323.         ifTrue: [samplefunction := temp]
  51324.         ifFalse: [samplefunction := temp , ',' , samplefunction].
  51325.     samplefunction = 'nil' ifTrue: [^samplefunction].
  51326.     ^TTMList removeAllBlanksFrom: samplefunction! !
  51327.  
  51328. !TTM methodsFor: 'processing trs'!
  51329. processFunction: aFunction fromLast: aTransition 
  51330.     "Return formatted string"
  51331.  
  51332.     | samplefunction avfunction temp |
  51333.     temp := ''.
  51334.     samplefunction := aFunction.
  51335.     (self getSubStructureFor: aTransition endingAt)
  51336.         do: 
  51337.             [:x | 
  51338.             "avfunction := self avFunctionFor: aTransition."
  51339.             temp = '' ifFalse: [temp := temp , ','].
  51340.             temp := temp , ((x at: 1) av at: 1) , ' : ' , (x at: 1) myName].
  51341.     samplefunction = 'nil'
  51342.         ifTrue: ["avfunction := avfunction , temp."
  51343.             samplefunction := temp]
  51344.         ifFalse: [samplefunction := temp , ',' , samplefunction].
  51345.     samplefunction = 'nil' ifTrue: [^samplefunction].
  51346.     ^TTMList removeAllBlanksFrom: samplefunction! !
  51347.  
  51348. !TTM methodsFor: 'processing trs'!
  51349. processFunctionOld: aFunction from: aTransition 
  51350.  
  51351.     "Return formatted string"
  51352.  
  51353.  
  51354.  
  51355.     | samplefunction avfunction |
  51356.  
  51357.     samplefunction := aFunction.
  51358.  
  51359.     avfunction := self avFunctionFor: aTransition.
  51360.  
  51361.     samplefunction = 'nil'
  51362.  
  51363.         ifTrue: [samplefunction := avfunction]
  51364.  
  51365.         ifFalse: [samplefunction := avfunction , ',' , samplefunction].
  51366.  
  51367.     samplefunction = 'nil' ifTrue: [^samplefunction].
  51368.  
  51369.     ^TTMList removeAllBlanksFrom: samplefunction! !
  51370.  
  51371. !TTM methodsFor: 'processing trs'!
  51372. processGuard: aGuard from: aTransition 
  51373.     "Return formatted string"
  51374.  
  51375.     | sampleguard avguard temp |
  51376.     sampleguard := aGuard.
  51377.     currentAVCs := OrderedCollection new.
  51378.     avguard := self avEnablingFor: aTransition.
  51379.     temp := aTransition newGuard.
  51380.     temp notNil ifTrue: [avguard := avguard , ',' , temp].
  51381.     sampleguard = 'nil'
  51382.         ifTrue: [sampleguard := avguard]
  51383.         ifFalse: [sampleguard := avguard , ', (' , sampleguard , ')'].
  51384.     sampleguard = 'nil' ifTrue: [^sampleguard].
  51385.     ^TTMList removeAllBlanksFrom: sampleguard! !
  51386.  
  51387. !TTM methodsFor: 'processing trs'!
  51388. processSharedTransitions: shared 
  51389.     "Given a set of shared transitions, this returns the name, guard, 
  51390.     transformation, and time 
  51391.  bounds composed from them. Note that we 
  51392.     have to look for branches. 
  51393.     We can identify them by the fact that their source activities belong to the 
  51394.     same activity variable."
  51395.  
  51396.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  51397.     name := (shared at: 1) myName.
  51398.     guard := ''.
  51399.     transformation := ''.
  51400.     lower := (shared at: 1) boundLower.
  51401.     upper := (shared at: 1) boundUpper.
  51402.     avCount := 1.
  51403.     [avCount > self activityvariable size]
  51404.         whileFalse: 
  51405.             [count := 1.
  51406.             currentAVCs := OrderedCollection new.
  51407.             thisAVempty := true.
  51408.             closeBracket := false.
  51409.             [count > shared size]
  51410.                 whileFalse: 
  51411.                     [thisInstance := shared at: count.
  51412.                     (thisInstance startingAt av at: 1)
  51413.                         = ((self activityvariable at: avCount)
  51414.                                 at: 1)
  51415.                         ifTrue: 
  51416.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  51417.                             closeBracket := true.
  51418.                             guard isEmpty
  51419.                                 ifTrue: 
  51420.                                     [guard := '(' , currentGuard.
  51421.                                     thisAVempty := false]
  51422.                                 ifFalse: [thisAVempty = true
  51423.                                         ifTrue: 
  51424.                                             [guard := guard , ' (' , currentGuard.
  51425.                                             thisAVempty := false]
  51426.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  51427.                     count := count + 1].
  51428.             closeBracket = true ifTrue: [guard := guard , '),'].
  51429.             avCount := avCount + 1].
  51430.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  51431.     count := 1.
  51432.     currentAVCs := OrderedCollection new.
  51433.     checkedAVs := OrderedCollection new.
  51434.     [count > shared size]
  51435.         whileFalse: 
  51436.             [(checkedAVs includes: (shared at: count) endingAt av)
  51437.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  51438.                 ifFalse: 
  51439.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  51440.                     checkedAVs add: (shared at: count) endingAt av].
  51441.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  51442.                     ifTrue: [transformation := currentFunction]
  51443.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  51444.             newLower := (shared at: count) boundLower.
  51445.             newUpper := (shared at: count) boundUpper.
  51446.             (TTMList convertToNumber: newLower)
  51447.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  51448.             upper = 'infinity'
  51449.                 ifTrue: [upper := newUpper]
  51450.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  51451.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  51452.             count := count + 1].
  51453.     set := OrderedCollection new.
  51454.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  51455.     ^set! !
  51456.  
  51457. !TTM methodsFor: 'processing trs'!
  51458. processSharedTransitionsLast: shared 
  51459.     "Given a set of shared transitions, this returns 
  51460.     
  51461.     the name, guard, transformation, and time 
  51462.     
  51463.     bounds composed from them. Note that we 
  51464.     
  51465.     have to look for branches. We can identify 
  51466.     
  51467.     them by the fact that their source activities 
  51468.     
  51469.     belong to the same activity variable."
  51470.  
  51471.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  51472.     name := (shared at: 1) myName.
  51473.     guard := ''.
  51474.     transformation := ''.
  51475.     lower := (shared at: 1) boundLower.
  51476.     upper := (shared at: 1) boundUpper.
  51477.     avCount := 1.
  51478.     [avCount > self activityvariable size]
  51479.         whileFalse: 
  51480.             [count := 1.
  51481.             currentAVCs := OrderedCollection new.
  51482.             thisAVempty := true.
  51483.             closeBracket := false.
  51484.             [count > shared size]
  51485.                 whileFalse: 
  51486.                     [thisInstance := shared at: count.
  51487.                     (thisInstance startingAt av at: 1)
  51488.                         = ((self activityvariable at: avCount)
  51489.                                 at: 1)
  51490.                         ifTrue: 
  51491.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  51492.                             closeBracket := true.
  51493.                             guard isEmpty
  51494.                                 ifTrue: 
  51495.                                     [guard := '(' , currentGuard.
  51496.                                     thisAVempty := false]
  51497.                                 ifFalse: [thisAVempty = true
  51498.                                         ifTrue: 
  51499.                                             [guard := guard , ' (' , currentGuard.
  51500.                                             thisAVempty := false]
  51501.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  51502.                     count := count + 1].
  51503.             closeBracket = true ifTrue: [guard := guard , '),'].
  51504.             avCount := avCount + 1].
  51505.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  51506.     count := 1.
  51507.     currentAVCs := OrderedCollection new.
  51508.     checkedAVs := OrderedCollection new.
  51509.     [count > shared size]
  51510.         whileFalse: 
  51511.             [(checkedAVs includes: (shared at: count) endingAt av)
  51512.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  51513.                 ifFalse: 
  51514.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  51515.                     checkedAVs add: (shared at: count) endingAt av].
  51516.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  51517.                     ifTrue: [transformation := currentFunction]
  51518.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  51519.             newLower := (shared at: count) boundLower.
  51520.             newUpper := (shared at: count) boundUpper.
  51521.             (TTMList convertToNumber: newLower)
  51522.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  51523.             upper = 'infinity'
  51524.                 ifTrue: [upper := newUpper]
  51525.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  51526.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  51527.             count := count + 1].
  51528.     set := OrderedCollection new.
  51529.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  51530.     ^set! !
  51531.  
  51532. !TTM methodsFor: 'processing trs'!
  51533. processSharedTransitionsOld: shared 
  51534.  
  51535.     "Given a set of shared transitions, this returns 
  51536.  
  51537.     the name, guard, transformation, and time 
  51538.  
  51539.     bounds composed from them. Note that we 
  51540.  
  51541.     have to look for branches. We can identify 
  51542.  
  51543.     them by the fact that their source activities 
  51544.  
  51545.     belong to the same activity variable."
  51546.  
  51547.  
  51548.  
  51549.     | name guard transformation lower upper count currentGuard currentFunction set newLower newUpper avCount thisInstance thisAVempty closeBracket checkedAVs |
  51550.  
  51551.     name := (shared at: 1) myName.
  51552.  
  51553.     guard := ''.
  51554.  
  51555.     transformation := ''.
  51556.  
  51557.     lower := (shared at: 1) boundLower.
  51558.  
  51559.     upper := (shared at: 1) boundUpper.
  51560.  
  51561.     avCount := 1.
  51562.  
  51563.     [avCount > self activityvariable size]
  51564.  
  51565.         whileFalse: 
  51566.  
  51567.             [count := 1.
  51568.  
  51569.             currentAVCs := OrderedCollection new.
  51570.  
  51571.             thisAVempty := true.
  51572.  
  51573.             closeBracket := false.
  51574.  
  51575.             [count > shared size]
  51576.  
  51577.                 whileFalse: 
  51578.  
  51579.                     [thisInstance := shared at: count.
  51580.  
  51581.                     (thisInstance startingAt av at: 1)
  51582.  
  51583.                         = ((self activityvariable at: avCount)
  51584.  
  51585.                                 at: 1)
  51586.  
  51587.                         ifTrue: 
  51588.  
  51589.                             [currentGuard := self processGuard: thisInstance myGuard from: thisInstance.
  51590.  
  51591.                             closeBracket := true.
  51592.  
  51593.                             guard isEmpty
  51594.  
  51595.                                 ifTrue: 
  51596.  
  51597.                                     [guard := '(' , currentGuard.
  51598.  
  51599.                                     thisAVempty := false]
  51600.  
  51601.                                 ifFalse: [thisAVempty = true
  51602.  
  51603.                                         ifTrue: 
  51604.  
  51605.                                             [guard := guard , ' (' , currentGuard.
  51606.  
  51607.                                             thisAVempty := false]
  51608.  
  51609.                                         ifFalse: [guard := guard , ';' , currentGuard]]].
  51610.  
  51611.                     count := count + 1].
  51612.  
  51613.             closeBracket = true ifTrue: [guard := guard , '),'].
  51614.  
  51615.             avCount := avCount + 1].
  51616.  
  51617.     guard size > 1 ifTrue: [guard := guard copyFrom: 1 to: guard size - 1].
  51618.  
  51619.     count := 1.
  51620.  
  51621.     currentAVCs := OrderedCollection new.
  51622.  
  51623.     checkedAVs := OrderedCollection new.
  51624.  
  51625.     [count > shared size]
  51626.  
  51627.         whileFalse: 
  51628.  
  51629.             [(checkedAVs includes: (shared at: count) endingAt av)
  51630.  
  51631.                 ifTrue: [currentFunction := TTMList removeAllBlanksFrom: (shared at: count) myAction]
  51632.  
  51633.                 ifFalse: 
  51634.  
  51635.                     [currentFunction := self processFunction: (shared at: count) myAction from: (shared at: count).
  51636.  
  51637.                     checkedAVs add: (shared at: count) endingAt av].
  51638.  
  51639.             currentFunction ~= 'nil' ifTrue: [transformation isEmpty
  51640.  
  51641.                     ifTrue: [transformation := currentFunction]
  51642.  
  51643.                     ifFalse: [transformation := transformation , ',' , currentFunction]].
  51644.  
  51645.             newLower := (shared at: count) boundLower.
  51646.  
  51647.             newUpper := (shared at: count) boundUpper.
  51648.  
  51649.             (TTMList convertToNumber: newLower)
  51650.  
  51651.                 > (TTMList convertToNumber: lower) ifTrue: [lower := newLower].
  51652.  
  51653.             upper = 'infinity'
  51654.  
  51655.                 ifTrue: [upper := newUpper]
  51656.  
  51657.                 ifFalse: [newUpper = 'infinity' ifFalse: [(TTMList convertToNumber: upper)
  51658.  
  51659.                             > (TTMList convertToNumber: newUpper) ifTrue: [upper := newUpper]]].
  51660.  
  51661.             count := count + 1].
  51662.  
  51663.     set := OrderedCollection new.
  51664.  
  51665.     set add: name; add: guard; add: transformation; add: lower; add: upper.
  51666.  
  51667.     ^set! !
  51668.  
  51669. !TTM methodsFor: 'processing trs'!
  51670. translate: enablingStates toStringUsing: av 
  51671.     "For use in Simulation and code generation: we 
  51672.     
  51673.     are given a set of activities which composed the 
  51674.     
  51675.     type of av. Translate into something like: 
  51676.     
  51677.     `X1 = one; X1 = two; X1 =three'"
  51678.  
  51679.     | preamble aString count |
  51680.     preamble := (av at: 1) asString , '='.
  51681.     aString := ''.
  51682.     count := 1.
  51683.     [count > enablingStates size]
  51684.         whileFalse: 
  51685.             [aString := aString , preamble , (enablingStates at: count) myName.
  51686.             count ~= enablingStates size ifTrue: [aString := aString , ';'].
  51687.             count := count + 1].
  51688.     ^aString! !
  51689.  
  51690. !TTM methodsFor: 'consistancy checks'!
  51691. checkForUndeclaredVariables! !
  51692.  
  51693. !TTM methodsFor: 'consistancy checks'!
  51694. checkSFs! !
  51695.  
  51696. !TTM methodsFor: 'consistancy checks'!
  51697. checkTransformationFunctions
  51698.     "Not currently used - but don't delete"
  51699.  
  51700.     | undefined ast ok |
  51701.     undefined := ''.
  51702.     ok := true.
  51703.     transitionList
  51704.         do: 
  51705.             [:x | 
  51706.             ast := BuildTFParser new parseForAST: x myAction ifFail: [nil].
  51707.             ast rhsVars do: [:y | (self anExistingAV: y)
  51708.                     = false & (self anExistingDV: y) = false
  51709.                     ifTrue: 
  51710.                         [ok := false.
  51711.                         undefined isNil ifTrue: [undefined := ''].
  51712.                         undefined := undefined , '  ' , y]]].
  51713.     ^ok! !
  51714.  
  51715. !TTM methodsFor: 'shared transitions'!
  51716. computeEffectiveTransitions
  51717.     | t1 t2 |
  51718.     self initializeForSharedTransitionAlgorithm.
  51719.     t2 := SortedCollection sortBlock: [:x :y | x myName < y myName].
  51720.     t1 := self findEffectiveTransitionsOf: activityTree getRoot.
  51721.     (t1 at: 2) notNil ifTrue: [t2 addAll: (t1 at: 2)].
  51722.     (t1 at: 1) notNil ifTrue: [(t1 at: 1) values do: [:x | t2 addAll: x]].
  51723.     ^t2! !
  51724.  
  51725. !TTM methodsFor: 'shared transitions'!
  51726. computeEffectiveTransitionsTest
  51727.     self initializeForSharedTransitionAlgorithm.
  51728.     ^self findEffectiveTransitionsOf: activityTree getRoot! !
  51729.  
  51730. !TTM methodsFor: 'shared transitions'!
  51731. crossTransition: a with: b named: aName 
  51732.     | newGuard newFunction newLo newHi t1 t2 newName temp |
  51733.     temp := ''.
  51734.     a startingAt notNil ifTrue: [temp := self avEnablingFor: a].
  51735.     b startingAt notNil ifTrue: [temp := temp , (self avEnablingFor: b)].
  51736.     newGuard := a myGuard , ',' , b myGuard.
  51737.     a myAction = 'nil'
  51738.         ifTrue: [newFunction := b myAction]
  51739.         ifFalse: [b myAction = 'nil'
  51740.                 ifTrue: [newFunction := a myAction]
  51741.                 ifFalse: [newFunction := a myAction , ',' , b myAction]].
  51742.     newName := self getUniqueNameForTransitionNamed: aName.
  51743.     t1 := a boundUpper.
  51744.     t2 := b boundUpper.
  51745.     t1 = 'infinity'
  51746.         ifTrue: [t2 ~= 'infinity'
  51747.                 ifTrue: [newHi := t2]
  51748.                 ifFalse: [newHi := 'infinity']]
  51749.         ifFalse: [t2 = 'infinity'
  51750.                 ifTrue: [newHi := t1]
  51751.                 ifFalse: [t2 asNumber < t1 asNumber
  51752.                         ifTrue: [newHi := t2]
  51753.                         ifFalse: [newHi := t1]]].
  51754.     t1 := a boundLower.
  51755.     t2 := b boundLower.
  51756.     t1 asNumber  < t2 asNumber
  51757.         ifTrue: [newLo := t2]
  51758.         ifFalse: [newLo := t1].
  51759.     ^Transition
  51760.         name: newName
  51761.         startAt: nil
  51762.         endAt: nil
  51763.         upper: newHi
  51764.         lower: newLo
  51765.         guard: newGuard
  51766.         action: newFunction! !
  51767.  
  51768. !TTM methodsFor: 'shared transitions'!
  51769. crossTransitionCollection: a with: b named: aName 
  51770.     | result |
  51771.     a isNil & b isNil ifTrue: [^OrderedCollection new].
  51772.     a isNil ifTrue: [^b].
  51773.     b isNil ifTrue: [^a].
  51774.     a size = 0 ifTrue: [^b].
  51775.     result := OrderedCollection new.
  51776.     a do: [:x | b do: [:y | result add: (self
  51777.                     crossTransition: x
  51778.                     with: y
  51779.                     named: aName)]].
  51780.     ^result! !
  51781.  
  51782. !TTM methodsFor: 'shared transitions'!
  51783. findEffectiveTransitionsOf: aNode 
  51784.     | children childResultCollection temp sharedDictionary nonSharedCollection s ind newTransition cs temp2 temp1 temp3 |
  51785.     children := activityTree allImmediateChildrenOf: aNode.
  51786.     s := children size.
  51787.     s = 0 ifTrue: [^Array with: (Dictionary new) with: (OrderedCollection new)].
  51788.     childResultCollection := OrderedCollection new.
  51789.     sharedDictionary := Dictionary new.
  51790.     nonSharedCollection := OrderedCollection new.
  51791.     children do: [:x | childResultCollection add: (self findEffectiveTransitionsOf: x)].
  51792.     aNode collectionType == #cluster
  51793.         ifTrue: 
  51794.             [childResultCollection do: [:c | (c at: 1) notNil
  51795.                     ifTrue: 
  51796.                         [(c at: 1) associations
  51797.                             do: 
  51798.                                 [:a | 
  51799.                                 ind := sharedDictionary findKey: a key ifAbsent: [nil].
  51800.                                 ind isNil ifFalse: [(sharedDictionary at: a key) value addAll: a value]
  51801.                                     ifTrue: [sharedDictionary add: a key -> a value]].
  51802.                         nonSharedCollection addAll: (c at: 2)]].
  51803.             (self getSetOfTransitionsStartingOrEndingAtActivites: children)
  51804.                 do: 
  51805.                     [:t | 
  51806.                     temp1 := ''.
  51807.                     temp := self getUniqueNameForTransitionNamed: t myName.
  51808.                     t startingAt notNil
  51809.                         ifTrue: 
  51810.                             [temp3 := self processFunction: t myAction from: t.
  51811.                             temp1 := self processGuard: t myGuard from: t].
  51812.                              
  51813.                     newTransition := Transition
  51814.                                 name: temp
  51815.                                 startAt: t startingAt
  51816.                                 endAt: t endingAt
  51817.                                 upper: t boundUpper copy
  51818.                                 lower: t boundLower copy
  51819.                                 guard: temp1 copy
  51820.                                 action: temp3 copy.
  51821.                     newTransition defaultDestinationAssignments: t defaultDestinationAssignments.
  51822.                     newTransition defaultSourceAssignments: t defaultSourceAssignments.
  51823.                     t shared
  51824.                         ifTrue: [(sharedDictionary includesKey: t myName)
  51825.                                 = true
  51826.                                 ifTrue: [(sharedDictionary at: t myName)
  51827.                                         add: newTransition]
  51828.                                 ifFalse: 
  51829.                                     [sharedDictionary add: t myName -> OrderedCollection new.
  51830.                                     (sharedDictionary at: t myName)
  51831.                                         add: newTransition]]
  51832.                         ifFalse: [nonSharedCollection add: newTransition]]]
  51833.         ifFalse: 
  51834.             [childResultCollection do: [:c | (c at: 1) notNil ifTrue: [nonSharedCollection addAll: (c at: 2)]].
  51835.             s < 2
  51836.                 ifTrue: [sharedDictionary := (childResultCollection at: 1)
  51837.                                 at: 1]
  51838.                 ifFalse: [1 to: s
  51839.                         do: 
  51840.                             [:i | 
  51841.                             cs := (childResultCollection at: i)
  51842.                                         at: 1.
  51843.                             cs associations do: [:x | (sharedDictionary includesKey: x key)
  51844.                                     = false
  51845.                                     ifTrue: 
  51846.                                         [temp := x value.
  51847.                                         i + 1 to: s
  51848.                                             do: 
  51849.                                                 [:j | 
  51850.                                                 temp2 := ((childResultCollection at: j)
  51851.                                                             at: 1)
  51852.                                                             at: x key ifAbsent: [nil].
  51853.                                                 temp2 isNil ifFalse: [temp := self
  51854.                                                                 crossTransitionCollection: temp
  51855.                                                                 with: temp2
  51856.                                                                 named: x key]].
  51857.                                         sharedDictionary add: x key -> temp]]]]].
  51858.     ^Array with: sharedDictionary with: nonSharedCollection! !
  51859.  
  51860. !TTM methodsFor: 'shared transitions'!
  51861. getSetOfTransitionsStartingOrEndingAtActivites: activityCollection 
  51862.     | result |
  51863.     result := OrderedCollection new.
  51864.     activityCollection do: [:x | result addAll: (transitionList TransitionsStartingAt: x)].
  51865.     ^result! !
  51866.  
  51867. !TTM methodsFor: 'shared transitions'!
  51868. getUniqueNameForTransitionNamed: aName 
  51869.     | int |
  51870.     int := transitionDictionary at: aName.
  51871.     transitionDictionary at: aName put: int + 1.
  51872.     int = 0
  51873.         ifTrue: [^aName]
  51874.         ifFalse: [^aName , '_' , int printString]! !
  51875.  
  51876. !TTM methodsFor: 'shared transitions'!
  51877. initializeForSharedTransitionAlgorithm
  51878.     transitionDictionary := Dictionary new.
  51879.     transitionList do: [:x | (transitionDictionary includesKey: x myName)
  51880.             ifFalse: [transitionDictionary add: x myName -> 0]
  51881.             ifTrue: [transitionDictionary at: x myName put: 1]]! !
  51882.  
  51883. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  51884.  
  51885. TTM class
  51886.     instanceVariableNames: ''!
  51887.  
  51888. !TTM class methodsFor: 'instance creation'!
  51889. create: givenName with: variable 
  51890.     "Create an instance of a TTM. 
  51891.     
  51892.     We use the new method for Model, super, and then the 
  51893.     
  51894.     initialize instance method for TTM."
  51895.  
  51896.     ^super new initialize: givenName with: variable! !
  51897.  
  51898. !TTM class methodsFor: 'BOSS i/o'!
  51899. getTTMFromFile: aFileName 
  51900.     | aTTM bos |
  51901.     bos := BinaryObjectStorage onOld: (Filename named: aFileName) readStream.
  51902.     aTTM := bos next.
  51903.     bos close.
  51904.     ^aTTM! !
  51905.  
  51906. !TTM class methodsFor: 'BOSS i/o'!
  51907. storeTTM: aTTM onFile: aFileName 
  51908.     | t1 t2 t3 i |
  51909.     t3 := aTTM openWindows.
  51910.     aTTM openWindows: #(0 0 0 0 ).
  51911.     t2 := OrderedCollection new.
  51912.     t1 := aTTM simulateWindow.
  51913.     aTTM transitionlist
  51914.         do: 
  51915.             [:x | 
  51916.             t2 add: x detailWindow.
  51917.             x detailWindow: nil].
  51918.     aTTM simulateWindow: nil.
  51919.     (BinaryObjectStorage onNew: (Filename named: aFileName) writeStream)
  51920.         nextPut: aTTM; close.
  51921.     aTTM simulateWindow: t1.
  51922.     aTTM openWindows: t3.
  51923.     i := 1.
  51924.     aTTM transitionlist
  51925.         do: 
  51926.             [:x | 
  51927.             x detailWindow: (t2 at: i).
  51928.             i := i + 1].
  51929.     ^aTTM! !
  51930.  
  51931. Model subclass: #ConditionsWindow
  51932.     instanceVariableNames: 'currentTTM allSelection icSelection myConditions initialCondition table '
  51933.     classVariableNames: ''
  51934.     poolDictionaries: ''
  51935.     category: 'Build'!
  51936.  
  51937. !ConditionsWindow methodsFor: 'initialize-release'!
  51938. initializeCondition
  51939.     | count existingDV |
  51940.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  51941.                     with: (currentTTM defaultOfAV: (existingAV at: 1))].
  51942.     count := 1.
  51943.     currentTTM datavariable size
  51944.         timesRepeat: 
  51945.             [existingDV := currentTTM datavariable at: count.
  51946.             existingDV := Array with: (existingDV at: 1)
  51947.                         with: (existingDV at: 4).
  51948.             count := count + 1.
  51949.             initialCondition add: existingDV]! !
  51950.  
  51951. !ConditionsWindow methodsFor: 'initialize-release'!
  51952. initializeTTM: instanceOfTTM 
  51953.     currentTTM := instanceOfTTM.
  51954.     myConditions := currentTTM specificIC.
  51955.     self initializeCondition! !
  51956.  
  51957. !ConditionsWindow methodsFor: 'ic maintenance'!
  51958. icChange
  51959.     "Change initial value of a variable."
  51960.  
  51961.     | initial oldInitial |
  51962.     icSelection ~~ nil ifFalse: []
  51963.         ifTrue: 
  51964.             [oldInitial := icSelection at: 2.
  51965.             initial := DialogView request: 'New initial value of ' , (icSelection at: 1) , '?' initialAnswer: oldInitial.
  51966.             (currentTTM anExistingDV: (icSelection at: 1))
  51967.                 ifTrue: [(currentTTM isInDVRange: initial of: (icSelection at: 1))
  51968.                         ifFalse: 
  51969.                             [TTMList speak: 'illegal data variable value.'.
  51970.                             ^self]]
  51971.                 ifFalse: [(currentTTM anExistingAV: (icSelection at: 1))
  51972.                         ifTrue: [(currentTTM isInAVRange: initial of: (icSelection at: 1))
  51973.                                 ifFalse: 
  51974.                                     [TTMList speak: 'illegal activity variable value.'.
  51975.                                     ^self]]
  51976.                         ifFalse: 
  51977.                             [TTMList speak: 'illegal variable name in use.'.
  51978.                             ^self]].
  51979.             initial isEmpty
  51980.                 ifTrue: [^self]
  51981.                 ifFalse: 
  51982.                     [icSelection at: 2 put: initial.
  51983.                     self changed: #icTransaction]]! !
  51984.  
  51985. !ConditionsWindow methodsFor: 'ic maintenance'!
  51986. icList
  51987.  
  51988.     "Return a list of variable names and initial conditions."
  51989.  
  51990.  
  51991.  
  51992.     allSelection ~~ nil
  51993.  
  51994.         ifTrue: 
  51995.  
  51996.             [initialCondition := allSelection at: 2.
  51997.  
  51998.             ^initialCondition collect: [:existingCondition | (existingCondition at: 1)
  51999.  
  52000.                     , ' = ' , (existingCondition at: 2)]]
  52001.  
  52002.         ifFalse: [^nil]! !
  52003.  
  52004. !ConditionsWindow methodsFor: 'ic maintenance'!
  52005. icMenu
  52006.     "Answer a menu for the specific initial condition view."
  52007.  
  52008.     icSelection == nil ifTrue: [^nil].
  52009.     ^PopUpMenu labelList: #(#('new initial value' 'show type' ) ) values: #(#icChange #icTypeList )! !
  52010.  
  52011. !ConditionsWindow methodsFor: 'ic maintenance'!
  52012. icSelection: index 
  52013.  
  52014.      "If the selection has been changed, remember the new
  52015.  
  52016. selection."
  52017.  
  52018.  
  52019.  
  52020.      | newSel |
  52021.  
  52022.      newSel := index = 0
  52023.  
  52024.                     ifTrue: []
  52025.  
  52026.                     ifFalse: [initialCondition at: index].
  52027.  
  52028.      
  52029.  
  52030.      icSelection == newSel
  52031.  
  52032.           ifTrue: 
  52033.  
  52034.                ["self updateSimulateWindowIfOpen."
  52035.  
  52036.                ^self].
  52037.  
  52038.      
  52039.  
  52040.      icSelection := newSel.! !
  52041.  
  52042. !ConditionsWindow methodsFor: 'ic maintenance'!
  52043. icTypeList
  52044.     | n list temp pos cd junk isActivity |
  52045.     isActivity := False.
  52046.     list := Array new: 1.
  52047.     (pos := currentTTM anExistingDVsPosition: (icSelection at: 1)) notNil
  52048.         ifTrue: 
  52049.             [cd := currentTTM datavariable at: pos.
  52050.             temp := 'Range: ' , (cd at: 2) , ' to ' , (cd at: 3).
  52051.             junk := Array new: 1.
  52052.             junk at: 1 put: temp.
  52053.             list at: 1 put: junk]
  52054.         ifFalse: [(pos := currentTTM anExistingAVsPosition: (icSelection at: 1)) notNil
  52055.                 ifTrue: 
  52056.                     [isActivity := True.
  52057.                     temp := SortedCollection new.
  52058.                     (currentTTM typeForAVNamed: (icSelection at: 1))
  52059.                         do: [:x | temp add: x].
  52060.                     temp := temp asArray.
  52061.                     list at: 1 put: temp]
  52062.                 ifFalse: []].
  52063.     n := (PopUpMenu labelList: list) startUp.
  52064.     isActivity = True & (n > 0)
  52065.         ifTrue: 
  52066.             [icSelection at: 2 put: ((list at: 1)
  52067.                     at: n).
  52068.             self changed: #icTransaction]! !
  52069.  
  52070. !ConditionsWindow methodsFor: 'list access'!
  52071. listAdd
  52072.     | newname totalNumber checkIfValid count okay |
  52073.     totalNumber := myConditions size.
  52074.     checkIfValid := true.
  52075.     [checkIfValid = true]
  52076.         whileTrue: 
  52077.             [count := 1.
  52078.             okay := true.
  52079.             [count > myConditions size]
  52080.                 whileFalse: 
  52081.                     [((myConditions at: count)
  52082.                         at: 1)
  52083.                         = totalNumber printString
  52084.                         ifTrue: 
  52085.                             [okay := false.
  52086.                             count := myConditions size].
  52087.                     count := count + 1].
  52088.             okay = true
  52089.                 ifTrue: [checkIfValid := false]
  52090.                 ifFalse: [totalNumber := totalNumber + 1]].
  52091.     newname := DialogView request: 'New condition number?' initialAnswer: totalNumber printString.
  52092.     newname isEmpty
  52093.         ifTrue: [^self]
  52094.         ifFalse: 
  52095.             [self initializeCondition.
  52096.             myConditions add: (Array with: newname with: initialCondition copy).
  52097.             self changed: #listTransaction.
  52098.             self changed: #icTransaction]! !
  52099.  
  52100. !ConditionsWindow methodsFor: 'list access'!
  52101. listClear
  52102.     currentTTM specificIC: OrderedCollection new.
  52103.     myConditions := currentTTM specificIC.
  52104.     self changed: #listTransaction! !
  52105.  
  52106. !ConditionsWindow methodsFor: 'list access'!
  52107. listCopy
  52108.     | newname copiedCondition |
  52109.     allSelection == nil
  52110.         ifFalse: 
  52111.             [newname := DialogView request: 'Copy to condition number?'.
  52112.             newname isEmpty
  52113.                 ifTrue: [^self]
  52114.                 ifFalse: 
  52115.                     [copiedCondition := (allSelection at: 2) copy.
  52116.                     myConditions add: (Array with: newname with: copiedCondition).
  52117.                     self changed: #listTransaction.
  52118.                     self changed: #icTransaction]]! !
  52119.  
  52120. !ConditionsWindow methodsFor: 'list access'!
  52121. listList
  52122.  
  52123.      ^myConditions collect: [:existingIC | existingIC at: 1]! !
  52124.  
  52125. !ConditionsWindow methodsFor: 'list access'!
  52126. listMenu
  52127.  
  52128.     allSelection = nil
  52129.  
  52130.         ifTrue: [^PopUpMenu labelList: #(#(#add #clear ) ) values: #(#listAdd #listClear )]
  52131.  
  52132.         ifFalse: [^PopUpMenu labelList: #(#(#add #copy #clear #remove #send ) ) values: #(#listAdd #listCopy #listClear #listRemove #listSend )]! !
  52133.  
  52134. !ConditionsWindow methodsFor: 'list access'!
  52135. listRemove
  52136.  
  52137.     | location |
  52138.  
  52139.     allSelection == nil
  52140.  
  52141.         ifTrue: []
  52142.  
  52143.         ifFalse: 
  52144.  
  52145.             [location := myConditions indexOf: allSelection.
  52146.  
  52147.             myConditions removeAtIndex: location.
  52148.  
  52149.             self changed: #listTransaction]! !
  52150.  
  52151. !ConditionsWindow methodsFor: 'list access'!
  52152. listSelection: index 
  52153.     "If the selection has been changed, remember the new 
  52154.     
  52155.     selection."
  52156.  
  52157.     | newSel |
  52158.     newSel := index = 0
  52159.                 ifTrue: [nil]
  52160.                 ifFalse: [myConditions at: index].
  52161.     allSelection == newSel ifTrue: [^self].
  52162.     allSelection := newSel.
  52163.     self changed: #icTransaction! !
  52164.  
  52165. !ConditionsWindow methodsFor: 'list access'!
  52166. listSend
  52167.  
  52168.     self updateSimulateWindowIfOpen! !
  52169.  
  52170. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  52171. ic1Accept: candidateCondition 
  52172.  
  52173.      | accept cCondition |
  52174.  
  52175.      accept := false.
  52176.  
  52177.      candidateCondition isEmpty
  52178.  
  52179.           ifTrue: [cCondition := 'nil']
  52180.  
  52181.           ifFalse: [cCondition := candidateCondition].
  52182.  
  52183.      cCondition asString = 'nil'
  52184.  
  52185.           ifTrue: [accept := true]
  52186.  
  52187.           ifFalse: [(ParseTree guardSyntaxCheck: cCondition
  52188.  
  52189. asString from: currentTTM)
  52190.  
  52191.                     ifFalse: [accept := true]].
  52192.  
  52193.      accept = false
  52194.  
  52195.           ifFalse: 
  52196.  
  52197.                [currentTTM initialcondition: cCondition asString.
  52198.  
  52199.                self changed: #ic1List.
  52200.  
  52201.                ^true]
  52202.  
  52203.           ifTrue: 
  52204.  
  52205.                [TTMList speak: 'revised initial condition
  52206.  
  52207. rejected.'.
  52208.  
  52209.                self changed: #ic1List.
  52210.  
  52211.                ^true]! !
  52212.  
  52213. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  52214. ic1List
  52215.  
  52216.      ^currentTTM initialcondition! !
  52217.  
  52218. !ConditionsWindow methodsFor: 'ic1 maintenance'!
  52219. ic1Menu
  52220.  
  52221.      "Answer a menu for the initial condition view."
  52222.  
  52223.  
  52224.  
  52225.      ^PopUpMenu 
  52226.  
  52227.                        labelList: #(#(#again #undo ) #(#copy #cut
  52228.  
  52229. #paste ) #(#accept #cancel ) ) 
  52230.  
  52231.                        values: #(#again #undo #copySelection #cut
  52232.  
  52233. #paste #accept #cancel )! !
  52234.  
  52235. !ConditionsWindow methodsFor: 'SimulateWindow interface'!
  52236. simulateWindowOpen
  52237.     "Return the SimulateWindow if it is open"
  52238.  
  52239.     (currentTTM openWindows at: 4)
  52240.         ~= 0 ifTrue: [^currentTTM simulateWindow].
  52241.     ^nil! !
  52242.  
  52243. !ConditionsWindow methodsFor: 'SimulateWindow interface'!
  52244. updateSimulateWindowIfOpen
  52245.     "If there is a SimulateWindow open for this TTM, then update the 
  52246.     Starting Condition to the IC chosen in the corresponding 
  52247.     QueryWindow"
  52248.  
  52249.     | anSW |
  52250.     anSW := self simulateWindowOpen.
  52251.     anSW ~= nil ifTrue: [allSelection notNil
  52252.             ifTrue: 
  52253.                 [anSW initialCondition: (self allSelection at: 2) copy.
  52254.                 anSW changed: #icTransaction.
  52255.                 anSW clockReset.
  52256.                 anSW accessTimeFor: #all to: #initialize.
  52257.                 anSW initializeTable.
  52258.                 anSW reset]]! !
  52259.  
  52260. !ConditionsWindow methodsFor: 'variable access'!
  52261. allSelection
  52262.  
  52263.      ^allSelection! !
  52264.  
  52265. !ConditionsWindow methodsFor: 'variable access'!
  52266. currentTTM
  52267.  
  52268.      ^currentTTM! !
  52269.  
  52270. !ConditionsWindow methodsFor: 'closing'!
  52271. removeDependent: aDependent 
  52272.  
  52273.     currentTTM openWindows at: 1 put: 0.
  52274.  
  52275.     super removeDependent: aDependent! !
  52276.  
  52277. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  52278.  
  52279. ConditionsWindow class
  52280.     instanceVariableNames: ''!
  52281.  
  52282. !ConditionsWindow class methodsFor: 'instance creation'!
  52283. new: ttm 
  52284.     ^super new initializeTTM: ttm! !
  52285.  
  52286. !ConditionsWindow class methodsFor: 'instance creation'!
  52287. open: currentTTM 
  52288.     self open: (self new: currentTTM)
  52289.         with: currentTTM! !
  52290.  
  52291. !ConditionsWindow class methodsFor: 'instance creation'!
  52292. open: anICModel with: currentTTM 
  52293.     | window container myWrapper title initialView up vsize left hsize hButton cButton noteView icListView |
  52294.     window := ScheduledWindow new.
  52295.     title := 'Specifying Initial Conditions For: ' , currentTTM named asText.
  52296.     window label: title.
  52297.     window minimumSize: 450 @ 300.
  52298.     window insideColor: ColorValue white.
  52299.     window model: anICModel.
  52300.     container := CompositePart new.
  52301.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  52302.         insideColor: ColorValue white.
  52303.     noteView := TextView
  52304.                 on: anICModel
  52305.                 aspect: #ic1List
  52306.                 change: #ic1Accept:
  52307.                 menu: #ic1Menu
  52308.                 initialSelection: nil.
  52309.     myWrapper := self wrap: (LookPreferences edgeDecorator on: noteView).
  52310.     (container add: myWrapper borderedIn: (0.0 @ 0.08 extent: 1.0 @ 0.33))
  52311.         insideColor: ColorValue white.
  52312.     self labelWrap: (container add: ' Prolog III Initial
  52313.  
  52314. Condition:' asText allBold asComposedText borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.08)).
  52315.     icListView := SelectionInListView
  52316.                 on: anICModel
  52317.                 printItems: false
  52318.                 oneItem: false
  52319.                 aspect: #listTransaction
  52320.                 change: #listSelection:
  52321.                 list: #listList
  52322.                 menu: #listMenu
  52323.                 initialSelection: nil
  52324.                 useIndex: true.
  52325.     myWrapper := self wrap: (LookPreferences edgeDecorator on: icListView).
  52326.     (container add: myWrapper borderedIn: (0.0 @ 0.49 extent: 0.3 @ 0.42))
  52327.         insideColor: ColorValue white.
  52328.     self labelWrap: (container add: ' Specific IC List:' asText allBold asComposedText borderedIn: (0.0 @ 0.41 extent: 0.3 @ 0.08)).    "new initial condition view"
  52329.     initialView := SelectionInListView
  52330.                 on: anICModel
  52331.                 printItems: false
  52332.                 oneItem: false
  52333.                 aspect: #icTransaction
  52334.                 change: #icSelection:
  52335.                 list: #icList
  52336.                 menu: #icMenu
  52337.                 initialSelection: nil
  52338.                 useIndex: true.
  52339.     myWrapper := self wrap: (LookPreferences edgeDecorator on: initialView).
  52340.     container add: myWrapper borderedIn: (0.3 @ 0.49 extent: 0.7 @ 0.42).
  52341.     self labelWrap: (container add: ' Selected Specific Initial
  52342.  
  52343. Condition:' asText allBold asComposedText borderedIn: (0.3 @ 0.41 extent: 0.7 @ 0.08)).
  52344.     up := 0.91.
  52345.     vsize := 0.08.
  52346.     left := 0.01.
  52347.     hsize := 0.17.    "Button for closing"
  52348.     cButton := PushButton named: 'Exit'.
  52349.     cButton model: ((PluggableAdaptor on: anICModel)
  52350.             getBlock: [:model | false]
  52351.             putBlock: [:model :value | TTMList closeWindow: 1 in: currentTTM]
  52352.             updateBlock: [:model :value :parameter | false]).
  52353.     (container add: cButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  52354.         insideColor: ColorValue white.
  52355.     left := left + hsize.    "Button for help"
  52356.     hButton := PushButton named: 'Help' asText allBold.
  52357.     hButton model: ((PluggableAdaptor on: anICModel)
  52358.             getBlock: [:model | false]
  52359.             putBlock: [:model :value | HelpScreens openHelp: 'specifying']
  52360.             updateBlock: [:model :value :parameter | false]).
  52361.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  52362.         insideColor: ColorValue white.
  52363.     window component: container.
  52364.     window open! !
  52365.  
  52366. !ConditionsWindow class methodsFor: 'decoration'!
  52367. labelWrap: aLabel 
  52368.     | newLabel |
  52369.     newLabel := aLabel.
  52370.     newLabel insideColor: ColorValue white.
  52371.     newLabel borderColor: ColorValue black.
  52372.     newLabel borderWidth: 1.
  52373.     ^newLabel! !
  52374.  
  52375. !ConditionsWindow class methodsFor: 'decoration'!
  52376. wrap: aWrapper 
  52377.     | newWrapper |
  52378.     newWrapper := aWrapper.
  52379.     newWrapper noMenuBar.    "newWrapper borderColor: ColorValue black."
  52380.     "newWrapper borderWidth: 1."
  52381.     ^newWrapper"newWrapper insideColor: ColorValue white."! !
  52382.  
  52383. ApplicationModel subclass: #SimulateWindow
  52384.     instanceVariableNames: 'currentTime currentTTM initialCondition finalCondition table tableEntry tabs ttmVariables icSelection fcSelection stop transitionTimes cursorPt displayedVariables filterActView filterDataView filterNewView filterWindowOpen variableLabels windowGC container filterWindow resultCollection simulateTable trajectoryTable tableInterface trajectoryList ncols nrows aLine total icList fcList fcTempString icFormatted clockList advanceNumber advanceTransition advanceTransitionNumber doAdvance doAdvanceTransition lastTransition advanceCount advanceTransitionNumberAspect transitionList tlMenuAspect tlOutAspect pause doAdvanceNoTick '
  52385.     classVariableNames: ''
  52386.     poolDictionaries: ''
  52387.     category: 'Build'!
  52388.  
  52389. !SimulateWindow methodsFor: 'initialize-release'!
  52390. correctVariables
  52391.     | name temp ind |
  52392.     temp := OrderedCollection new.
  52393.     currentTTM currentlyDisplayedSimulateVariables notNil
  52394.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  52395.                 do: 
  52396.                     [:cDV | 
  52397.                     name := cDV at: 1.
  52398.                     ind := 0.
  52399.                     initialCondition
  52400.                         do: 
  52401.                             [:t | 
  52402.                             ind := ind + 1.
  52403.                             (t at: 1)
  52404.                                 = name ifTrue: [temp add: (Array with: name with: ind)]]]]
  52405.         ifFalse: [^nil].
  52406.     ^temp asArray! !
  52407.  
  52408. !SimulateWindow methodsFor: 'initialize-release'!
  52409. initializeNTable
  52410.     | list |
  52411.     trajectoryList := OrderedCollection new.
  52412.     aLine := OrderedCollection new.
  52413.     list := TwoDList
  52414.                 on: trajectoryList
  52415.                 columns: 0
  52416.                 rows: 0.
  52417.     trajectoryTable := SelectionInTable with: list.
  52418.     tableInterface := TableInterface new.
  52419.     tableInterface selectionInTable: trajectoryTable.
  52420.       total := 0.
  52421.     nrows := 0.
  52422.     ncols := 0! !
  52423.  
  52424. !SimulateWindow methodsFor: 'initialize-release'!
  52425. initializeTable
  52426.     ttmVariables := OrderedCollection new.
  52427.     initialCondition do: [:x | ttmVariables add: ((Array ) with: (x at: 1) copy with: (x at: 2) copy)].
  52428.     icFormatted := OrderedCollection new.
  52429.       initialCondition do: [:x| icFormatted add:( (x at: 1), ' = ', (x at: 2)) ].
  52430.     icList list: icFormatted .
  52431.     self resetTable! !
  52432.  
  52433. !SimulateWindow methodsFor: 'initialize-release'!
  52434. initializeTTM: instanceOfTTM 
  52435.     "Prepare the TTM for displaying by initializing the variables."
  52436.  
  52437.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  52438.     advanceNumber := 1.
  52439.     advanceTransition := ''.
  52440.     advanceTransitionNumber := 1.
  52441.     doAdvance := false.
  52442.     doAdvanceTransition := false.
  52443.     doAdvanceNoTick := false.
  52444.     stop := true.
  52445.     currentTTM := instanceOfTTM.
  52446.     currentTime := 0.
  52447.     tabs := OrderedCollection new.
  52448.     transitionList := OrderedCollection new.
  52449.     transitionList add: 'NONE'; add: 'Any Transition'; add: 'Any except tick'; add: 'tick'.
  52450.     filterWindowOpen := False.
  52451.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  52452.                     with: (currentTTM defaultOfAV: (existingAV at: 1)) ].
  52453.     count := 1.
  52454.     currentTTM datavariable size
  52455.         timesRepeat: 
  52456.             [existingDV := currentTTM datavariable at: count.
  52457.             existingDV := Array with: (existingDV at: 1)
  52458.                         with: (existingDV at: 4).
  52459.             count := count + 1.
  52460.             initialCondition add: existingDV].
  52461.     finalCondition := '0=1'.
  52462.     fcTempString := finalCondition copy.
  52463.     fcList := fcTempString asValue.
  52464.     icFormatted := OrderedCollection new.
  52465.     initialCondition do: [:x | icFormatted add: (x at: 1)
  52466.                 , ' = ' , (x at: 2)].
  52467.     icList := SelectionInList new list: icFormatted.
  52468.     transitionTimes := OrderedCollection new.
  52469.     count := 1.
  52470.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  52471.     aTransitionCollection
  52472.         do: 
  52473.             [:x | 
  52474.             aTransitionEntry := OrderedCollection new.
  52475.             set := OrderedCollection new.
  52476.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  52477.             transitionList add: x myName.
  52478.             aTransitionEntry add: set; add: 0.
  52479.             transitionTimes add: aTransitionEntry].
  52480.     labels := OrderedCollection new.
  52481.     labels add: 'ticks'.
  52482.     currentTTM currentlyDisplayedSimulateVariables: self correctVariables.
  52483.     t1 := initialCondition size.
  52484.     currentTTM currentlyDisplayedSimulateVariables notNil
  52485.         ifTrue: 
  52486.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  52487.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  52488.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  52489.     self initializeNTable.
  52490.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  52491.     ncols := t1 + 1.
  52492.     self initializeTable! !
  52493.  
  52494. !SimulateWindow methodsFor: 'initialize-release'!
  52495. initializeTTMNew: instanceOfTTM 
  52496.     "Prepare the TTM for displaying by initializing the variables."
  52497.  
  52498.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  52499.     advanceNumber := 1.
  52500.     advanceTransition := ''.
  52501.     advanceTransitionNumber := 1.
  52502.     doAdvance := false.
  52503.     doAdvanceTransition := false.
  52504.       doAdvanceNoTick := false.
  52505.     stop := true.
  52506.     currentTTM := instanceOfTTM.
  52507.     currentTime := 0.
  52508.     tabs := OrderedCollection new.
  52509.     transitionList := OrderedCollection new.
  52510.     transitionList add: 'NONE'; add: 'Any Transition';  add: 'Any except tick';add: 'tick'.
  52511.     filterWindowOpen := False.
  52512.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  52513.                     with:(existingAV at: 2) inspect].
  52514.     count := 1.
  52515.     currentTTM datavariable size
  52516.         timesRepeat: 
  52517.             [existingDV := currentTTM datavariable at: count.
  52518.             existingDV := Array with: (existingDV at: 1)
  52519.                         with: (existingDV at: 4).
  52520.             count := count + 1.
  52521.             initialCondition add: existingDV].
  52522.     finalCondition := '0=1'.
  52523.     fcTempString := finalCondition copy.
  52524.     fcList := fcTempString asValue.
  52525.     icFormatted := OrderedCollection new.
  52526.     initialCondition do: [:x | icFormatted add: (x at: 1)
  52527.                 , ' = ' , (x at: 2)].
  52528.     icList := SelectionInList new list: icFormatted.
  52529.     transitionTimes := OrderedCollection new.
  52530.     count := 1.
  52531.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  52532.     aTransitionCollection
  52533.         do: 
  52534.             [:x | 
  52535.             aTransitionEntry := OrderedCollection new.
  52536.             set := OrderedCollection new.
  52537.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  52538.             transitionList add: x myName.
  52539.             aTransitionEntry add: set; add: 0.
  52540.             transitionTimes add: aTransitionEntry].
  52541.     labels := OrderedCollection new.
  52542.     labels add: 'ticks'.
  52543.     t1 := initialCondition size.
  52544.     currentTTM currentlyDisplayedSimulateVariables notNil
  52545.         ifTrue: 
  52546.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  52547.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  52548.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  52549.     self initializeNTable.
  52550.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  52551.     ncols := t1 + 1.
  52552.       
  52553.     self initializeTable! !
  52554.  
  52555. !SimulateWindow methodsFor: 'initialize-release'!
  52556. initializeTTMOld: instanceOfTTM 
  52557.     "Prepare the TTM for displaying by initializing the variables."
  52558.  
  52559.     | count existingDV aTransitionEntry set aTransitionCollection t1 labels |
  52560.     advanceNumber := 1.
  52561.     advanceTransition := ''.
  52562.     advanceTransitionNumber := 1.
  52563.     doAdvance := false.
  52564.     doAdvanceTransition := false.
  52565.       doAdvanceNoTick := false.
  52566.     stop := true.
  52567.     currentTTM := instanceOfTTM.
  52568.     currentTime := 0.
  52569.     tabs := OrderedCollection new.
  52570.     transitionList := OrderedCollection new.
  52571.     transitionList add: 'NONE'; add: 'Any Transition';  add: 'Any except tick';add: 'tick'.
  52572.     filterWindowOpen := False.
  52573.     initialCondition := currentTTM activityvariable collect: [:existingAV | Array with: (existingAV at: 1)
  52574.                     with: (currentTTM typeForAV: existingAV) last myName].
  52575.     count := 1.
  52576.     currentTTM datavariable size
  52577.         timesRepeat: 
  52578.             [existingDV := currentTTM datavariable at: count.
  52579.             existingDV := Array with: (existingDV at: 1)
  52580.                         with: (existingDV at: 4).
  52581.             count := count + 1.
  52582.             initialCondition add: existingDV].
  52583.     finalCondition := '0=1'.
  52584.     fcTempString := finalCondition copy.
  52585.     fcList := fcTempString asValue.
  52586.     icFormatted := OrderedCollection new.
  52587.     initialCondition do: [:x | icFormatted add: (x at: 1)
  52588.                 , ' = ' , (x at: 2)].
  52589.     icList := SelectionInList new list: icFormatted.
  52590.     transitionTimes := OrderedCollection new.
  52591.     count := 1.
  52592.     aTransitionCollection := currentTTM computeEffectiveTransitions.
  52593.     aTransitionCollection
  52594.         do: 
  52595.             [:x | 
  52596.             aTransitionEntry := OrderedCollection new.
  52597.             set := OrderedCollection new.
  52598.             set add: x myName; add: x myGuard; add: x myAction; add: x boundLower; add: x boundUpper.
  52599.             transitionList add: x myName.
  52600.             aTransitionEntry add: set; add: 0.
  52601.             transitionTimes add: aTransitionEntry].
  52602.     labels := OrderedCollection new.
  52603.     labels add: 'ticks'.
  52604.     t1 := initialCondition size.
  52605.     currentTTM currentlyDisplayedSimulateVariables notNil
  52606.         ifTrue: 
  52607.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  52608.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  52609.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  52610.     self initializeNTable.
  52611.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  52612.     ncols := t1 + 1.
  52613.       
  52614.     self initializeTable! !
  52615.  
  52616. !SimulateWindow methodsFor: 'condition maintenance'!
  52617. fcAccept
  52618.     self fcAccept: fcList value! !
  52619.  
  52620. !SimulateWindow methodsFor: 'condition maintenance'!
  52621. fcAccept: candidateCondition 
  52622.     | accept cCondition |
  52623.     accept := false.
  52624.     candidateCondition isEmpty
  52625.         ifTrue: [cCondition := 'nil']
  52626.         ifFalse: [cCondition := candidateCondition].
  52627.     cCondition asString = 'nil'
  52628.         ifTrue: [accept := true]
  52629.         ifFalse: [(ParseTree guardSyntaxCheck: cCondition asString from: currentTTM)
  52630.                 ifFalse: [accept := true]].
  52631.     accept = false
  52632.         ifFalse: 
  52633.             [finalCondition := cCondition asString.
  52634.             self changed: #fcList.
  52635.             ^true]
  52636.         ifTrue: 
  52637.             [TTMList speak: 'revised stopping condition rejected.'.
  52638.             self changed: #fcList.
  52639.             ^true]! !
  52640.  
  52641. !SimulateWindow methodsFor: 'condition maintenance'!
  52642. fcMenu
  52643.     "Answer a menu for the final condition view."
  52644.  
  52645.     ^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #fcAccept #cancel )! !
  52646.  
  52647. !SimulateWindow methodsFor: 'condition maintenance'!
  52648. icChange
  52649.     "Change initial value of a variable."
  52650.  
  52651.     | initial oldInitial actual |
  52652.     icList selection ~~ nil ifFalse: []
  52653.         ifTrue: 
  52654.             [actual := initialCondition at: icList selectionIndex.
  52655.             oldInitial := actual at: 2.
  52656.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  52657.             (currentTTM anExistingDV: (actual at: 1))
  52658.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  52659.                         ifFalse: 
  52660.                             [TTMList speak: 'illegal data variable value.'.
  52661.                             ^self]]
  52662.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  52663.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  52664.                                 ifFalse: 
  52665.                                     [TTMList speak: 'illegal activity variable value.'.
  52666.                                     ^self]]
  52667.                         ifFalse: 
  52668.                             [TTMList speak: 'illegal activity variable value.'.
  52669.                             ^self]].
  52670.             initial isEmpty
  52671.                 ifTrue: [^self]
  52672.                 ifFalse: 
  52673.                     [actual at: 2 put: initial.
  52674.                     icFormatted := OrderedCollection new.
  52675.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  52676.                                 , ' = ' , (x at: 2)].
  52677.                     icList list: icFormatted.
  52678.                     self doClear.
  52679.                     self changed: #icTransaction]]! !
  52680.  
  52681. !SimulateWindow methodsFor: 'condition maintenance'!
  52682. icChangeNew
  52683.     "Change initial value of a variable."
  52684.  
  52685.     | initial oldInitial actual |
  52686.     icList selection ~~ nil ifFalse: []
  52687.         ifTrue: 
  52688.             [actual := initialCondition at: icList selectionIndex.
  52689.             oldInitial := actual at: 2.
  52690.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  52691.             (currentTTM anExistingDV: (actual at: 1))
  52692.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  52693.                         ifFalse: 
  52694.                             [TTMList speak: 'illegal data variable value.'.
  52695.                             ^self]]
  52696.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  52697.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  52698.                                 ifFalse: 
  52699.                                     [TTMList speak: 'illegal activity variable value.'.
  52700.                                     ^self]]
  52701.                         ifFalse: 
  52702.                             [TTMList speak: 'illegal activity variable value.'.
  52703.                             ^self]].
  52704.             initial isEmpty
  52705.                 ifTrue: [^self]
  52706.                 ifFalse: 
  52707.                     [actual at: 2 put: initial.
  52708.                     icFormatted := OrderedCollection new.
  52709.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  52710.                                 , ' = ' , (x at: 2)].
  52711.                     icList list: icFormatted.
  52712.                     self doClear.
  52713.                     self changed: #icTransaction]]! !
  52714.  
  52715. !SimulateWindow methodsFor: 'condition maintenance'!
  52716. icChangeOld
  52717.     "Change initial value of a variable."
  52718.  
  52719.     | initial oldInitial actual |
  52720.     icList selection ~~ nil ifFalse: []
  52721.         ifTrue: 
  52722.             [actual := initialCondition at: icList selectionIndex.
  52723.             oldInitial := actual at: 2.
  52724.             initial := DialogView request: 'New initial value of ' , (actual at: 1) , '?' initialAnswer: oldInitial.
  52725.             (currentTTM anExistingDV: (actual at: 1))
  52726.                 ifTrue: [(currentTTM isInDVRange: initial of: (actual at: 1))
  52727.                         ifFalse: 
  52728.                             [TTMList speak: 'illegal data variable value.'.
  52729.                             ^self]]
  52730.                 ifFalse: [(currentTTM anExistingAV: (actual at: 1))
  52731.                         ifTrue: [initial = 'True' | (currentTTM isInAVRange: initial of: (actual at: 1))
  52732.                                 ifFalse: 
  52733.                                     [TTMList speak: 'illegal activity variable value.'.
  52734.                                     ^self]]
  52735.                         ifFalse: 
  52736.                             [TTMList speak: 'illegal activity variable value.'.
  52737.                             ^self]].
  52738.             initial isEmpty
  52739.                 ifTrue: [^self]
  52740.                 ifFalse: 
  52741.                     [actual at: 2 put: initial.
  52742.                     icFormatted := OrderedCollection new.
  52743.                     initialCondition do: [:x | icFormatted add: (x at: 1)
  52744.                                 , ' = ' , (x at: 2)].
  52745.                     icList list: icFormatted.
  52746.                     self changed: #icTransaction.
  52747.                     self initializeTable]]! !
  52748.  
  52749. !SimulateWindow methodsFor: 'condition maintenance'!
  52750. icMenu
  52751.     "Answer a menu for the initial condition view."
  52752.  
  52753.     "icSelection == nil ifTrue: [^nil]."
  52754.     ^PopUpMenu labelList: #(#('new initial value' ) ) values: #(#icChange )! !
  52755.  
  52756. !SimulateWindow methodsFor: 'condition maintenance'!
  52757. icSelection: index 
  52758.     "If the selection has been changed, remember the new 
  52759.     
  52760.     selection."
  52761.  
  52762.     | newSel |
  52763.     newSel := index = 0
  52764.                 ifTrue: [nil]
  52765.                 ifFalse: [initialCondition at: index].
  52766.     icSelection == newSel ifTrue: [^self].
  52767.     icSelection := newSel! !
  52768.  
  52769. !SimulateWindow methodsFor: 'condition maintenance'!
  52770. tlMenu
  52771.     ""
  52772.  
  52773.     
  52774.     ^tlMenuAspect! !
  52775.  
  52776. !SimulateWindow methodsFor: 'table access'!
  52777. addEntry
  52778.     "add the current entry to the table."
  52779.  
  52780.     table addFirst: tableEntry.
  52781.     self changed: #tableTransaction! !
  52782.  
  52783. !SimulateWindow methodsFor: 'table access'!
  52784. addLatestValues
  52785.     "Add the latest values of the ttmVariables to the table and display it."
  52786.  
  52787.     | count existingVariable |
  52788.     count := 1.
  52789.     self addStringToLine: currentTime printString.
  52790.     currentTTM currentlyDisplayedSimulateVariables notNil
  52791.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  52792.                 do: 
  52793.                     [:cDV | 
  52794.                     self addStringToLine: ((ttmVariables at: (cDV at: 2))
  52795.                             at: 2).
  52796.                     count := count + 1]]
  52797.         ifFalse: [ttmVariables size = 0 ifFalse: [[count > ttmVariables size]
  52798.                     whileFalse: 
  52799.                         [existingVariable := ttmVariables at: count.
  52800.                         self addStringToLine: (existingVariable at: 2).
  52801.                         count := count + 1]]].
  52802.     self putLine! !
  52803.  
  52804. !SimulateWindow methodsFor: 'table access'!
  52805. addLatestValuesNew
  52806.     "Add the latest values of the ttmVariables to the table and display it."
  52807.  
  52808.     | count existingVariable |
  52809.     count := 1.
  52810.     self addStringToLine: currentTime printString.
  52811.     currentTTM currentlyDisplayedSimulateVariables notNil
  52812.         ifTrue: [currentTTM currentlyDisplayedSimulateVariables
  52813.                 do: 
  52814.                     [:cDV | 
  52815.                     self addStringToLine: ((ttmVariables at: (cDV at: 2))
  52816.                             at: 2).
  52817.                     count := count + 1]]
  52818.         ifFalse: [ttmVariables size = 0 ifFalse: [[count > ttmVariables size]
  52819.                     whileFalse: 
  52820.                         [existingVariable := ttmVariables at: count.
  52821.                         self addStringToLine: (existingVariable at: 2).
  52822.                         count := count + 1]]].
  52823.     self putLine! !
  52824.  
  52825. !SimulateWindow methodsFor: 'table access'!
  52826. addTransition: transitionName 
  52827.     "Add a transition and arrow to the table and display it."
  52828.  
  52829.     | count sp |
  52830.     sp := 3.
  52831.     count := 1.
  52832.     ncols = 2
  52833.         ifTrue: 
  52834.             [self addStringToLine: ''.
  52835.             self addStringToLine: '  ^' , transitionName]
  52836.         ifFalse: [ncols
  52837.                 timesRepeat: 
  52838.                     [count >= sp & (count \\ sp) == 0 ifFalse: [self addStringToLine: '']
  52839.                         ifTrue: [self addStringToLine: '  ^' , transitionName].
  52840.                     count := count + 1]].
  52841.     self putLine! !
  52842.  
  52843. !SimulateWindow methodsFor: 'table access'!
  52844. addTransitionNew: transitionName 
  52845.     "Add a transition and arrow to the table and display it."
  52846.  
  52847.     | midpoint |
  52848.     midpoint := (ncols / 2) ceiling.
  52849.     self addStringToLine: ' | ' , transitionName.
  52850.     2 to: midpoint do: [:x | self addStringToLine: ''].
  52851.     self addStringToLine: ' | '.
  52852.      (midpoint+ 1) to: ncols do: [:x | self addStringToLine: ''].
  52853.     self putLine! !
  52854.  
  52855. !SimulateWindow methodsFor: 'table access'!
  52856. addTransitionOld: transitionName 
  52857.     "Add a transition and arrow to the table and display it."
  52858.     "[table size > 5] whileTrue: [table removeLast]."
  52859.  
  52860.     | midpoint newName |
  52861.  
  52862.     midpoint := ((tabs at: tabs size - 1)
  52863.                 / 2) ceiling.
  52864.     self clearEntry.
  52865.     tableEntry
  52866.         replaceFrom: midpoint
  52867.         to: midpoint
  52868.         with: '|'.
  52869.     self addEntry.
  52870.     self clearEntry.
  52871.     newName := '| ' , transitionName.
  52872.     tableEntry
  52873.         replaceFrom: midpoint
  52874.         to: midpoint + newName size - 1
  52875.         with: newName.
  52876.     self addEntry.
  52877.     self clearEntry.
  52878.     tableEntry
  52879.         replaceFrom: midpoint
  52880.         to: midpoint
  52881.         with: '^'.
  52882.     self addEntry.
  52883.     self clearEntry! !
  52884.  
  52885. !SimulateWindow methodsFor: 'table access'!
  52886. atTab: tabNumber put: aString 
  52887.     "At the supplied tab position insert aString into the tableEntry."
  52888.  
  52889.     | start length allowedLength newString |
  52890.     start := tabs at: tabNumber.
  52891.     length := aString size.
  52892.     allowedLength := (tabs at: tabNumber + 1)
  52893.                 - (start + 1).
  52894.     length > allowedLength
  52895.         ifTrue: 
  52896.             [newString := aString copyFrom: 1 to: allowedLength.
  52897.             tableEntry
  52898.                 replaceFrom: start
  52899.                 to: start + allowedLength - 1
  52900.                 with: newString]
  52901.         ifFalse: [tableEntry
  52902.                 replaceFrom: start
  52903.                 to: start + length - 1
  52904.                 with: aString]! !
  52905.  
  52906. !SimulateWindow methodsFor: 'table access'!
  52907. clearEntry
  52908.     | tableSize |
  52909.     tableEntry := ''.
  52910.     currentTTM currentlyDisplayedSimulateVariables notNil
  52911.         ifTrue: [tableSize := currentTTM currentlyDisplayedSimulateVariables size * 10]
  52912.         ifFalse: [tableSize := ttmVariables size * 10].
  52913.     tableSize < 80 ifTrue: [tableSize := 80].
  52914.     tableSize timesRepeat: [tableEntry := tableEntry , ' ']! !
  52915.  
  52916. !SimulateWindow methodsFor: 'table access'!
  52917. resetTable
  52918.     "Clear the table and initialize it to the current 
  52919.     
  52920.     values of the ttmVariables."
  52921.  
  52922.     table := OrderedCollection new.
  52923.     self addLatestValues! !
  52924.  
  52925. !SimulateWindow methodsFor: 'table access'!
  52926. tableList
  52927.     "Return a list of the transition entries."
  52928.  
  52929.     ^table collect: [:currentEntry | currentEntry]! !
  52930.  
  52931. !SimulateWindow methodsFor: 'filter window access'!
  52932. acceptAllActs
  52933.     self actVarList do: [:var | (displayedVariables includes: var)
  52934.             ifFalse: [displayedVariables addLast: var]].
  52935.     filterNewView update: #newVarList! !
  52936.  
  52937. !SimulateWindow methodsFor: 'filter window access'!
  52938. acceptAlldata
  52939.     self dataVarList do: [:var | (displayedVariables includes: var)
  52940.             ifFalse: [displayedVariables addLast: var]].
  52941.     filterNewView update: #newVarList! !
  52942.  
  52943. !SimulateWindow methodsFor: 'filter window access'!
  52944. actVarList
  52945.  
  52946.      ^currentTTM activityvariable collect: [:x | x at: 1]! !
  52947.  
  52948. !SimulateWindow methodsFor: 'filter window access'!
  52949. addAVarToList: ignore 
  52950.     | selection chosen |
  52951.     filterActView notNil
  52952.         ifTrue: 
  52953.             [selection := filterActView selection.
  52954.             selection > 0
  52955.                 ifTrue: 
  52956.                     [chosen := self actVarList at: selection.
  52957.                     (displayedVariables includes: chosen)
  52958.                         ifFalse: 
  52959.                             [displayedVariables addLast: chosen.
  52960.                             filterNewView update: #newVarList]]]! !
  52961.  
  52962. !SimulateWindow methodsFor: 'filter window access'!
  52963. addDVarToList: ignore 
  52964.     | selection chosen |
  52965.     filterDataView notNil
  52966.         ifTrue: 
  52967.             [selection := filterDataView selection.
  52968.             selection > 0
  52969.                 ifTrue: 
  52970.                     [chosen := self dataVarList at: selection.
  52971.                     (displayedVariables includes: chosen)
  52972.                         ifFalse: 
  52973.                             [displayedVariables addLast: chosen.
  52974.                             filterNewView update: #newVarList]]]! !
  52975.  
  52976. !SimulateWindow methodsFor: 'filter window access'!
  52977. addVarToList: ignore! !
  52978.  
  52979. !SimulateWindow methodsFor: 'filter window access'!
  52980. aVarListMenu
  52981.  
  52982.     ^PopUpMenu labelList: #(#('accept all' ) ) values: #(#acceptAllActs )! !
  52983.  
  52984. !SimulateWindow methodsFor: 'filter window access'!
  52985. closeFilter
  52986.     filterWindowOpen := False.
  52987.     "super removeDependent: filterWindow."
  52988.     filterWindow controller close! !
  52989.  
  52990. !SimulateWindow methodsFor: 'filter window access'!
  52991. dataVarList
  52992.     ^currentTTM datavariable collect: [:x | x at: 1]! !
  52993.  
  52994. !SimulateWindow methodsFor: 'filter window access'!
  52995. doAcceptFilter
  52996.     "Accept new set of Variables to be displayed in Simulation Window. 
  52997.     Reset the simulation to its initial state"
  52998.  
  52999.     | variables textLabels ttmVarSize c2 ttmVar newArray theArray c1 |
  53000.     textLabels := OrderedCollection new.
  53001.     theArray := Array new: displayedVariables size.
  53002.     ttmVar := nil.
  53003.     ttmVarSize := ttmVariables size.
  53004.     c1 := 1.
  53005.     displayedVariables
  53006.         do: 
  53007.             [:aDV | 
  53008.             newArray := Array new: 2.
  53009.             newArray at: 1 put: aDV.
  53010.             c2 := 1.
  53011.             [c2 > ttmVarSize | (aDV = ttmVar)]
  53012.                 whileFalse: 
  53013.                     [ttmVar := (ttmVariables at: c2)
  53014.                                 at: 1.
  53015.                     aDV = ttmVar
  53016.                         ifTrue: 
  53017.                             [newArray at: 2 put: c2.
  53018.                             theArray at: c1 put: newArray.
  53019.                             c1 := c1 + 1].
  53020.                     c2 := c2 + 1]].
  53021.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  53022.     variables := displayedVariables.
  53023.     variables do: [:aVar | textLabels add: (aVar at: 1)].
  53024.     tableInterface columnLabelsArray: textLabels asArray; columnLabelsFormats: #left; columnWidths: #(100 ).
  53025.     self doClear.
  53026.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  53027.  
  53028. !SimulateWindow methodsFor: 'filter window access'!
  53029. doAcceptFilterNew
  53030.     "Accept new set of Variable to be displayed in Simulation 
  53031.     
  53032.     Window. 
  53033.     
  53034.     Reset the simulation to its initial state"
  53035.  
  53036.     | variables textLabels     ttmVarSize c2 ttmVar newArray theArray c1  |
  53037.     textLabels := OrderedCollection new.
  53038.     theArray := Array new: displayedVariables size.
  53039.     ttmVar := nil.
  53040.     ttmVarSize := ttmVariables size.
  53041.     c1 := 1.
  53042.     displayedVariables
  53043.         do: 
  53044.             [:aDV | 
  53045.             newArray := Array new: 2.
  53046.             newArray at: 1 put: aDV.
  53047.             c2 := 1.
  53048.             [c2 > ttmVarSize | (aDV = ttmVar)]
  53049.                 whileFalse: 
  53050.                     [ttmVar := (ttmVariables at: c2)
  53051.                                 at: 1.
  53052.                     aDV = ttmVar
  53053.                         ifTrue: 
  53054.                             [newArray at: 2 put: c2.
  53055.                             theArray at: c1 put: newArray.
  53056.                             c1 := c1 + 1].
  53057.                     c2 := c2 + 1]].
  53058.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  53059.     variables := displayedVariables.
  53060.     variables do: [:aVar | textLabels add: aVar at: 1].
  53061.     tableInterface columnLabelsArray: textLabels asArray; columnLabelsFormats: #left;columnWidths: #(100)
  53062.     self doClear.
  53063.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  53064.  
  53065. !SimulateWindow methodsFor: 'filter window access'!
  53066. doAcceptFilterOld
  53067.     "Accept new set of Variable to be displayed in Simulation 
  53068.     
  53069.     Window. 
  53070.     
  53071.     Reset the simulation to its initial state"
  53072.  
  53073.     | variables textLabels temp end iSize pad ttmVarSize c2 ttmVar newArray theArray c1 temp1 |
  53074.     theArray := Array new: displayedVariables size.
  53075.     self setTabs: displayedVariables size forVariableLength: 7.
  53076.     iSize := variableLabels text size.
  53077.     textLabels := ' t:     '.
  53078.     temp1 := ''.
  53079.     8 to: iSize do: [:x | temp1 := temp1 , ' '].
  53080.     variableLabels
  53081.         replaceFrom: 8
  53082.         to: iSize
  53083.         with: temp1.
  53084.     ttmVar := nil.
  53085.     ttmVarSize := ttmVariables size.
  53086.     c1 := 1.
  53087.     displayedVariables
  53088.         do: 
  53089.             [:aDV | 
  53090.             newArray := Array new: 2.
  53091.             newArray at: 1 put: aDV.
  53092.             c2 := 1.
  53093.             [c2 > ttmVarSize | (aDV = ttmVar)]
  53094.                 whileFalse: 
  53095.                     [ttmVar := (ttmVariables at: c2)
  53096.                                 at: 1.
  53097.                     aDV = ttmVar
  53098.                         ifTrue: 
  53099.                             [newArray at: 2 put: c2.
  53100.                             theArray at: c1 put: newArray.
  53101.                             c1 := c1 + 1].
  53102.                     c2 := c2 + 1]].
  53103.     currentTTM currentlyDisplayedSimulateVariables: theArray.
  53104.     variables := displayedVariables.
  53105.     variables
  53106.         do: 
  53107.             [:aVar | 
  53108.             temp := ''.
  53109.             end := 7.
  53110.             aVar size < 7
  53111.                 ifTrue: 
  53112.                     [end := aVar size.
  53113.                     pad := 7 - end.
  53114.                     1 to: pad do: [:y | temp := temp , ' ']].
  53115.             textLabels := textLabels , (aVar copyFrom: 1 to: end) , temp].
  53116.     windowGC medium width notNil
  53117.         ifTrue: 
  53118.             ["container remove: variableLabels."
  53119.             variableLabels := ComposedText withText: textLabels style: (TextAttributes styleNamed: #fixed).
  53120.             SimulateWindow labelWrap: (container add: variableLabels borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05))]
  53121.         ifFalse: [variableLabels
  53122.                 replaceFrom: 1
  53123.                 to: textLabels size
  53124.                 with: textLabels].
  53125.     self doClear.
  53126.     filterWindowOpen = True ifTrue: [self closeFilter]! !
  53127.  
  53128. !SimulateWindow methodsFor: 'filter window access'!
  53129. dumb! !
  53130.  
  53131. !SimulateWindow methodsFor: 'filter window access'!
  53132. dumb: ignore! !
  53133.  
  53134. !SimulateWindow methodsFor: 'filter window access'!
  53135. dVarListMenu
  53136.     ^PopUpMenu labelList: #(#('accept all' ) ) values: #(#acceptAlldata )! !
  53137.  
  53138. !SimulateWindow methodsFor: 'filter window access'!
  53139. newVarList
  53140.     ^displayedVariables! !
  53141.  
  53142. !SimulateWindow methodsFor: 'filter window access'!
  53143. newVarListMenu
  53144.  
  53145.     | selection |
  53146.  
  53147.     filterNewView notNil
  53148.  
  53149.         ifTrue: 
  53150.  
  53151.             [selection := filterNewView selection.
  53152.  
  53153.             selection > 0 ifFalse: [^PopUpMenu labelList: #(#('remove all' ) ) values: #(#removeAll )]
  53154.  
  53155.                 ifTrue: [^PopUpMenu labelList: #(#('remove variable' 'remove all' ) ) values: #(#removeVar #removeAll )]]! !
  53156.  
  53157. !SimulateWindow methodsFor: 'filter window access'!
  53158. removeAll
  53159.  
  53160.     displayedVariables := OrderedCollection new.
  53161.  
  53162.     filterNewView update: #newVarList! !
  53163.  
  53164. !SimulateWindow methodsFor: 'filter window access'!
  53165. removeVar
  53166.  
  53167.     displayedVariables removeAtIndex: filterNewView selection.
  53168.  
  53169.     filterNewView update: #newVarList! !
  53170.  
  53171. !SimulateWindow methodsFor: 'filter window access'!
  53172. varListMenu
  53173.  
  53174.     ^PopUpMenu labelList: #(#(#acceptAll ) ) values: #(#acceptAll )! !
  53175.  
  53176. !SimulateWindow methodsFor: 'filter window access'!
  53177. varNameList
  53178.  
  53179.     ^displayedVariables! !
  53180.  
  53181. !SimulateWindow methodsFor: 'button access'!
  53182. doClear
  53183.     ttmVariables := OrderedCollection new.
  53184.     initialCondition do: [:x | ttmVariables add: ((Array ) with: (x at: 1) copy with: (x at: 2) copy)].
  53185.     self accessTimeFor: #all to: #initialize.
  53186.     self clockReset.
  53187.     "self resetTable"
  53188.     self reset! !
  53189.  
  53190. !SimulateWindow methodsFor: 'button access'!
  53191. doFilter
  53192.     | topWin topView label acceptButton qButton |
  53193.     filterWindowOpen == True ifTrue: [^nil].
  53194.     filterWindowOpen := True.
  53195.     label := 'Filter Variables for : ' , currentTTM named.
  53196.     topWin := ScheduledWindow
  53197.                 model: self
  53198.                 label: label
  53199.                 minimumSize: 350 @ 350.
  53200.     topView := CompositePart new.
  53201.     topWin component: topView.
  53202.     filterWindow := topWin.
  53203.     topView add: 'Activity Variables' asText allBold asComposedText borderedIn: (0.0 @ 0.0 extent: 0.5 @ 0.08).
  53204.     topView add: 'Data Variables' asText allBold asComposedText borderedIn: (0.5 @ 0.0 extent: 0.5 @ 0.08).
  53205.     filterActView := SelectionInListView
  53206.                 on: self
  53207.                 aspect: #actVarList
  53208.                 change: #addAVarToList:
  53209.                 list: #actVarList
  53210.                 menu: #aVarListMenu
  53211.                 initialSelection: nil.
  53212.     topView add: (LookPreferences edgeDecorator on: filterActView)
  53213.         in: (0.0 @ 0.08 extent: 0.5 @ 0.3).
  53214.     filterDataView := SelectionInListView
  53215.                 on: self
  53216.                 aspect: #varNameList
  53217.                 change: #addDVarToList:
  53218.                 list: #dataVarList
  53219.                 menu: #dVarListMenu
  53220.                 initialSelection: nil.
  53221.     topView add: (LookPreferences edgeDecorator on: filterDataView)
  53222.         in: (0.5 @ 0.08 extent: 0.5 @ 0.3).
  53223.     filterNewView := SelectionInListView
  53224.                 on: self
  53225.                 aspect: #newVarList
  53226.                 change: #dumb:
  53227.                 list: #newVarList
  53228.                 menu: #newVarListMenu
  53229.                 initialSelection: nil.
  53230.     topView add: (LookPreferences edgeDecorator on: filterNewView)
  53231.         in: (0.0 @ 0.405 extent: 1.0 @ 0.5).    "*********************"
  53232.     "***********************"
  53233.     "Button accepting filtering out variables"
  53234.     acceptButton := PushButton named: 'Accept for Simulation'.
  53235.     acceptButton model: ((PluggableAdaptor on: self)
  53236.             getBlock: [:model | false]
  53237.             putBlock: [:model :value | model doAcceptFilter]
  53238.             updateBlock: [:model :value :parameter | false]).
  53239.     (topView add: acceptButton borderedIn: ((LayoutFrame new) leftFraction: 0.0; topFraction: 0.9; rightFraction: 0.49; bottomFraction: 0.96))
  53240.         insideColor: ColorValue white.    "Button for 
  53241.     
  53242.     quitting"
  53243.     qButton := PushButton named: 'Exit'.
  53244.     qButton model: ((PluggableAdaptor on: self)
  53245.             getBlock: [:model | false]
  53246.             putBlock: [:model :value | model closeFilter]
  53247.             updateBlock: [:model :value :parameter | false]).
  53248.     (topView add: qButton borderedIn: ((LayoutFrame new) leftFraction: 0.5; topFraction: 0.9; rightFraction: 0.99; bottomFraction: 0.96))
  53249.         insideColor: ColorValue white.
  53250.     topWin openWithExtent: 350 @ 350! !
  53251.  
  53252. !SimulateWindow methodsFor: 'button access'!
  53253. doHelp
  53254.     HelpScreens openHelp: 'simulating'! !
  53255.  
  53256. !SimulateWindow methodsFor: 'button access'!
  53257. doStart
  53258.     stop := false.
  53259.     advanceCount := 0.
  53260.     pause := true.
  53261.     cursorPt := ScheduledControllers activeController sensor cursorPoint.
  53262.     self considerStopping
  53263.         ifTrue: 
  53264.             [stop := true.
  53265.             TTMList speak: 'Stopping Condition is already satisfied.']
  53266.         ifFalse: [[stop = false]
  53267.                 whileTrue: [self selectionOfTransitions]]! !
  53268.  
  53269. !SimulateWindow methodsFor: 'button access'!
  53270. doStates
  53271.     | completeList pending enabled mustOccur disabled aList count entire selection timeElapsed |
  53272.     completeList := self sortTransitions.
  53273.     pending := completeList at: 1.
  53274.     enabled := completeList at: 2.
  53275.     mustOccur := completeList at: 3.
  53276.     disabled := completeList at: 4.
  53277.     aList := OrderedCollection new.
  53278.     entire := disabled.
  53279.     count := 1.
  53280.     [count > disabled size]
  53281.         whileFalse: 
  53282.             [aList add: ((disabled at: count)
  53283.                     at: 1)
  53284.                     , ' is disabled'.
  53285.             count := count + 1].
  53286.     count := 1.
  53287.     [count > pending size]
  53288.         whileFalse: 
  53289.             [aList add: ((pending at: count)
  53290.                     at: 1)
  53291.                     , ' is pending'.
  53292.             entire add: (pending at: count).
  53293.             count := count + 1].
  53294.     count := 1.
  53295.     [count > enabled size]
  53296.         whileFalse: 
  53297.             [aList add: ((enabled at: count)
  53298.                     at: 1)
  53299.                     , ' is enabled'.
  53300.             entire add: (enabled at: count).
  53301.             count := count + 1].
  53302.     aList add: 'tick is enabled'.
  53303.     count := 1.
  53304.     [count > mustOccur size]
  53305.         whileFalse: 
  53306.             [aList add: ((mustOccur at: count)
  53307.                     at: 1)
  53308.                     , ' must occur before a tick'.
  53309.             entire add: (mustOccur at: count).
  53310.             count := count + 1].
  53311.     selection := (PopUpMenu labelList: (Array with: aList)) startUp.
  53312.     selection ~= 0 ifTrue: [(aList at: selection)
  53313.             ~= 'tick is enabled'
  53314.             ifTrue: 
  53315.                 [timeElapsed := TTMList convertToString: (self accessTimeFor: (entire at: selection)
  53316.                                 to: #return).
  53317.                 HelpScreens openTable: (Array with: (entire at: selection)
  53318.                         with: timeElapsed)]]! !
  53319.  
  53320. !SimulateWindow methodsFor: 'button access'!
  53321. doStep
  53322.     "Step through one transition of the TTM."
  53323.  
  53324.     stop := true.
  53325.     advanceCount := 0.
  53326.     self selectionOfTransitions! !
  53327.  
  53328. !SimulateWindow methodsFor: 'evaluating'!
  53329. considerStopping
  53330.     "Compare stopping condition with the current 
  53331.     
  53332.     values of the ttmVariables."
  53333.  
  53334.     ^(self evaluateTFunction: finalCondition asString)
  53335.         = true! !
  53336.  
  53337. !SimulateWindow methodsFor: 'evaluating'!
  53338. evaluateAtomsAs: atomType usingTree: parseTree 
  53339.     atomType = #function
  53340.         ifTrue: 
  53341.             [self functionTraverse: parseTree treeRoot.
  53342.             ^nil]
  53343.         ifFalse: 
  53344.             [self guardTraverse: parseTree treeRoot.
  53345.             ^parseTree treeRoot left contents = 'TRUE']! !
  53346.  
  53347. !SimulateWindow methodsFor: 'evaluating'!
  53348. functionEvaluatingNew: aString 
  53349.     "We assume that the function is syntactically 
  53350.     
  53351.     correct so we just go through the parse tree 
  53352.     
  53353.     and evaluate each expression. Nothing needs 
  53354.     
  53355.     to be returned. The variable values are changed."
  53356.  
  53357.     | components parseTree  |
  53358.     aString = 'nil'
  53359.         ifFalse: 
  53360.             [components := ParseTree fission: aString definedAs: #function.
  53361.             parseTree := ParseTree orderIntoTree: components from: currentTTM.
  53362.             resultCollection := OrderedCollection new.
  53363.             self evaluateAtomsAs: #function usingTree: parseTree.
  53364.             resultCollection do: [ :x |   self store: (x at: 2) in: (x at: 1)]]! !
  53365.  
  53366. !SimulateWindow methodsFor: 'evaluating'!
  53367. functionTraverse: start 
  53368.     "A recursive traversal. Because a function is made 
  53369.     
  53370.     up only of assignments ANDed together we just 
  53371.     
  53372.     do each atom's operation."
  53373.  
  53374.     start left ~= nil ifTrue: [self functionTraverse: start left].
  53375.     start right ~= nil ifTrue: [self functionTraverse: start right].
  53376.     start isAtom ifTrue: [self processFunctionAtom: start contents]! !
  53377.  
  53378. !SimulateWindow methodsFor: 'evaluating'!
  53379. guardEvaluating: aString and: fString 
  53380.     "We assume that the guard is syntactically 
  53381.     
  53382.     correct so we just go through the parse tree 
  53383.     
  53384.     and evaluate each expression. Returns true 
  53385.     
  53386.     if the guard evaluates to true given the 
  53387.     
  53388.     current values of the variables."
  53389.  
  53390.     | result |
  53391.     aString = 'nil' ifTrue: [^true].
  53392.     (fString findString: '?' startingAt: 1)
  53393.         ~= 0 | ((fString findString: '!!' startingAt: 1)
  53394.             ~= 0) ifTrue: [^false].
  53395.     result := self evaluateTGuard: aString.
  53396.     ^result! !
  53397.  
  53398. !SimulateWindow methodsFor: 'evaluating'!
  53399. guardTraverse: start 
  53400.     "A recursive traversal. ."
  53401.  
  53402.     | newContents c |
  53403.     start left ~= nil ifTrue: [self guardTraverse: start left].
  53404.     start right ~= nil ifTrue: [self guardTraverse: start right].
  53405.     newContents := 'FALSE'.
  53406.     start contents = 'ROOT' ifFalse: [start isAtom
  53407.             ifTrue: 
  53408.                 [(self processGuardAtom: start contents)
  53409.                     ifTrue: [newContents := 'TRUE'].
  53410.                 start contents: newContents]
  53411.             ifFalse: 
  53412.                 [c := start contents.
  53413.                 c = 'LEFT' | (c = 'FALSE' | (c = 'TRUE'))
  53414.                     ifTrue: [TTMList speak: 'we got parse tree node errors']
  53415.                     ifFalse: 
  53416.                         [c = 'AND' & (start left contents = 'TRUE' & (start right contents = 'TRUE')) ifTrue: [newContents := 'TRUE'].
  53417.                         c = 'OR' & (start left contents = 'TRUE' | (start right contents = 'TRUE')) ifTrue: [newContents := 'TRUE']].
  53418.                 start contents: newContents]]! !
  53419.  
  53420. !SimulateWindow methodsFor: 'evaluating'!
  53421. selectionOfTransitions
  53422.     | completeList enabled mustOccur choices aList count selected totalChoices found nChoice |
  53423.     completeList := self sortTransitions.
  53424.     choices := nil.
  53425.     aList := OrderedCollection new.
  53426.     totalChoices := 0.
  53427.     enabled := completeList at: 2.
  53428.     mustOccur := completeList at: 3.
  53429.     count := 1.
  53430.     choices := enabled.
  53431.     [count > enabled size]
  53432.         whileFalse: 
  53433.             [aList add: ((enabled at: count)
  53434.                     at: 1).
  53435.             totalChoices := totalChoices + 1.
  53436.             count := count + 1].
  53437.     mustOccur size = 0
  53438.         ifTrue: 
  53439.             [aList add: 'tick'.
  53440.             totalChoices := totalChoices + 1]
  53441.         ifFalse: 
  53442.             [count := 1.
  53443.             [count > mustOccur size]
  53444.                 whileFalse: 
  53445.                     [aList add: ((mustOccur at: count)
  53446.                             at: 1).
  53447.                     choices add: (mustOccur at: count).
  53448.                     totalChoices := totalChoices + 1.
  53449.                     count := count + 1]].
  53450.     nChoice := aList size.
  53451.     aList add: 'STOP'.
  53452.     stop = false ifTrue: [ScheduledControllers activeController sensor cursorPoint: cursorPt].
  53453.     advanceCount  isNil ifTrue: [advanceCount := 0].
  53454.     advanceCount   <  advanceTransitionNumberAspect value
  53455.         ifTrue: 
  53456.             [doAdvanceTransition = true ifTrue: [(selected := aList indexOf: advanceTransition) = 0
  53457.                     ifTrue: [pause := true]
  53458.                     ifFalse: [pause := false]].
  53459.             doAdvance = true ifTrue: [nChoice = 1
  53460.                     ifTrue: 
  53461.                         [selected := 1.
  53462.                         pause := false]
  53463.                     ifFalse: [pause := true]].
  53464.             doAdvanceNoTick = true ifTrue: [nChoice > 2
  53465.                     ifTrue: [pause := true]
  53466.                     ifFalse: [nChoice = 1
  53467.                             ifTrue: 
  53468.                                 [selected := 1.
  53469.                                 pause := false]
  53470.                             ifFalse: [(aList includes: 'tick')
  53471.                                     = true
  53472.                                     ifTrue: 
  53473.                                         [selected := 1.
  53474.                                         pause := false]
  53475.                                     ifFalse: [pause := true]]]]]
  53476.         ifFalse: [pause := true].
  53477.     pause = true
  53478.         ifTrue: 
  53479.             [selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  53480.             advanceCount := 1.
  53481.             pause := true]
  53482.         ifFalse: [advanceCount := advanceCount + 1].
  53483.     selected > totalChoices  | (selected = 0)
  53484.         ifTrue: [stop := true]
  53485.         ifFalse: 
  53486.             [lastTransition := aList at: selected.
  53487.             (aList at: selected)
  53488.                 = 'tick'
  53489.                 ifTrue: [self tick: completeList]
  53490.                 ifFalse: 
  53491.                     [count := 1.
  53492.                     found := false.
  53493.                     [count > choices size | (found = true)]
  53494.                         whileFalse: 
  53495.                             [found := (aList at: selected)
  53496.                                         = ((choices at: count)
  53497.                                                 at: 1).
  53498.                             found = true ifFalse: [count := count + 1]].
  53499.                     found = true
  53500.                         ifTrue: 
  53501.                             [self evaluateTFunction: ((choices at: count)
  53502.                                     at: 3).
  53503.                             self addTransition: ((choices at: count)
  53504.                                     at: 1).
  53505.                             self addLatestValues.
  53506.                             self accessTimeFor: (choices at: count)
  53507.                                 to: #reset]]].
  53508.     self considerStopping ifTrue: [stop := true]! !
  53509.  
  53510. !SimulateWindow methodsFor: 'evaluating'!
  53511. selectionOfTransitionsOld
  53512.     | completeList enabled mustOccur choices aList count selected totalChoices found nChoice |
  53513.     completeList := self sortTransitions.
  53514.     choices := nil.
  53515.     aList := OrderedCollection new.
  53516.     totalChoices := 0.
  53517.     enabled := completeList at: 2.
  53518.     mustOccur := completeList at: 3.
  53519.     count := 1.
  53520.     choices := enabled.
  53521.     [count > enabled size]
  53522.         whileFalse: 
  53523.             [aList add: ((enabled at: count)
  53524.                     at: 1).
  53525.             totalChoices := totalChoices + 1.
  53526.             count := count + 1].
  53527.     mustOccur size = 0
  53528.         ifTrue: 
  53529.             [aList add: 'tick'.
  53530.             totalChoices := totalChoices + 1]
  53531.         ifFalse: 
  53532.             [count := 1.
  53533.             [count > mustOccur size]
  53534.                 whileFalse: 
  53535.                     [aList add: ((mustOccur at: count)
  53536.                             at: 1).
  53537.                     choices add: (mustOccur at: count).
  53538.                     totalChoices := totalChoices + 1.
  53539.                     count := count + 1]].
  53540.     nChoice := aList size.
  53541.     aList add: 'STOP'.
  53542.     stop = false ifTrue: [ScheduledControllers activeController sensor cursorPoint: cursorPt].
  53543.     advanceCount  isNil ifTrue: [advanceCount := 0].
  53544.     advanceCount < advanceTransitionNumberAspect value
  53545.         ifTrue: 
  53546.             [doAdvanceTransition = true ifTrue: [(selected := aList indexOf: advanceTransition) = 0
  53547.                     ifTrue: [pause := true]
  53548.                     ifFalse: [pause := false]].
  53549.             doAdvance = true ifTrue: [nChoice = 1
  53550.                     ifTrue: 
  53551.                         [selected := 1.
  53552.                         pause := false]
  53553.                     ifFalse: [pause := true]].
  53554.             doAdvanceNoTick = true ifTrue: [nChoice > 2
  53555.                     ifTrue: [pause := true]
  53556.                     ifFalse: [nChoice = 1
  53557.                             ifTrue: 
  53558.                                 [selected := 1.
  53559.                                 pause := false]
  53560.                             ifFalse: [(aList includes: 'tick')
  53561.                                     = true
  53562.                                     ifTrue: 
  53563.                                         [selected := 1.
  53564.                                         pause := false]
  53565.                                     ifFalse: [pause := true]]]]]
  53566.         ifFalse: [pause := true].
  53567.     pause = true
  53568.         ifTrue: 
  53569.             [selected := (PopUpMenu labelList: (Array with: aList)) startUp.
  53570.             advanceCount := 0.
  53571.             pause := true]
  53572.         ifFalse: [advanceCount := advanceCount + 1].
  53573.     selected > totalChoices | (selected = 0)
  53574.         ifTrue: [stop := true]
  53575.         ifFalse: 
  53576.             [lastTransition := aList at: selected.
  53577.             (aList at: selected)
  53578.                 = 'tick'
  53579.                 ifTrue: [self tick: completeList]
  53580.                 ifFalse: 
  53581.                     [count := 1.
  53582.                     found := false.
  53583.                     [count > choices size | (found = true)]
  53584.                         whileFalse: 
  53585.                             [found := (aList at: selected)
  53586.                                         = ((choices at: count)
  53587.                                                 at: 1).
  53588.                             found = true ifFalse: [count := count + 1]].
  53589.                     found = true
  53590.                         ifTrue: 
  53591.                             [self evaluateTFunction: ((choices at: count)
  53592.                                     at: 3).
  53593.                             self addTransition: ((choices at: count)
  53594.                                     at: 1).
  53595.                             self addLatestValues.
  53596.                             self accessTimeFor: (choices at: count)
  53597.                                 to: #reset]]].
  53598.     self considerStopping ifTrue: [stop := true]! !
  53599.  
  53600. !SimulateWindow methodsFor: 'evaluating'!
  53601. sortTransitions
  53602.     "returns a sorted set of the transitions. The set 
  53603.     
  53604.     is comprised of four groups. Transitions disabled 
  53605.     
  53606.     in the current state, transitions pending (waiting 
  53607.     
  53608.     for more ticks of clock), transitions enabled (ready 
  53609.     
  53610.     to occur), and transitions mustOccur (their upper 
  53611.     
  53612.     bounds have been reached - they must occur or 
  53613.     
  53614.     be disabled before another clock tick)."
  53615.  
  53616.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  53617.     count := 1.
  53618.     complete := OrderedCollection new.
  53619.     pending := OrderedCollection new.
  53620.     enabled := OrderedCollection new.
  53621.     disabled := OrderedCollection new.
  53622.     mustOccur := OrderedCollection new.
  53623.     [count > transitionTimes size]
  53624.         whileFalse: 
  53625.             [currentEntry := transitionTimes at: count.
  53626.             currentTr := currentEntry at: 1.
  53627.             lower := TTMList convertToNumber: (currentTr at: 4).
  53628.             finiteUpper := (currentTr at: 5)
  53629.                         ~= 'infinity'.
  53630.             finiteUpper = true ifFalse: [upper := 0]
  53631.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  53632.             timeElapsed := currentEntry at: 2.
  53633.             (self evaluateTGuard: (currentTr at: 2))
  53634.                 ifTrue: [timeElapsed >= lower
  53635.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  53636.                                 ifTrue: [mustOccur add: currentTr]
  53637.                                 ifFalse: [enabled add: currentTr]]
  53638.                         ifFalse: [pending add: currentTr]]
  53639.                 ifFalse: 
  53640.                     [currentEntry at: 2 put: 0.
  53641.                     disabled add: currentTr].
  53642.             count := count + 1].
  53643.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  53644.     ^complete! !
  53645.  
  53646. !SimulateWindow methodsFor: 'evaluating'!
  53647. sortTransitionsNew
  53648.     "returns a sorted set of the transitions. The set 
  53649.     
  53650.     is comprised of four groups. Transitions disabled 
  53651.     
  53652.     in the current state, transitions pending (waiting 
  53653.     
  53654.     for more ticks of clock), transitions enabled (ready 
  53655.     
  53656.     to occur), and transitions mustOccur (their upper 
  53657.     
  53658.     bounds have been reached - they must occur or 
  53659.     
  53660.     be disabled before another clock tick)."
  53661.  
  53662.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  53663.     count := 1.
  53664.     complete := OrderedCollection new.
  53665.     pending := OrderedCollection new.
  53666.     enabled := OrderedCollection new.
  53667.     disabled := OrderedCollection new.
  53668.     mustOccur := OrderedCollection new.
  53669.     [count > transitionTimes size]
  53670.         whileFalse: 
  53671.             [currentEntry := transitionTimes at: count.
  53672.             currentTr := currentEntry at: 1.
  53673.             lower := TTMList convertToNumber: (currentTr at: 4).
  53674.             finiteUpper := (currentTr at: 5)
  53675.                         ~= 'infinity'.
  53676.             finiteUpper = true ifFalse: [upper := 0]
  53677.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  53678.             timeElapsed := currentEntry at: 2.
  53679.             (self guardEvaluating: (currentTr at: 2)
  53680.                 and: (currentTr at: 3))
  53681.                 ifTrue: [timeElapsed >= lower
  53682.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  53683.                                 ifTrue: [mustOccur add: currentTr]
  53684.                                 ifFalse: [enabled add: currentTr]]
  53685.                         ifFalse: [pending add: currentTr]]
  53686.                 ifFalse: 
  53687.                     [currentEntry at: 2 put: 0.
  53688.                     disabled add: currentTr].
  53689.             count := count + 1].
  53690.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  53691.     ^complete! !
  53692.  
  53693. !SimulateWindow methodsFor: 'evaluating'!
  53694. sortTransitionsNewG
  53695.     "returns a sorted set of the transitions. The set 
  53696.     
  53697.     is comprised of four groups. Transitions disabled 
  53698.     
  53699.     in the current state, transitions pending (waiting 
  53700.     
  53701.     for more ticks of clock), transitions enabled (ready 
  53702.     
  53703.     to occur), and transitions mustOccur (their upper 
  53704.     
  53705.     bounds have been reached - they must occur or 
  53706.     
  53707.     be disabled before another clock tick)."
  53708.  
  53709.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  53710.     count := 1.
  53711.     complete := OrderedCollection new.
  53712.     pending := OrderedCollection new.
  53713.     enabled := OrderedCollection new.
  53714.     disabled := OrderedCollection new.
  53715.     mustOccur := OrderedCollection new.
  53716.     [count > transitionTimes size]
  53717.         whileFalse: 
  53718.             [currentEntry := transitionTimes at: count.
  53719.             currentTr := currentEntry at: 1.
  53720.             lower := TTMList convertToNumber: (currentTr at: 4).
  53721.             finiteUpper := (currentTr at: 5)
  53722.                         ~= 'infinity'.
  53723.             finiteUpper = true ifFalse: [upper := 0]
  53724.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  53725.             timeElapsed := currentEntry at: 2.
  53726.             (self evaluateTGuard: (currentTr at: 2))
  53727.                 ifTrue: [timeElapsed >= lower
  53728.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  53729.                                 ifTrue: [mustOccur add: currentTr]
  53730.                                 ifFalse: [enabled add: currentTr]]
  53731.                         ifFalse: [pending add: currentTr]]
  53732.                 ifFalse: 
  53733.                     [currentEntry at: 2 put: 0.
  53734.                     disabled add: currentTr].
  53735.             count := count + 1].
  53736.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  53737.     ^complete! !
  53738.  
  53739. !SimulateWindow methodsFor: 'evaluating'!
  53740. sortTransitionsOld
  53741.     "returns a sorted set of the transitions. The set 
  53742.     
  53743.     is comprised of four groups. Transitions disabled 
  53744.     
  53745.     in the current state, transitions pending (waiting 
  53746.     
  53747.     for more ticks of clock), transitions enabled (ready 
  53748.     
  53749.     to occur), and transitions mustOccur (their upper 
  53750.     
  53751.     bounds have been reached - they must occur or 
  53752.     
  53753.     be disabled before another clock tick)."
  53754.  
  53755.     | count currentEntry currentTr complete pending enabled disabled mustOccur lower upper timeElapsed finiteUpper |
  53756.     count := 1.
  53757.     complete := OrderedCollection new.
  53758.     pending := OrderedCollection new.
  53759.     enabled := OrderedCollection new.
  53760.     disabled := OrderedCollection new.
  53761.     mustOccur := OrderedCollection new.
  53762.     [count > transitionTimes size]
  53763.         whileFalse: 
  53764.             [currentEntry := transitionTimes at: count.
  53765.             currentTr := currentEntry at: 1.
  53766.             lower := TTMList convertToNumber: (currentTr at: 4).
  53767.             finiteUpper := (currentTr at: 5)
  53768.                         ~= 'infinity'.
  53769.             finiteUpper = true ifFalse: [upper := 0]
  53770.                 ifTrue: [upper := TTMList convertToNumber: (currentTr at: 5)].
  53771.             timeElapsed := currentEntry at: 2.
  53772.             (self guardEvaluating: (currentTr at: 2)
  53773.                 and: (currentTr at: 3))
  53774.                 ifTrue: [timeElapsed >= lower
  53775.                         ifTrue: [finiteUpper = true & (timeElapsed >= upper)
  53776.                                 ifTrue: [mustOccur add: currentTr]
  53777.                                 ifFalse: [enabled add: currentTr]]
  53778.                         ifFalse: [pending add: currentTr]]
  53779.                 ifFalse: 
  53780.                     [currentEntry at: 2 put: 0.
  53781.                     disabled add: currentTr].
  53782.             count := count + 1].
  53783.     complete add: pending; add: enabled; add: mustOccur; add: disabled.
  53784.     ^complete! !
  53785.  
  53786. !SimulateWindow methodsFor: 'evaluating options'!
  53787. add: variable1 to: variable2 
  53788.     | value1 value2 value1asNumber value2asNumber result |
  53789.     value1 := self valueOf: variable1.
  53790.     value2 := self valueOf: variable2.
  53791.     value1 = '-infinity' ifTrue: [^value2].
  53792.     value2 = '-infinity' ifTrue: [^value1].
  53793.     value2 ~= 'infinity' & (value1 ~= 'infinity')
  53794.         ifTrue: 
  53795.             [value1asNumber := TTMList convertToNumber: value1.
  53796.             value2asNumber := TTMList convertToNumber: value2.
  53797.             result := TTMList convertToString: value1asNumber + value2asNumber.
  53798.             ^result]
  53799.         ifFalse: [^'infinity']! !
  53800.  
  53801. !SimulateWindow methodsFor: 'evaluating options'!
  53802. evaluateOperand: anAtom from: start to: end 
  53803.     "Evaluate and then return the value of the given operand."
  53804.  
  53805.     | p left operator variable |
  53806.     p := start.
  53807.     (anAtom at: start)
  53808.         = '+' ifTrue: [p := p + 1].
  53809.     (anAtom at: start)
  53810.         = '-'
  53811.         ifTrue: 
  53812.             [p := p + 1.
  53813.             left := self subtract: (anAtom at: p)
  53814.                         from: '0']
  53815.         ifFalse: [left := anAtom at: p].
  53816.     p := p + 1.
  53817.     [p > end]
  53818.         whileFalse: 
  53819.             [operator := anAtom at: p.
  53820.             p := p + 1.
  53821.             p > end ifTrue: [^left].
  53822.             (ParseTree isAnOperator: (anAtom at: p))
  53823.                 ifTrue: 
  53824.                     [operator = '-'
  53825.                         ifTrue: [(anAtom at: p)
  53826.                                 = '-' ifTrue: [operator := '+']]
  53827.                         ifFalse: [(#('*' '/' '%' ) includes: operator)
  53828.                                 ifTrue: [(anAtom at: p)
  53829.                                         = '-'
  53830.                                         ifTrue: [left := self subtract: left from: '0']
  53831.                                         ifFalse: []]
  53832.                                 ifFalse: [operator := anAtom at: p]].
  53833.                     p := p + 1.
  53834.                     p > end ifTrue: [^left]].
  53835.             variable := anAtom at: p.
  53836.             operator = '+' ifTrue: [left := self add: variable to: left].
  53837.             operator = '*' ifTrue: [left := self multiply: variable and: left].
  53838.             operator = '-' ifTrue: [left := self subtract: variable from: left].
  53839.             operator = '/' ifTrue: [left := self integerDivide: left and: variable].
  53840.             operator = '%' ifTrue: [left := self remainderOf: left and: variable].
  53841.             p := p + 1].
  53842.     ^left! !
  53843.  
  53844. !SimulateWindow methodsFor: 'evaluating options'!
  53845. integerDivide: variable1 and: variable2 
  53846.     | value1 value2 value1asNumber value2asNumber result |
  53847.     value1 := self valueOf: variable1.
  53848.     value2 := self valueOf: variable2.
  53849.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  53850.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^'0'].
  53851.     value1asNumber := TTMList convertToNumber: value1.
  53852.     value2asNumber := TTMList convertToNumber: value2.
  53853.     result := TTMList convertToString: value1asNumber // value2asNumber.
  53854.     ^result! !
  53855.  
  53856. !SimulateWindow methodsFor: 'evaluating options'!
  53857. is: variable1 equalTo: variable2 
  53858.     | value1 value2 |
  53859.     variable1 = 'True' | (variable2 = 'True')
  53860.         ifTrue: [^true]
  53861.         ifFalse: 
  53862.             [value1 := self valueOf: variable1.
  53863.             value2 := self valueOf: variable2.
  53864.             value1 = 'True' | (value2 = 'True')
  53865.                 ifTrue: [^true]
  53866.                 ifFalse: [^value1 = value2]]! !
  53867.  
  53868. !SimulateWindow methodsFor: 'evaluating options'!
  53869. is: variable1 greaterOrEqualTo: variable2 
  53870.     ^(self is: variable1 equalTo: variable2)
  53871.         | (self is: variable1 greaterThan: variable2)! !
  53872.  
  53873. !SimulateWindow methodsFor: 'evaluating options'!
  53874. is: variable1 greaterThan: variable2 
  53875.     | value1 value2 value1asNumber value2asNumber |
  53876.     variable1 = 'True' | (variable2 = 'True')
  53877.         ifTrue: [^true]
  53878.         ifFalse: 
  53879.             [value1 := self valueOf: variable1.
  53880.             value2 := self valueOf: variable2.
  53881.             value1 = 'True' | (value2 = 'True')
  53882.                 ifTrue: [^true]
  53883.                 ifFalse: 
  53884.                     [value2 = '-infinity' | (value1 = 'infinity' & (value2 ~= 'infinity')) ifTrue: [^true].
  53885.                     value1 = '-infinity' | (value2 = 'infinity') ifTrue: [^false].
  53886.                     value1asNumber := TTMList convertToNumber: value1.
  53887.                     value2asNumber := TTMList convertToNumber: value2.
  53888.                     ^value1asNumber > value2asNumber]]! !
  53889.  
  53890. !SimulateWindow methodsFor: 'evaluating options'!
  53891. is: variable1 lessOrEqualTo: variable2 
  53892.     ^self is: variable2 greaterOrEqualTo: variable1! !
  53893.  
  53894. !SimulateWindow methodsFor: 'evaluating options'!
  53895. is: variable1 lessThan: variable2 
  53896.     ^self is: variable2 greaterThan: variable1! !
  53897.  
  53898. !SimulateWindow methodsFor: 'evaluating options'!
  53899. is: variable1 notEqualTo: variable2 
  53900.     (self is: variable1 equalTo: variable2)
  53901.         ifTrue: [^false]
  53902.         ifFalse: [^true]! !
  53903.  
  53904. !SimulateWindow methodsFor: 'evaluating options'!
  53905. multiply: variable1 and: variable2 
  53906.     | value1 value2 value1asNumber value2asNumber result |
  53907.     value1 := self valueOf: variable1.
  53908.     value2 := self valueOf: variable2.
  53909.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  53910.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^value2].
  53911.     value1asNumber := TTMList convertToNumber: value1.
  53912.     value2asNumber := TTMList convertToNumber: value2.
  53913.     result := TTMList convertToString: value1asNumber * value2asNumber.
  53914.     ^result! !
  53915.  
  53916. !SimulateWindow methodsFor: 'evaluating options'!
  53917. processFunctionAtom: anAtom 
  53918.     "store the calculated result in the respective variable."
  53919.  
  53920.     | operand result |
  53921.     operand := anAtom at: 1.
  53922.     result := self
  53923.                 evaluateOperand: anAtom
  53924.                 from: 3
  53925.                 to: anAtom size.
  53926.     anAtom size > 3
  53927.         ifFalse: 
  53928.             [result := anAtom at: 3.
  53929.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  53930.     resultCollection add: (Array with: operand with: result).
  53931.     "self store: result in: operand"! !
  53932.  
  53933. !SimulateWindow methodsFor: 'evaluating options'!
  53934. processFunctionAtomNew: anAtom 
  53935.     "store the calculated result in the respective variable."
  53936.  
  53937.     | operand result |
  53938.     operand := anAtom at: 1.
  53939.     result := self
  53940.                 evaluateOperand: anAtom
  53941.                 from: 3
  53942.                 to: anAtom size.
  53943.     anAtom size > 3
  53944.         ifFalse: 
  53945.             [result := anAtom at: 3.
  53946.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  53947.     resultCollection add: (Array with: operand with: result).
  53948.     "self store: result in: operand"! !
  53949.  
  53950. !SimulateWindow methodsFor: 'evaluating options'!
  53951. processFunctionAtomOld: anAtom 
  53952.     "store the calculated result in the respective variable."
  53953.  
  53954.     | operand result |
  53955.     operand := anAtom at: 1.
  53956.     result := self
  53957.                 evaluateOperand: anAtom
  53958.                 from: 3
  53959.                 to: anAtom size.
  53960.     anAtom size > 3
  53961.         ifFalse: 
  53962.             [result := anAtom at: 3.
  53963.             (self find: result) notNil ifTrue: [result := self valueOf: result]].
  53964.     resultCollection add: (Array with: operand with: result).
  53965.     "self store: result in: operand"! !
  53966.  
  53967. !SimulateWindow methodsFor: 'evaluating options'!
  53968. processGuardAtom: anAtom 
  53969.     "Calculate the left side of expression, make note of 
  53970.     
  53971.     the comparator, calculate the right side of expression, 
  53972.     
  53973.     then finally evaluate the expression."
  53974.  
  53975.     | count comparator double left right comparator1 comparator2 |
  53976.     count := 1.
  53977.     comparator := 0.
  53978.     double := 0.
  53979.     [count > anAtom size]
  53980.         whileFalse: 
  53981.             [(ParseTree isAComparator: (anAtom at: count))
  53982.                 ifTrue: [comparator > 0
  53983.                         ifTrue: 
  53984.                             [double > 0 ifTrue: [^false].
  53985.                             (anAtom at: comparator)
  53986.                                 = '>' & ((anAtom at: count)
  53987.                                     = '=') | ((anAtom at: comparator)
  53988.                                     = '=' & ((anAtom at: count)
  53989.                                         = '<')) ifFalse: [^false].
  53990.                             double := count]
  53991.                         ifFalse: [comparator := count]].
  53992.             count := count + 1].
  53993.     comparator < 2 | (comparator = anAtom size) ifTrue: [^false].
  53994.     double = 0 ifTrue: [double := comparator].
  53995.     left := self
  53996.                 evaluateOperand: anAtom
  53997.                 from: 1
  53998.                 to: comparator - 1.
  53999.     right := self
  54000.                 evaluateOperand: anAtom
  54001.                 from: double + 1
  54002.                 to: anAtom size.
  54003.     comparator1 := anAtom at: comparator.
  54004.     double = comparator
  54005.         ifTrue: [comparator2 := nil]
  54006.         ifFalse: [comparator2 := anAtom at: double].
  54007.     comparator1 = '>' & (comparator2 = '=') ifTrue: [^self is: left greaterOrEqualTo: right].
  54008.     comparator1 = '=' & (comparator2 = '<') ifTrue: [^self is: left lessOrEqualTo: right].
  54009.     comparator2 isNil
  54010.         ifTrue: 
  54011.             [comparator1 = '#' ifTrue: [^self is: left notEqualTo: right].
  54012.             comparator1 = '=' ifTrue: [^self is: left equalTo: right].
  54013.             comparator1 = '>' ifTrue: [^self is: left greaterThan: right].
  54014.             comparator1 = '<' ifTrue: [^self is: left lessThan: right]]! !
  54015.  
  54016. !SimulateWindow methodsFor: 'evaluating options'!
  54017. remainderOf: variable1 and: variable2 
  54018.     | value1 value2 value1asNumber value2asNumber result |
  54019.     value1 := self valueOf: variable1.
  54020.     value2 := self valueOf: variable2.
  54021.     value1 = '-infinity' | (value1 = 'infinity') ifTrue: [^value1].
  54022.     value2 = '-infinity' | (value2 = 'infinity') ifTrue: [^'0'].
  54023.     value1asNumber := TTMList convertToNumber: value1.
  54024.     value2asNumber := TTMList convertToNumber: value2.
  54025.     result := TTMList convertToString: value1asNumber \\ value2asNumber.
  54026.     ^result! !
  54027.  
  54028. !SimulateWindow methodsFor: 'evaluating options'!
  54029. subtract: variable1 from: variable2 
  54030.     | value1 value2 value1asNumber value2asNumber result |
  54031.     value1 := self valueOf: variable1.
  54032.     value2 := self valueOf: variable2.
  54033.     value2 = 'infinity' | (value2 = '-infinity')
  54034.         ifTrue: [^value2]
  54035.         ifFalse: [value1 = 'infinity'
  54036.                 ifTrue: [^0]
  54037.                 ifFalse: 
  54038.                     [value1 = '-infinity'
  54039.                         ifTrue: [value1asNumber := 0]
  54040.                         ifFalse: [value1asNumber := TTMList convertToNumber: value1].
  54041.                     value2asNumber := TTMList convertToNumber: value2.
  54042.                     result := TTMList convertToString: value2asNumber - value1asNumber.
  54043.                     ^result]]! !
  54044.  
  54045. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  54046. evaluateTFunction: aString 
  54047.     | rhs parser |
  54048.     "aString inspect."
  54049.     rhs := self getRHS: aString.
  54050.     rhs isNil ifTrue: [^'nil'].
  54051.     parser := BuildAEParser new.
  54052.     resultCollection := OrderedCollection new.
  54053.     rhs do: [:ex | resultCollection add: (Array with: (ex at: 1)
  54054.                 with: (BuildTFExpr valueWithAST: (parser parseForAST: (ex at: 2)
  54055.                             ifFail: [^nil] )
  54056.                         withSw: self))].
  54057.     resultCollection do: [:x | self store: (x at: 2) 
  54058.             in: (x at: 1)]! !
  54059.  
  54060. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  54061. evaluateTGuard: aString 
  54062.     | parser result ok |
  54063.     ok := true.
  54064.     parser := BuildBoolParser new.
  54065.     result := BuildTFExpr valueWithAST: (parser parseForAST: aString ifFail: [ok := false])
  54066.                 withSw: self.
  54067.     ok = true ifTrue: [^result]! !
  54068.  
  54069. !SimulateWindow methodsFor: 'T-Gen evaluation'!
  54070. getRHS: aTransformationFunction 
  54071.     | res str ind comma colon |
  54072.     ind := 1.
  54073.     res := OrderedCollection new.
  54074.     str := aTransformationFunction.
  54075.     (str occurrencesOf: $:)
  54076.         timesRepeat: 
  54077.             [comma := str
  54078.                         nextIndexOf: $,
  54079.                         from: ind
  54080.                         to: str size.
  54081.             comma isNil ifTrue: [comma := str size + 1].
  54082.             colon := str
  54083.                         nextIndexOf: $:
  54084.                         from: ind
  54085.                         to: str size.
  54086.             res add: (Array with: (str copyFrom: ind to: colon - 1)
  54087.                     with: (str copyFrom: colon + 1 to: comma - 1)).
  54088.             ind := comma + 1].
  54089.     ^res! !
  54090.  
  54091. !SimulateWindow methodsFor: 'variable access'!
  54092. addDisplayedVariable: aString
  54093.  
  54094.      displayedVariables addLast: aString! !
  54095.  
  54096. !SimulateWindow methodsFor: 'variable access'!
  54097. container: aC 
  54098.  
  54099.      container := aC! !
  54100.  
  54101. !SimulateWindow methodsFor: 'variable access'!
  54102. currentTTM
  54103.  
  54104.      ^currentTTM! !
  54105.  
  54106. !SimulateWindow methodsFor: 'variable access'!
  54107. displayedVariables
  54108.  
  54109.      ^displayedVariables! !
  54110.  
  54111. !SimulateWindow methodsFor: 'variable access'!
  54112. displayedVariables: aCollection 
  54113.  
  54114.      displayedVariables := aCollection! !
  54115.  
  54116. !SimulateWindow methodsFor: 'variable access'!
  54117. filterWindowOpen
  54118.  
  54119.      ^filterWindowOpen! !
  54120.  
  54121. !SimulateWindow methodsFor: 'variable access'!
  54122. filterWindowOpen: aBoolean 
  54123.  
  54124.      filterWindowOpen := aBoolean! !
  54125.  
  54126. !SimulateWindow methodsFor: 'variable access'!
  54127. find: aVariableName 
  54128.     "Return the variable."
  54129.  
  54130.     | found count existingV |
  54131.     found := nil.
  54132.     count := 1.
  54133.     ttmVariables size
  54134.         timesRepeat: 
  54135.             [existingV := ttmVariables at: count.
  54136.             (existingV at: 1)
  54137.                 = aVariableName
  54138.                 ifTrue: [found := existingV]
  54139.                 ifFalse: [].
  54140.             count := count + 1].
  54141.     ^found! !
  54142.  
  54143. !SimulateWindow methodsFor: 'variable access'!
  54144. findScrollWrapper
  54145.     |   |
  54146.     ^((tableInterface dependents) at: 1) component container
  54147. "do: [:x | x class = #BorderedWrapper & (x component class = #ScrollWrapper) ifTrue: [x component component class = #GeneralSelectionTableView ifTrue: [^x component component]]]"! !
  54148.  
  54149. !SimulateWindow methodsFor: 'variable access'!
  54150. findView
  54151.     |   |
  54152.     ^(((tableInterface dependents) at: 1) components) at: 1 "do: [:x | x class = #BorderedWrapper & (x component class = #ScrollWrapper) ifTrue: [x component component class = #GeneralSelectionTableView ifTrue: [^x component component]]]"! !
  54153.  
  54154. !SimulateWindow methodsFor: 'variable access'!
  54155. initialCondition: aCondition 
  54156.     initialCondition := aCondition! !
  54157.  
  54158. !SimulateWindow methodsFor: 'variable access'!
  54159. setTabs: numberOfDisplayedVariables forVariableLength: vl 
  54160.     tabs := OrderedCollection new.
  54161.     tabs add: 1.
  54162.     2 to: numberOfDisplayedVariables + 2 do: [:x | tabs add: (tabs at: x - 1)
  54163.                 + vl]! !
  54164.  
  54165. !SimulateWindow methodsFor: 'variable access'!
  54166. simulateTable: x 
  54167.     simulateTable := x! !
  54168.  
  54169. !SimulateWindow methodsFor: 'variable access'!
  54170. store: aValue in: aVariable 
  54171.     | trueVariable |
  54172.     trueVariable := self find: aVariable.
  54173.     trueVariable isNil ifFalse: [trueVariable at: 2 put: aValue]! !
  54174.  
  54175. !SimulateWindow methodsFor: 'variable access'!
  54176. valueOf: aVariable 
  54177.     "Return the current value of the variable. 
  54178.     
  54179.     If it is not a variable, return itself (presumeably 
  54180.     
  54181.     a number)."
  54182.  
  54183.     | trueVariable |
  54184.     (aVariable isMemberOf: SmallInteger)
  54185.         ifTrue: [^aVariable]
  54186.         ifFalse: 
  54187.             [trueVariable := self find: aVariable.
  54188.             trueVariable isNil ifFalse: [^trueVariable at: 2]
  54189.                 ifTrue: [^aVariable]]! !
  54190.  
  54191. !SimulateWindow methodsFor: 'variable access'!
  54192. variableLabels: this 
  54193.     variableLabels := this! !
  54194.  
  54195. !SimulateWindow methodsFor: 'variable access'!
  54196. windowGC: aGC 
  54197.     windowGC := aGC! !
  54198.  
  54199. !SimulateWindow methodsFor: 'clock access'!
  54200. accessTimeFor: aTransition to: doAction 
  54201.     "This method gives access to the elapsed times 
  54202.     
  54203.     of the transitions in the TTM. The valid actions 
  54204.     
  54205.     are 1) #initialize all times, 2) #increment the 
  54206.     
  54207.     time of aTransition, 3) #reset the time of 
  54208.     
  54209.     aTransition to 0, and 4) #return the time of 
  54210.     
  54211.     aTransition."
  54212.  
  54213.     | count currentEntry timeElapsed found |
  54214.     doAction = #initialize
  54215.         ifTrue: 
  54216.             [count := 1.
  54217.             [count > transitionTimes size]
  54218.                 whileFalse: 
  54219.                     [currentEntry := transitionTimes at: count.
  54220.                     timeElapsed := 0.
  54221.                     currentEntry at: 2 put: timeElapsed.
  54222.                     count := count + 1]]
  54223.         ifFalse: 
  54224.             [count := 1.
  54225.             found := false.
  54226.             [count > transitionTimes size | (found = true)]
  54227.                 whileFalse: 
  54228.                     [currentEntry := transitionTimes at: count.
  54229.                     found := aTransition = (currentEntry at: 1).
  54230.                     found ifFalse: [count := count + 1]].
  54231.             found
  54232.                 ifTrue: 
  54233.                     [timeElapsed := currentEntry at: 2.
  54234.                     doAction = #increment
  54235.                         ifTrue: 
  54236.                             [timeElapsed := timeElapsed + 1.
  54237.                             currentEntry at: 2 put: timeElapsed].
  54238.                     doAction = #reset ifTrue: [currentEntry at: 2 put: 0].
  54239.                     doAction = #return ifTrue: [^timeElapsed]]]! !
  54240.  
  54241. !SimulateWindow methodsFor: 'clock access'!
  54242. clockList
  54243.      ^clockList := currentTime  asValue! !
  54244.  
  54245. !SimulateWindow methodsFor: 'clock access'!
  54246. clockListNew
  54247.      ^clockList := currentTime  asValue! !
  54248.  
  54249. !SimulateWindow methodsFor: 'clock access'!
  54250. clockListOld
  54251.     | tempList |
  54252.     tempList := OrderedCollection new.
  54253.     tempList add: currentTime.
  54254.     ^tempList collect: [:aTime | aTime printString]! !
  54255.  
  54256. !SimulateWindow methodsFor: 'clock access'!
  54257. clockOffset
  54258.     | newTime |
  54259.     newTime := DialogView request: 'Set clock to how many ticks?' initialAnswer: currentTime printString.
  54260.     newTime isEmpty
  54261.         ifTrue: [^self]
  54262.         ifFalse: 
  54263.             [currentTime := TTMList convertToNumber: newTime.
  54264.             self changed: #clockTransaction]! !
  54265.  
  54266. !SimulateWindow methodsFor: 'clock access'!
  54267. clockReset
  54268.     currentTime := 0.
  54269.     clockList value: currentTime.
  54270.     self changed: #clockTransaction! !
  54271.  
  54272. !SimulateWindow methodsFor: 'clock access'!
  54273. tick: completeList
  54274.     "The completeList of sorted transitions is output 
  54275.     
  54276.     from the sortTransition method."
  54277.  
  54278.     | pending enabled mustOccur count |
  54279.     pending := completeList at: 1.
  54280.     enabled := completeList at: 2.
  54281.     mustOccur := completeList at: 3.
  54282.     mustOccur size = 0
  54283.         ifTrue: 
  54284.             [currentTime := currentTime + 1.
  54285.             clockList value: currentTime.
  54286.             self changed: #clockTransaction.
  54287.             count := 1.
  54288.             [count > pending size]
  54289.                 whileFalse: 
  54290.                     [self accessTimeFor: (pending at: count)
  54291.                         to: #increment.
  54292.                     count := count + 1].
  54293.             count := 1.
  54294.             [count > enabled size]
  54295.                 whileFalse: 
  54296.                     [self accessTimeFor: (enabled at: count)
  54297.                         to: #increment.
  54298.                     count := count + 1].
  54299.             self addTransition: 'tick'.
  54300.             self addLatestValues]
  54301.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  54302.  
  54303. !SimulateWindow methodsFor: 'clock access'!
  54304. tickNew: completeList
  54305.     "The completeList of sorted transitions is output 
  54306.     
  54307.     from the sortTransition method."
  54308.  
  54309.     | pending enabled mustOccur count |
  54310.     pending := completeList at: 1.
  54311.     enabled := completeList at: 2.
  54312.     mustOccur := completeList at: 3.
  54313.     mustOccur size = 0
  54314.         ifTrue: 
  54315.             [currentTime := currentTime + 1.
  54316.             clockList value: currentTime.
  54317.             self changed: #clockTransaction.
  54318.             count := 1.
  54319.             [count > pending size]
  54320.                 whileFalse: 
  54321.                     [self accessTimeFor: (pending at: count)
  54322.                         to: #increment.
  54323.                     count := count + 1].
  54324.             count := 1.
  54325.             [count > enabled size]
  54326.                 whileFalse: 
  54327.                     [self accessTimeFor: (enabled at: count)
  54328.                         to: #increment.
  54329.                     count := count + 1].
  54330.             self addTransition: 'tick'.
  54331.             self addLatestValues]
  54332.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  54333.  
  54334. !SimulateWindow methodsFor: 'clock access'!
  54335. tickOld: completeList 
  54336.     "The completeList of sorted transitions is output 
  54337.     
  54338.     from the sortTransition method."
  54339.  
  54340.     | pending enabled mustOccur count |
  54341.     pending := completeList at: 1.
  54342.     enabled := completeList at: 2.
  54343.     mustOccur := completeList at: 3.
  54344.     mustOccur size = 0
  54345.         ifTrue: 
  54346.             [currentTime := currentTime + 1.
  54347.             self changed: #clockTransaction.
  54348.             count := 1.
  54349.             [count > pending size]
  54350.                 whileFalse: 
  54351.                     [self accessTimeFor: (pending at: count)
  54352.                         to: #increment.
  54353.                     count := count + 1].
  54354.             count := 1.
  54355.             [count > enabled size]
  54356.                 whileFalse: 
  54357.                     [self accessTimeFor: (enabled at: count)
  54358.                         to: #increment.
  54359.                     count := count + 1].
  54360.             self addTransition: 'tick'.
  54361.             self addLatestValues]
  54362.         ifFalse: [TTMList speak: 'a tick cannot occur.']! !
  54363.  
  54364. !SimulateWindow methodsFor: 'file out'!
  54365. doFileOut
  54366.     | aStream ans1 ans2 ans3 myTable |
  54367.     aStream := self openFileForWrite.
  54368.     aStream isNil ifTrue: [^nil].
  54369.     currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  54370.     ans1 := DialogView confirm: 'Include notepad?'.
  54371.     ans1 = true ifTrue: [currentTTM fileNotePadOn: aStream].
  54372.     ans2 := DialogView confirm: 'Include Starting and Stopping Conditions?'.
  54373.     ans2 = true
  54374.         ifTrue: 
  54375.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  54376.             currentTTM fileThis: self icList on: aStream.
  54377.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  54378.             myTable := OrderedCollection new.
  54379.             myTable add: '  ' , finalCondition.
  54380.             currentTTM fileThis: myTable on: aStream].
  54381.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  54382.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  54383.                 with: '%'
  54384.                 with: '%'
  54385.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  54386.             on: aStream].
  54387.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  54388.     currentTTM fileThis: (self makeCollectionOfStringsWithFieldWidth: 12)
  54389.         on: aStream.
  54390.     aStream close! !
  54391.  
  54392. !SimulateWindow methodsFor: 'file out'!
  54393. doFileOutNew
  54394.     | aStream ans1 ans2 ans3 myTable   |
  54395.     aStream := self openFileForWrite.
  54396.     ans1 := DialogView confirm: 'Include title and notepad?'.
  54397.     ans1 = true
  54398.         ifTrue: 
  54399.             [currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  54400.             currentTTM fileNotePadOn: aStream].
  54401.     ans2 := DialogView confirm: 'Include Starting and Stopping
  54402.  
  54403. Conditions?'.
  54404.     ans2 = true
  54405.         ifTrue: 
  54406.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  54407.             currentTTM fileThis: self icList on: aStream.
  54408.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  54409.             myTable := OrderedCollection new.
  54410.             myTable add: '  ' , finalCondition.
  54411.             currentTTM fileThis: myTable on: aStream].
  54412.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  54413.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  54414.                 with: '%'
  54415.                 with: '%'
  54416.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  54417.             on: aStream].
  54418.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  54419.     
  54420.     
  54421.     currentTTM fileThis: (self  makeCollectionOfStringsWithFieldWidth: 15)  on: aStream.
  54422.     
  54423.     aStream close! !
  54424.  
  54425. !SimulateWindow methodsFor: 'file out'!
  54426. doFileOutOld
  54427.     | aStream ans1 ans2 ans3 myTable varCount actuallyDisplayedVariables |
  54428.     aStream := self openFileForWrite.
  54429.     ans1 := DialogView confirm: 'Include title and notepad?'.
  54430.     ans1 = true
  54431.         ifTrue: 
  54432.             [currentTTM fileTitle: 'Simulated Run of TTM: ' , currentTTM named on: aStream.
  54433.             currentTTM fileNotePadOn: aStream].
  54434.     ans2 := DialogView confirm: 'Include Starting and Stopping
  54435.  
  54436. Conditions?'.
  54437.     ans2 = true
  54438.         ifTrue: 
  54439.             [currentTTM fileHeading: 'Starting Condition:' on: aStream.
  54440.             currentTTM fileThis: self icList on: aStream.
  54441.             currentTTM fileHeading: 'Stopping Condition:' on: aStream.
  54442.             myTable := OrderedCollection new.
  54443.             myTable add: '  ' , finalCondition.
  54444.             currentTTM fileThis: myTable on: aStream].
  54445.     ans3 := DialogView confirm: 'Include Elapsed Ticks?'.
  54446.     ans3 = true ifTrue: [currentTTM fileThis: (OrderedCollection
  54447.                 with: '%'
  54448.                 with: '%'
  54449.                 with: '%  Elapsed Ticks = ' , currentTime printString)
  54450.             on: aStream].
  54451.     ans2 = true | (ans3 = true) ifTrue: [currentTTM fileHeading: 'Simulated Run:' on: aStream].
  54452.     self clearEntry.
  54453.     currentTTM currentlyDisplayedSimulateVariables notNil
  54454.         ifTrue: [actuallyDisplayedVariables := currentTTM currentlyDisplayedSimulateVariables collect: [:x | x at: 1]]
  54455.         ifFalse: [actuallyDisplayedVariables := ttmVariables collect: [:x | x at: 1]].
  54456.     varCount := 1.
  54457.     [
  54458.         "ttmVariables"varCount > (actuallyDisplayedVariables size + 1)]
  54459.         whileFalse: 
  54460.             [self atTab: varCount put: '------'.
  54461.             varCount := varCount + 1].
  54462.     table addFirst: tableEntry.
  54463.     self clearEntry.
  54464.     varCount := 1.
  54465.     self atTab: varCount put: 't'.
  54466.     [
  54467.         "ttmVariables"varCount > actuallyDisplayedVariables size]
  54468.         whileFalse: 
  54469.             [
  54470.                 "ttmVariables"self atTab: varCount + 1 put: (actuallyDisplayedVariables at: varCount).
  54471.             varCount := varCount + 1].
  54472.     table addFirst: tableEntry.
  54473.     currentTTM fileThis: table on: aStream.
  54474.     table removeFirst.
  54475.     table removeFirst.
  54476.     aStream close! !
  54477.  
  54478. !SimulateWindow methodsFor: 'file out'!
  54479. forString: aString copyUpToWithPad: anInteger 
  54480.     | temp |
  54481.     temp := aString copyUpTo: anInteger.
  54482.     anInteger - temp size timesRepeat: [temp := temp , ' '].
  54483.     ^temp! !
  54484.  
  54485. !SimulateWindow methodsFor: 'file out'!
  54486. makeCollectionOfStringsWithFieldWidth: anInteger 
  54487.     | temp count result varCount actuallyDisplayedVariables temp2 y |
  54488.     result := OrderedCollection new.
  54489.     currentTTM currentlyDisplayedSimulateVariables notNil
  54490.         ifTrue: [actuallyDisplayedVariables := currentTTM currentlyDisplayedSimulateVariables collect: [:x | x at: 1]]
  54491.         ifFalse: [actuallyDisplayedVariables := ttmVariables collect: [:x | x at: 1]].
  54492.     varCount := 1.
  54493.     temp := self forString: 'ticks' copyUpToWithPad: anInteger.
  54494.     temp2 := self forString: '----- ' copyUpToWithPad: anInteger.
  54495.     [varCount > actuallyDisplayedVariables size]
  54496.         whileFalse: 
  54497.             [temp := temp , (self forString: (actuallyDisplayedVariables at: varCount)
  54498.                             copyUpToWithPad: anInteger).
  54499.             temp2 := temp2 , (self forString: '----- ' copyUpToWithPad: anInteger).
  54500.             varCount := varCount + 1].
  54501.     result add: temp; add: temp2.
  54502.     temp := ''.
  54503.     count := 1.
  54504.     trajectoryTable tableHolder value
  54505.         do: 
  54506.             [:x | 
  54507.             x isInteger
  54508.                 ifTrue: [y := x printString]
  54509.                 ifFalse: [y := x].
  54510.             temp := temp , (self forString: y copyUpToWithPad: anInteger).
  54511.             count := count + 1.
  54512.             count > ncols
  54513.                 ifTrue: 
  54514.                     [count := 1.
  54515.                     result add: temp.
  54516.                     temp := '']].
  54517.     ^result! !
  54518.  
  54519. !SimulateWindow methodsFor: 'file out'!
  54520. openFileForWrite
  54521.     "Returns the stream in append mode or 
  54522.     
  54523.     returns nil if file could not be opened."
  54524.  
  54525.     | defaultName fileName aStream fullPath |
  54526.     defaultName := currentTTM named asString , '.run'.
  54527.     fileName := DialogView request: 'file name to write out as?' initialAnswer: defaultName.
  54528.     fileName isEmpty
  54529.         ifTrue: 
  54530.             [TTMList speak: 'No filename given - generation aborted.'.
  54531.             aStream := nil]
  54532.         ifFalse: 
  54533.             [fullPath := (Filename named: currentTTM getDirectory)
  54534.                         constructString: fileName.
  54535.             aStream := (Filename named: fullPath) appendStream].
  54536.     ^aStream! !
  54537.  
  54538. !SimulateWindow methodsFor: 'closing'!
  54539. closeMe
  54540.     currentTTM openWindows at: 4 put: 0.
  54541.     filterWindowOpen = True ifTrue: [self closeFilter].
  54542.     self closeRequest! !
  54543.  
  54544. !SimulateWindow methodsFor: 'closing'!
  54545. removeDependent: aDependent 
  54546.     aDependent class name = #ApplicationWindow ifTrue: [currentTTM openWindows at: 4 put: 0].
  54547.     filterWindowOpen = True ifTrue: [self closeFilter].
  54548.     super removeDependent: aDependent! !
  54549.  
  54550. !SimulateWindow methodsFor: 'new reset'!
  54551. reset
  54552.     | list labels t1 |
  54553.     trajectoryList := OrderedCollection new.
  54554.     aLine := OrderedCollection new.    
  54555.     list := TwoDList
  54556.                 on: trajectoryList
  54557.                 columns: 0
  54558.                 rows: 0.
  54559.     trajectoryTable table: list.
  54560.     total := 0.
  54561.     labels := OrderedCollection new.
  54562.     labels add: 'ticks'.
  54563.     t1 := initialCondition size.
  54564.     currentTTM currentlyDisplayedSimulateVariables notNil
  54565.         ifTrue: 
  54566.             [t1 := currentTTM currentlyDisplayedSimulateVariables size.
  54567.             currentTTM currentlyDisplayedSimulateVariables do: [:x | labels addLast: (x at: 1)]]
  54568.         ifFalse: [initialCondition do: [:x | labels addLast: (x at: 1)]].
  54569.     
  54570.     tableInterface columnLabelsArray: labels asArray; columnLabelsFormats: #left.
  54571.     ncols := t1 + 1.
  54572.     self initializeTable! !
  54573.  
  54574. !SimulateWindow methodsFor: 'new variable access'!
  54575. ncols
  54576.     ^ncols! !
  54577.  
  54578. !SimulateWindow methodsFor: 'new variable access'!
  54579. ncols: anInteger
  54580.     ncols := anInteger! !
  54581.  
  54582. !SimulateWindow methodsFor: 'new variable access'!
  54583. nrows
  54584.     ^nrows! !
  54585.  
  54586. !SimulateWindow methodsFor: 'new variable access'!
  54587. simulateTable
  54588.     ^self! !
  54589.  
  54590. !SimulateWindow methodsFor: 'new variable access'!
  54591. tableInterface
  54592.     ^tableInterface! !
  54593.  
  54594. !SimulateWindow methodsFor: 'new variable access'!
  54595. trajectoryList
  54596.     ^trajectoryList! !
  54597.  
  54598. !SimulateWindow methodsFor: 'new variable access'!
  54599. trajectoryTable
  54600.     ^trajectoryTable! !
  54601.  
  54602. !SimulateWindow methodsFor: 'adding'!
  54603. addStringToLine: aString 
  54604.     aLine add: aString.
  54605.       total := total + 1.! !
  54606.  
  54607. !SimulateWindow methodsFor: 'adding'!
  54608. putLine
  54609.     | list lineNumber |
  54610.     lineNumber := 0.
  54611.     aLine addAll: trajectoryList.
  54612.     trajectoryList := aLine.
  54613.     list := TwoDList
  54614.                 on: trajectoryList
  54615.                 columns: ncols
  54616.                 rows: total / ncols.
  54617.     trajectoryTable table: list.
  54618.     advanceCount = 0 | advanceCount = 1
  54619.         ifTrue: [lineNumber := 3]
  54620.         ifFalse: [advanceCount notNil ifTrue: [lineNumber := 2 * advanceCount + 1]].
  54621.     trajectoryTable selectionIndex: 0 @ lineNumber.
  54622.     aLine := OrderedCollection new! !
  54623.  
  54624. !SimulateWindow methodsFor: 'aspects'!
  54625. advanceTransitionNumberAspect
  54626.     "This method was generated by UIDefiner. The initialization provided 
  54627.     below may have been preempted by an initialize method."
  54628.  
  54629.     ^advanceTransitionNumberAspect isNil ifTrue: [advanceTransitionNumberAspect := 0 asValue] ifFalse: [advanceTransitionNumberAspect]! !
  54630.  
  54631. !SimulateWindow methodsFor: 'aspects'!
  54632. fcList
  54633.     "This method was generated by UIDefiner. The initialization provided 
  54634.     below may have been preempted by an initialize method."
  54635.  
  54636.     ^fcList isNil ifTrue: [fcList := String new asValue] ifFalse: [fcList]! !
  54637.  
  54638. !SimulateWindow methodsFor: 'aspects'!
  54639. icList
  54640.     "This method was generated by UIDefiner. The initialization provided 
  54641.     below may have been preempted by an initialize method."
  54642.  
  54643.     ^icList isNil ifTrue: [icList := SelectionInList new] ifFalse: [icList]! !
  54644.  
  54645. !SimulateWindow methodsFor: 'aspects'!
  54646. tlOutAspect
  54647.     "This method was generated by UIDefiner. The initialization provided 
  54648.     below may have been preempted by an initialize method."
  54649.  
  54650.     ^tlOutAspect isNil ifTrue: [tlOutAspect := 'NONE' asValue] ifFalse: [tlOutAspect]! !
  54651.  
  54652. !SimulateWindow methodsFor: 'actions'!
  54653. doTlMenu
  54654.     ""
  54655.  
  54656.     | n |
  54657.     n := (PopUpMenu labelArray: transitionList) startUp.
  54658.     n > 0
  54659.         ifTrue: 
  54660.             [n = 1
  54661.                 ifTrue: 
  54662.                     [doAdvance := false.
  54663.                     doAdvanceTransition := false.
  54664.                     doAdvanceNoTick := false].
  54665.             n = 2
  54666.                 ifTrue: 
  54667.                     [doAdvance := true.
  54668.                     doAdvanceTransition := false.
  54669.                     doAdvanceNoTick := false].
  54670.             n = 3
  54671.                 ifTrue: 
  54672.                     [doAdvance := false.
  54673.                     doAdvanceTransition := false.
  54674.                     doAdvanceNoTick := true].
  54675.             n > 3
  54676.                 ifTrue: 
  54677.                     [doAdvance := false.
  54678.                     doAdvanceTransition := true.
  54679.                     advanceTransition := transitionList at: n].
  54680.             tlOutAspect value: (transitionList at: n)]! !
  54681.  
  54682. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  54683.  
  54684. SimulateWindow class
  54685.     instanceVariableNames: ''!
  54686.  
  54687. !SimulateWindow class methodsFor: 'instance creation'!
  54688. newTable: ttm 
  54689.     ^super new initializeTTM: ttm! !
  54690.  
  54691. !SimulateWindow class methodsFor: 'instance creation'!
  54692. open: currentTTM 
  54693.     self open: (self newTable: currentTTM)
  54694.         with: currentTTM! !
  54695.  
  54696. !SimulateWindow class methodsFor: 'instance creation'!
  54697. open: aSimulateModel with: currentTTM 
  54698.     | title |
  54699.     title := 'Simulating TTM: ' , currentTTM named asText.
  54700.     currentTTM simulateWindow: aSimulateModel.
  54701.     aSimulateModel displayedVariables: OrderedCollection new.
  54702.     aSimulateModel open.
  54703.     aSimulateModel builder window label: title! !
  54704.  
  54705. !SimulateWindow class methodsFor: 'instance creation'!
  54706. openNew: aSimulateModel with: currentTTM 
  54707.     | title |
  54708.     title := 'Simulating TTM: ' , currentTTM named asText.
  54709.     currentTTM simulateWindow: aSimulateModel.
  54710.     aSimulateModel displayedVariables: OrderedCollection new.
  54711.     aSimulateModel open! !
  54712.  
  54713. !SimulateWindow class methodsFor: 'instance creation'!
  54714. openOld: aSimulateModel with: currentTTM 
  54715.     | window container up vsize left hsize startButton stepButton hButton tableView initialView finalView title clockView reButton offButton columns totalPixels textLabels count existingV variableLabels clearButton myWrapper trButton fiButton qButton filterButton ed |
  54716.     window := ScheduledWindow new.
  54717.     title := 'Simulating TTM: ' , currentTTM named asText.
  54718.     window label: title.
  54719.     window model: aSimulateModel.
  54720.     window insideColor: ColorValue white.
  54721.     container := CompositePart new.
  54722.     (container add: '  ' asComposedText borderedIn: (0 @ 0 extent: 1.0 @ 1.0))
  54723.         insideColor: ColorValue white.
  54724.     columns := currentTTM activityvariable size + 1 + currentTTM datavariable size * 7.
  54725.     totalPixels := (7.5 * columns) ceiling.
  54726.     totalPixels < 550 ifTrue: [totalPixels := 550].
  54727.     window minimumSize: totalPixels @ 450.
  54728.     currentTTM simulateWindow: aSimulateModel.
  54729.     textLabels := ' t:     '.
  54730.     count := 1.
  54731.     [count > currentTTM activityvariable size]
  54732.         whileFalse: 
  54733.             [existingV := ((currentTTM activityvariable at: count)
  54734.                         at: 1)
  54735.                         , ':       '.
  54736.             existingV := existingV copyFrom: 1 to: 7.
  54737.             textLabels := textLabels , existingV.
  54738.             count := count + 1].
  54739.     count := 1.
  54740.     [count > currentTTM datavariable size]
  54741.         whileFalse: 
  54742.             [existingV := ((currentTTM datavariable at: count)
  54743.                         at: 1)
  54744.                         , ':       '.
  54745.             existingV := existingV copyFrom: 1 to: 7.
  54746.             textLabels := textLabels , existingV.
  54747.             count := count + 1].
  54748.     variableLabels := ComposedText withText: textLabels style: (TextAttributes styleNamed: #fixed).
  54749.     aSimulateModel variableLabels: variableLabels.
  54750.     self labelWrap: (container add: variableLabels borderedIn: (0.0 @ 0.0 extent: 1.0 @ 0.05)).
  54751.     vsize := 0.05.
  54752.     hsize := 0.15.
  54753.     tableView := AlteredTableView
  54754.                 on: aSimulateModel
  54755.                 aspect: #tableTransaction
  54756.                 list: #tableList.
  54757.      " tableView hasHorizontalScrollBar: true."
  54758.     ed := LookPreferences edgeDecorator on: tableView.    "ed useHorizontalScrollBar."
  54759.     myWrapper := self wrap: ed.
  54760.     container add: myWrapper borderedIn: (0.0 @ 0.05 extent: 1.0 @ 0.65).    "new initial condition view"
  54761.     initialView := SelectionInListView
  54762.                 on: aSimulateModel
  54763.                 printItems: false
  54764.                 oneItem: false
  54765.                 aspect: #icTransaction
  54766.                 change: #icSelection:
  54767.                 list: #icList
  54768.                 menu: #icMenu
  54769.                 initialSelection: nil
  54770.                 useIndex: true.
  54771.     myWrapper := self wrap: (LookPreferences edgeDecorator on: initialView).
  54772.     container add: myWrapper borderedIn: (0.0 @ 0.75 extent: 0.4 @ 0.2).
  54773.     self labelWrap: (container add: 'Starting Condition:' asText allBold asComposedText borderedIn: (0.0 @ 0.7 extent: 0.4 @ 0.05)).    "new stopping condition"
  54774.     finalView := TextView
  54775.                 on: aSimulateModel
  54776.                 aspect: #fcList
  54777.                 change: #fcAccept:
  54778.                 menu: #fcMenu
  54779.                 initialSelection: nil.
  54780.     myWrapper := self wrap: (LookPreferences edgeDecorator on: finalView).
  54781.     container add: myWrapper borderedIn: (0.4 @ 0.75 extent: 0.4 @ 0.2).
  54782.     self labelWrap: (container add: 'Stopping Condition:' asText allBold asComposedText borderedIn: (0.4 @ 0.7 extent: 0.4 @ 0.05)).
  54783.     clockView := AlteredTableView
  54784.                 on: aSimulateModel
  54785.                 aspect: #clockTransaction
  54786.                 list: #clockList.
  54787.     self labelWrap: (container add: clockView borderedIn: (0.8 @ 0.75 extent: 0.2 @ 0.1)).
  54788.     self labelWrap: (container add: 'Elapsed Ticks:' asText allBold asComposedText borderedIn: (0.8 @ 0.7 extent: 0.2 @ 0.05)).
  54789.     up := 0.85.
  54790.     left := 0.8.    "Button for reset of clock"
  54791.     reButton := PushButton named: 'Clock Reset'.
  54792.     reButton model: ((PluggableAdaptor on: aSimulateModel)
  54793.             getBlock: [:model | false]
  54794.             putBlock: [:model :value | model clockReset]
  54795.             updateBlock: [:model :value :parameter | false]).
  54796.     (container add: reButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + 0.2; bottomFraction: up + vsize))
  54797.         insideColor: ColorValue white.
  54798.     up := up + vsize.    "Button for clock offset"
  54799.     offButton := PushButton named: 'Clock Offset'.
  54800.     offButton model: ((PluggableAdaptor on: aSimulateModel)
  54801.             getBlock: [:model | false]
  54802.             putBlock: [:model :value | model clockOffset]
  54803.             updateBlock: [:model :value :parameter | false]).
  54804.     (container add: offButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + 0.2; bottomFraction: up + vsize))
  54805.         insideColor: ColorValue white.
  54806.     up := 0.95.
  54807.     vsize := 0.05.
  54808.     left := 0.
  54809.     hsize := 0.135.    "Button for starting or continuing 
  54810.     
  54811.     simulation"
  54812.     startButton := PushButton named: 'Start/Continue'.
  54813.     startButton model: ((PluggableAdaptor on: aSimulateModel)
  54814.             getBlock: [:model | false]
  54815.             putBlock: [:model :value | model doStart]
  54816.             updateBlock: [:model :value :parameter | false]).
  54817.     (container add: startButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize + 0.0595; bottomFraction: up + vsize))
  54818.         insideColor: ColorValue white.
  54819.     left := left + hsize + 0.0595.
  54820.     hsize := 0.116.    "Button for stepping through simulation 
  54821.     
  54822.     one transition at a time"
  54823.     stepButton := PushButton named: 'Step'.
  54824.     stepButton model: ((PluggableAdaptor on: aSimulateModel)
  54825.             getBlock: [:model | false]
  54826.             putBlock: [:model :value | model doStep]
  54827.             updateBlock: [:model :value :parameter | false]).
  54828.     (container add: stepButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54829.         insideColor: ColorValue white.
  54830.     left := left + hsize.    "Button for clearing table"
  54831.     clearButton := PushButton named: 'Clear'.
  54832.     clearButton model: ((PluggableAdaptor on: aSimulateModel)
  54833.             getBlock: [:model | false]
  54834.             putBlock: [:model :value | model doClear]
  54835.             updateBlock: [:model :value :parameter | false]).
  54836.     (container add: clearButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54837.         insideColor: ColorValue white.
  54838.     left := left + hsize.    "Button for transition states"
  54839.     trButton := PushButton named: 'Status'.
  54840.     trButton model: ((PluggableAdaptor on: aSimulateModel)
  54841.             getBlock: [:model | false]
  54842.             putBlock: [:model :value | model doStates]
  54843.             updateBlock: [:model :value :parameter | false]).
  54844.     (container add: trButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54845.         insideColor: ColorValue white.
  54846.     left := left + hsize.    "***********************"
  54847.     "Button filtering out variables"
  54848.     filterButton := PushButton named: 'Filter'.
  54849.     filterButton model: ((PluggableAdaptor on: aSimulateModel)
  54850.             getBlock: [:model | false]
  54851.             putBlock: [:model :value | model doFilter]
  54852.             updateBlock: [:model :value :parameter | false]).
  54853.     (container add: filterButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54854.         insideColor: ColorValue white.
  54855.     left := left + hsize.    "***********************"
  54856.     "Button for filing out"
  54857.     fiButton := PushButton named: 'File Out'.
  54858.     fiButton model: ((PluggableAdaptor on: aSimulateModel)
  54859.             getBlock: [:model | false]
  54860.             putBlock: [:model :value | model doFileOut]
  54861.             updateBlock: [:model :value :parameter | false]).
  54862.     (container add: fiButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54863.         insideColor: ColorValue white.
  54864.     left := left + hsize.    "Button for quitting"
  54865.     qButton := PushButton named: 'Exit'.
  54866.     qButton model: ((PluggableAdaptor on: aSimulateModel)
  54867.             getBlock: [:model | false]
  54868.             putBlock: [:model :value | TTMList closeWindow: 4 in: currentTTM]
  54869.             updateBlock: [:model :value :parameter | false]).
  54870.     (container add: qButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54871.         insideColor: ColorValue white.
  54872.     left := left + hsize.    "Button for help"
  54873.     hButton := PushButton named: 'Help' asText allBold.
  54874.     hButton model: ((PluggableAdaptor on: aSimulateModel)
  54875.             getBlock: [:model | false]
  54876.             putBlock: [:model :value | HelpScreens openHelp: 'simulating']
  54877.             updateBlock: [:model :value :parameter | false]).
  54878.     (container add: hButton borderedIn: ((LayoutFrame new) leftFraction: left; topFraction: up; rightFraction: left + hsize; bottomFraction: up + vsize))
  54879.         insideColor: ColorValue white.
  54880.     window component: container.
  54881.     aSimulateModel container: container.
  54882.     aSimulateModel windowGC: window graphicsContext.
  54883.     aSimulateModel displayedVariables: OrderedCollection new.
  54884.     currentTTM currentlyDisplayedSimulateVariables notNil
  54885.         ifTrue: 
  54886.             [currentTTM currentlyDisplayedSimulateVariables do: [:x | aSimulateModel displayedVariables addLast: (x at: 1)].
  54887.             aSimulateModel doAcceptFilter].
  54888.     window open! !
  54889.  
  54890. !SimulateWindow class methodsFor: 'decoration'!
  54891. labelWrap: aLabel 
  54892.  
  54893.      | newLabel |
  54894.  
  54895.      newLabel := aLabel.
  54896.  
  54897.      newLabel insideColor: ColorValue white.
  54898.  
  54899.      newLabel borderColor: ColorValue black.
  54900.  
  54901.      newLabel borderWidth: 1.
  54902.  
  54903.      ^newLabel! !
  54904.  
  54905. !SimulateWindow class methodsFor: 'decoration'!
  54906. wrap: aWrapper 
  54907.  
  54908.      | newWrapper |
  54909.  
  54910.      newWrapper := aWrapper.
  54911.  
  54912.      newWrapper noMenuBar.
  54913.  
  54914.      "newWrapper borderColor: ColorValue black."
  54915.  
  54916.      "newWrapper borderWidth: 1."
  54917.  
  54918.      "newWrapper insideColor: ColorValue white."
  54919.  
  54920.      ^newWrapper! !
  54921.  
  54922. !SimulateWindow class methodsFor: 'interface specs'!
  54923. windowSpec
  54924.     "UIPainter new openOnClass: self andSelector: #windowSpec"
  54925.  
  54926.     ^#(#FullSpec #window: #(#WindowSpec #label: 'Simulating TTM:' #min: #(#Point 481 450 ) #bounds: #(#Rectangle 330 286 843 736 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 9 0 0 0.682222 0 0.4 0 0.897778 ) #model: #icList #menu: #icMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.723197 0 0.942222 0 0.838207 0 0.995556 ) #model: #closeMe #label: 'Exit' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.163743 0 0.94 0 0.278752 0 1.0 ) #model: #doStep #label: 'Step' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.272374 0 0.944086 0 0.379377 0 0.995699 ) #model: #doClear #label: 'Clear' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.378168 0 0.944444 0 0.487329 0 0.995556 ) #model: #doStates #label: 'Status' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.489279 0 0.942222 0 0.590643 0 0.995556 ) #model: #doFilter #label: 'Filter' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.00779727 0 0.935556 0 0.163743 0 1.00222 ) #model: #doStart #label: 'Start/Cont.' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0932039 0 0.631111 ) #label: 'Starting Condition:' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.454369 0 0.631111 ) #label: 'Stopping Condition:' ) #(#TableViewSpec #layout: #(#LayoutFrame 0 0.00776699 0 0.0177778 0 0.986408 0 0.631111 ) #model: #tableInterface #tabable: false #style: #small #selectionStyle: #row ) #(#TextEditorSpec #layout: #(#LayoutFrame 0 0.417154 0 0.684444 0 0.762183 0 0.828889 ) #flags: 15 #model: #fcList #menu: #fcMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.854369 0 0.942222 0 0.961165 0 0.993333 ) #model: #doHelp #label: 'Help' #style: #large #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.772374 0 0.737634 0 0.963035 0 0.787097 ) #model: #clockReset #label: 'Clock Reset' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.774319 0 0.784946 0 0.96498 0 0.834409 ) #model: #clockOffset #label: 'Clock Offset' #defaultable: true ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.773879 0 0.688889 0 0.968811 0 0.735555 ) #model: #clockList #type: #number ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.601942 0 0.942222 0 0.712621 0 0.995556 ) #model: #doFileOut #label: 'FileOut' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.770874 0 0.635556 ) #label: 'Clock Value:' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.470817 0 0.834409 ) #label: 'Advance Transition' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.819066 0 0.836559 ) #label: 'Amount' ) #(#GroupBoxSpec #layout: #(#LayoutFrame 0 0.418288 0 0.83871 0 0.970817 0 0.937634 ) ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.805447 0 0.87957 0 0.928016 0 0.922581 ) #model: #advanceTransitionNumberAspect #type: #number ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.533074 0 0.877419 0 0.77821 0 0.924731 ) #model: #tlOutAspect #isReadOnly: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.420233 0 0.866667 0 0.527237 0 0.931183 ) #model: #doTlMenu #label: 'set' #defaultable: true ) ) ) )! !
  54927.  
  54928. !SimulateWindow class methodsFor: 'resources'!
  54929. fcMenu
  54930.     "Answer a menu for the final condition view."
  54931.  
  54932.     ^PopUpMenu labelList: #(#(#again #undo ) #(#copy #cut #paste ) #(#accept #cancel ) ) values: #(#again #undo #copySelection #cut #paste #fcAccept #cancel )! !
  54933.  
  54934. !SimulateWindow class methodsFor: 'resources'!
  54935. icMenu
  54936.     "Answer a menu for the initial condition view."
  54937.  
  54938.     "icSelection == nil ifTrue: [^nil]."
  54939.     ^PopUpMenu labelList: #(#('new initial value' ) ) values: #(#icChange )! !
  54940.  
  54941. ApplicationModel subclass: #DetailWindow
  54942.     instanceVariableNames: 'editingController transition newSource newDestination list currentTTM tempList sourceActView destActView topWin originalDestinationList defaultDestinationDictionary defaultSourceDictionary propertyNameView lowerBoundAspect upperBoundAspect guardAspect functionAspect newDestinationList destinationAspect sourceAspect ui sharedAspect '
  54943.     classVariableNames: 'Instances '
  54944.     poolDictionaries: ''
  54945.     category: 'Build'!
  54946.  
  54947. !DetailWindow methodsFor: 'miscellaneous'!
  54948. blanks: anInteger 
  54949.     | temp |
  54950.     temp := ''.
  54951.     anInteger timesRepeat: [temp := temp , ' '].
  54952.     ^temp! !
  54953.  
  54954. !DetailWindow methodsFor: 'performing'!
  54955. aActListMenu
  54956.     sourceActView selection > 0
  54957.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#sourceActivityTypeList )]
  54958.         ifFalse: [^nil]! !
  54959.  
  54960. !DetailWindow methodsFor: 'performing'!
  54961. aDestListMenu
  54962.     destActView selection > 0
  54963.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#destinationActivityTypeList )]
  54964.         ifFalse: [^nil]! !
  54965.  
  54966. !DetailWindow methodsFor: 'performing'!
  54967. aSourceListMenu
  54968.     ^PopUpMenu labelList: #(#('TTM | Activity Name' 'Range' ) ) values: #(#ttmNameS #sourceRange )! !
  54969.  
  54970. !DetailWindow methodsFor: 'performing'!
  54971. compressString: s 
  54972.     | r |
  54973.     r := ''.
  54974.     s do: [:x | x isAlphaNumeric | (#($< $> $% $* $+ $/ $- $) $( $= $: $, $; $~ $# $_ ) includes: x) ifTrue: [r := r , x asString]].
  54975.     ^r! !
  54976.  
  54977. !DetailWindow methodsFor: 'performing'!
  54978. destinationActivityTypeList
  54979.     | n lt temp2 temp1 theAct anAssociation newDict |
  54980.     lt := Array new: 1.
  54981.     theAct := (newDestination at: destinationAspect selectionIndex)
  54982.                 at: 1.
  54983.     temp1 := theAct.
  54984.     (currentTTM anExistingAVsPosition: (temp1 av at: 1)) notNil
  54985.         ifTrue: 
  54986.             [temp2 := SortedCollection new.
  54987.             (currentTTM typeForAVNamed: (temp1 av at: 1))
  54988.                 do: [:x | temp2 add: x].
  54989.             temp2 := temp2 asArray.
  54990.             lt at: 1 put: temp2].
  54991.     n := (PopUpMenu labelList: lt) startUp.
  54992.     n > 0
  54993.         ifTrue: 
  54994.             [theAct := (currentTTM typeForAVNamed3: (temp1 av at: 1))
  54995.                         at: n.
  54996.             anAssociation := Association new.
  54997.             anAssociation key: (temp1 av at: 1)
  54998.                 value: theAct.
  54999.             defaultDestinationDictionary add: anAssociation.
  55000.             newDict := Dictionary new.
  55001.             newDestination := editingController
  55002.                         findAV: transition endingAt
  55003.                         withDefault: defaultDestinationDictionary
  55004.                         newDictionary: newDict.
  55005.             defaultDestinationDictionary := newDict.
  55006.             destinationAspect list: self newDestinationList]! !
  55007.  
  55008. !DetailWindow methodsFor: 'performing'!
  55009. destinationMenu
  55010.     ^PopUpMenu labelList: #(#('TTM | Activity Name' 'Range' ) ) values: #(#ttmNameD #destinationRange )! !
  55011.  
  55012. !DetailWindow methodsFor: 'performing'!
  55013. destinationMenu1
  55014.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  55015.  
  55016. !DetailWindow methodsFor: 'performing'!
  55017. destinationMenut
  55018.     destinationAspect selectionIndex > 0
  55019.         ifTrue: [^PopUpMenu labelList: #(#('Range' ) ) values: #(#destinationRange ) decodeAsLiteralArray]
  55020.         ifFalse: [^nil]! !
  55021.  
  55022. !DetailWindow methodsFor: 'performing'!
  55023. destinationRange
  55024.     destinationAspect selectionIndex > 0 ifTrue: [self destinationActivityTypeList]! !
  55025.  
  55026. !DetailWindow methodsFor: 'performing'!
  55027. dummy! !
  55028.  
  55029. !DetailWindow methodsFor: 'performing'!
  55030. dummy: ignore! !
  55031.  
  55032. !DetailWindow methodsFor: 'performing'!
  55033. editProperty! !
  55034.  
  55035. !DetailWindow methodsFor: 'performing'!
  55036. functionMenu
  55037.     ^PopUpMenu labelList: #(#('Edit' ) ) values: #(#performEditFunction )! !
  55038.  
  55039. !DetailWindow methodsFor: 'performing'!
  55040. getFunction
  55041.   ^transition myAction! !
  55042.  
  55043. !DetailWindow methodsFor: 'performing'!
  55044. getGuard
  55045.   ^transition myGuard! !
  55046.  
  55047. !DetailWindow methodsFor: 'performing'!
  55048. getLowerBound
  55049.   ^transition boundLower asString! !
  55050.  
  55051. !DetailWindow methodsFor: 'performing'!
  55052. getParallelAVListFor: anActivity 
  55053.     | child |
  55054.     child := anActivity left.
  55055.     [child notNil]
  55056.         whileTrue: 
  55057.             [child collectionType = #cluster
  55058.                 ifTrue: [child left notNil ifTrue: [tempList add: child]]
  55059.                 ifFalse: [self getParallelAVListFor: child].
  55060.             child := child right]! !
  55061.  
  55062. !DetailWindow methodsFor: 'performing'!
  55063. getUpperBound
  55064.   ^transition boundUpper asString! !
  55065.  
  55066. !DetailWindow methodsFor: 'performing'!
  55067. guardMenu
  55068.     ^PopUpMenu labelList: #(#('Edit' ) ) values: #(#performEditGuard )! !
  55069.  
  55070. !DetailWindow methodsFor: 'performing'!
  55071. isNumber: aString 
  55072.     aString = '' ifTrue: [^false].
  55073.     aString do: [:x | x isDigit ifFalse: [^false]].
  55074.     ^true! !
  55075.  
  55076. !DetailWindow methodsFor: 'performing'!
  55077. parallelAVListFor: anActivity 
  55078.     | t c |
  55079.     tempList := OrderedCollection new.
  55080.     self getParallelAVListFor: anActivity.
  55081.     t := Array new: tempList size.
  55082.     c := 1.
  55083.     tempList
  55084.         do: 
  55085.             [:x | 
  55086.             t at: c put: (x selfAV at: 1).
  55087.             c := c + 1].
  55088.     ^t! !
  55089.  
  55090. !DetailWindow methodsFor: 'performing'!
  55091. parrallelAVs
  55092.     | theAct temp2 lt s1 n types |
  55093.     theAct := (newSource at: sourceAspect selectionIndex)
  55094.                 at: 1.
  55095.     theAct collectionType = #parallel
  55096.         ifTrue: 
  55097.             [s1 := (PopUpMenu labelArray: (self parallelAVListFor: theAct)) startUp.
  55098.             s1 = 0 ifTrue: [^nil].
  55099.             lt := Array new: 1.
  55100.             (currentTTM anExistingAVsPosition: ((tempList at: s1) selfAV at: 1)) notNil
  55101.                 ifTrue: 
  55102.                     [temp2 := SortedCollection new.
  55103.                     types := currentTTM typeForAVNamed: ((tempList at: s1) selfAV at: 1).
  55104.                     types isNil ifTrue: [^nil].
  55105.                     types do: [:x | temp2 add: x].
  55106.                     temp2 := temp2 asArray.
  55107.                     lt at: 1 put: temp2].
  55108.             n := (PopUpMenu labelList: lt) startUp]
  55109.         ifFalse: [^nil]! !
  55110.  
  55111. !DetailWindow methodsFor: 'performing'!
  55112. performEditFunction
  55113.     | oldValue newValue accept ast undefined |
  55114.     oldValue := transition myAction.
  55115.     newValue := functionAspect value.
  55116.     newValue := self compressString: newValue.
  55117.     accept := false.
  55118.     newValue isEmpty ifTrue: [newValue := 'nil'].
  55119.     newValue = oldValue
  55120.         ifFalse: 
  55121.             [newValue = 'nil'
  55122.                 ifTrue: [transition myAction: newValue]
  55123.                 ifFalse: 
  55124.                     [accept := true.
  55125.                     ast := BuildTFParser new parseForAST: newValue
  55126.                                 ifFail: 
  55127.                                     [TTMList speak: newValue , ' : Invalid function for transition'.
  55128.                                     accept := false.
  55129.                                     ^functionAspect value: oldValue]].
  55130.             accept = false ifFalse: [ast rhsVars do: [:x | (currentTTM anExistingAV: x)
  55131.                         = false & (currentTTM anExistingDV: x) = false
  55132.                         ifTrue: 
  55133.                             [undefined isNil ifTrue: [undefined := ''].
  55134.                             undefined := undefined , '  ' , x]]].
  55135.             accept = false | undefined notNil = true
  55136.                 ifTrue: [undefined notNil
  55137.                         ifTrue: 
  55138.                             [TTMList speak: (newValue , ' : Invalid function for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  55139.                             functionAspect value: oldValue]]
  55140.                 ifFalse: 
  55141.                     [transition myAction: newValue.
  55142.                     editingController view displayOn: #dummy]]! !
  55143.  
  55144. !DetailWindow methodsFor: 'performing'!
  55145. performEditGuard
  55146.     | oldValue newValue accept ast undefined |
  55147.     oldValue := transition myGuard.
  55148.     newValue := guardAspect value.
  55149.     newValue := self compressString: newValue.
  55150.     accept := false.
  55151.     newValue isEmpty ifTrue: [newValue := 'nil'].
  55152.     newValue = oldValue
  55153.         ifFalse: 
  55154.             [newValue = 'nil'
  55155.                 ifTrue: [accept := true]
  55156.                 ifFalse: 
  55157.                     [accept := true.
  55158.                     ast := BuildBoolParser new parseForAST: newValue
  55159.                                 ifFail: 
  55160.                                     [TTMList speak: newValue , ' : Invalid guard for transition'.
  55161.                                     accept := false].
  55162.                     accept = false ifFalse: [ast rhsVars do: [:x | (currentTTM anExistingAV: x)
  55163.                                 = false & ((currentTTM anExistingDV: x)
  55164.                                     = false)
  55165.                                 ifTrue: 
  55166.                                     [undefined isNil ifTrue: [undefined := ''].
  55167.                                     undefined := undefined , '  ' , x]]]].
  55168.             accept = false | undefined notNil = true
  55169.                 ifTrue: [undefined notNil
  55170.                         ifTrue: 
  55171.                             [TTMList speak: (newValue , ' : Invalid guard for transition\' , 'The following variable(s) are undefined: ' , '\' , undefined) withCRs.
  55172.                             guardAspect value: oldValue]]
  55173.                 ifFalse: 
  55174.                     [transition myGuard: newValue.
  55175.                     editingController view displayOn: #dummy]]! !
  55176.  
  55177. !DetailWindow methodsFor: 'performing'!
  55178. performEditLowerBound
  55179.     | oldValue newValue |
  55180.     oldValue := transition boundLower.
  55181.     newValue := lowerBoundAspect value.
  55182.     newValue := self compressString: newValue.
  55183.     (self isNumber: newValue)
  55184.         = true
  55185.         ifTrue: 
  55186.             [transition boundLower: newValue.
  55187.             editingController view displayOn: #dummy]
  55188.         ifFalse: 
  55189.             [lowerBoundAspect value: oldValue.
  55190.             TTMList speak: 'invalid lower bound']! !
  55191.  
  55192. !DetailWindow methodsFor: 'performing'!
  55193. performEditUpperBound
  55194.     | oldValue newValue |
  55195.     oldValue := transition boundUpper.
  55196.     newValue := upperBoundAspect value.
  55197.     newValue := self compressString: newValue.
  55198.     (self isNumber: newValue)
  55199.         = true | (newValue = 'infinity')
  55200.         ifTrue: 
  55201.             [transition boundUpper: newValue.
  55202.             editingController view displayOn: #dummy]
  55203.         ifFalse: 
  55204.             [upperBoundAspect value: oldValue.
  55205.             TTMList speak: 'invalid upper bound']! !
  55206.  
  55207. !DetailWindow methodsFor: 'performing'!
  55208. propertyMenu
  55209.     propertyNameView selection > 0
  55210.         ifTrue: [^PopUpMenu labelList: #(#('Edit' ) ) values: #(#editProperty )]
  55211.         ifFalse: [^nil]! !
  55212.  
  55213. !DetailWindow methodsFor: 'performing'!
  55214. sourceActivityTypeList
  55215.     | n lt temp2 temp1 theAct anAssociation newDict actualActs s1 |
  55216.     sourceAspect selectionIndex < 1 ifTrue: [^nil].
  55217.     lt := Array new: 1.
  55218.     theAct := (newSource at: sourceAspect selectionIndex)
  55219.                 at: 1.
  55220.     temp1 := theAct.
  55221.     theAct collectionType = #parallel
  55222.         ifTrue: 
  55223.             [s1 := (PopUpMenu labelArray: (self parallelAVListFor: theAct)) startUp.
  55224.             s1 = 0 ifTrue: [^nil].
  55225.             lt := Array new: 1.
  55226.             (currentTTM anExistingAVsPosition: ((tempList at: s1) selfAV at: 1)) notNil
  55227.                 ifTrue: 
  55228.                     [temp2 := SortedCollection new.
  55229.                     actualActs := currentTTM typeForAVNamed3: ((tempList at: s1) selfAV at: 1).
  55230.                     actualActs isNil ifTrue: [^nil].
  55231.                     actualActs do: [:x | temp2 add: x myName].
  55232.                     temp2 := temp2 asArray.
  55233.                     lt at: 1 put: temp2].
  55234.             n := (PopUpMenu labelList: lt) startUp]
  55235.         ifFalse: 
  55236.             [temp1 selfAV isNil ifTrue: [^nil].
  55237.             (currentTTM anExistingAVsPosition: (temp1 selfAV at: 1)) notNil
  55238.                 ifTrue: 
  55239.                     [temp2 := OrderedCollection new.
  55240.                     actualActs := currentTTM typeForAVNamed3: (temp1 selfAV at: 1).
  55241.                     actualActs isNil ifTrue: [^nil].
  55242.                     actualActs do: [:x | temp2 add: x myName].
  55243.                     temp2 := temp2 asArray.
  55244.                     lt at: 1 put: temp2].
  55245.             (lt at: 1) notNil ifTrue: [n := (PopUpMenu labelList: lt) startUp]].
  55246.     n isNil ifTrue: [^nil].
  55247.     n > 0
  55248.         ifTrue: 
  55249.             [theAct := actualActs at: n.
  55250.             anAssociation := Association new.
  55251.             anAssociation key: (theAct av at: 1)
  55252.                 value: theAct.
  55253.             defaultSourceDictionary add: anAssociation.
  55254.             newDict := Dictionary new.
  55255.             newSource := editingController
  55256.                         findAVSource2: transition startingAt
  55257.                         withDefault: defaultSourceDictionary
  55258.                         newDictionary: newDict.
  55259.             defaultDestinationDictionary := newDict.
  55260.             sourceAspect list: self newSourceList]! !
  55261.  
  55262. !DetailWindow methodsFor: 'performing'!
  55263. sourceMenu
  55264.     ^self aSourceListMenu! !
  55265.  
  55266. !DetailWindow methodsFor: 'performing'!
  55267. sourceRange
  55268.     self sourceActivityTypeList! !
  55269.  
  55270. !DetailWindow methodsFor: 'performing'!
  55271. ttmNameD
  55272.     | theAct name |
  55273.     destinationAspect selectionIndex < 1 ifTrue: [^nil].
  55274.     theAct := (newDestination at: destinationAspect selectionIndex)
  55275.                 at: 1.
  55276.     name := (editingController model ttm activitytree parentOf: theAct) myName.
  55277.     (PopUpMenu labels: name) startUp! !
  55278.  
  55279. !DetailWindow methodsFor: 'performing'!
  55280. ttmNameS
  55281.     | theAct name |
  55282.      sourceAspect selectionIndex < 1 ifTrue: [^nil].
  55283.     theAct := (newSource at: sourceAspect selectionIndex)
  55284.                 at: 1.
  55285.     name := (editingController model ttm activitytree parentOf: theAct) myName.
  55286.     (PopUpMenu labels: name) startUp! !
  55287.  
  55288. !DetailWindow methodsFor: 'closing'!
  55289. closeDetail
  55290.     transition detailWindow: nil.
  55291.       self closeRequest.
  55292.     "ui close"! !
  55293.  
  55294. !DetailWindow methodsFor: 'closing'!
  55295. removeDependent: aDependent 
  55296.     transition detailWindow: nil.
  55297.     super removeDependent: aDependent.
  55298.       self closeRequest.! !
  55299.  
  55300. !DetailWindow methodsFor: 'initialization'!
  55301. initialize
  55302.     super initialize.
  55303.     self lowerBoundAspect onChangeSend: #performEditLowerBound to: self.
  55304.     self upperBoundAspect onChangeSend: #performEditUpperBound to: self.
  55305.     self guardAspect onChangeSend: #performEditGuard to: self.
  55306.     self functionAspect onChangeSend: #performEditFunction to: self! !
  55307.  
  55308. !DetailWindow methodsFor: 'initialization'!
  55309. openFor2: aTransition 
  55310.     | p |
  55311.     transition := aTransition.
  55312.     defaultDestinationDictionary := Dictionary new.
  55313.     defaultSourceDictionary := Dictionary new.
  55314.     newSource := OrderedCollection new.
  55315.     functionAspect := aTransition myAction asValue.
  55316.     guardAspect := aTransition myGuard asValue.
  55317.     upperBoundAspect := aTransition boundUpper asValue.
  55318.     lowerBoundAspect := aTransition boundLower asValue.
  55319.     sharedAspect := ValueHolder new.
  55320.     aTransition shared ifTrue: [sharedAspect value: #setShared].
  55321.     sharedAspect onChangeSend: #updateSharedStatus to: self.
  55322.     transition detailWindow: self.
  55323.     transition defaultDestinationAssignments notNil
  55324.         ifFalse: 
  55325.             [newDestination := editingController getActivityTranformationsFor: aTransition endingAt.
  55326.             originalDestinationList := OrderedCollection new.
  55327.             newDestination
  55328.                 do: 
  55329.                     [:x | 
  55330.                     p := Array new: 2.
  55331.                     p at: 1 put: (x at: 1).
  55332.                     p at: 2 put: (x at: 2).
  55333.                     originalDestinationList add: p]]
  55334.         ifTrue: [newDestination := editingController
  55335.                         findAV: transition endingAt
  55336.                         withDefault: transition defaultDestinationAssignments
  55337.                         newDictionary: defaultDestinationDictionary].
  55338.     transition defaultSourceAssignments notNil
  55339.         ifTrue: [newSource := editingController
  55340.                         findAVSource: transition startingAt
  55341.                         withDefault: transition defaultSourceAssignments
  55342.                         newDictionary: defaultSourceDictionary]
  55343.         ifFalse: [newSource add: (Array with: aTransition startingAt with: 0)].
  55344.     destinationAspect := SelectionInList new list: self newDestinationList.
  55345.     sourceAspect := SelectionInList new list: self newSourceList.
  55346.     currentTTM := editingController model ttm.
  55347.     self initialize.! !
  55348.  
  55349. !DetailWindow methodsFor: 'variable access'!
  55350. editingController
  55351.  
  55352.      ^editingController! !
  55353.  
  55354. !DetailWindow methodsFor: 'variable access'!
  55355. editingController: aController
  55356.  
  55357.      editingController := aController! !
  55358.  
  55359. !DetailWindow methodsFor: 'variable access'!
  55360. newDestination
  55361.  
  55362.      ^newDestination! !
  55363.  
  55364. !DetailWindow methodsFor: 'variable access'!
  55365. newSource
  55366.  
  55367.      ^newSource! !
  55368.  
  55369. !DetailWindow methodsFor: 'variable access'!
  55370. newSourceList
  55371.     | temp |
  55372.     temp := OrderedCollection new.
  55373.     newSource do: [:x | temp add: (self blanks: (x at: 2)
  55374.                     - 1 * 4)
  55375.                 , ((x at: 1) av at: 1) , ' = ' , (x at: 1) myName].
  55376.     ^temp asArray! !
  55377.  
  55378. !DetailWindow methodsFor: 'variable access'!
  55379. propertyList
  55380.     ^#('Upper Time Bound' 'Lower Time Bound' 'Guard' 'Transformation Function' )! !
  55381.  
  55382. !DetailWindow methodsFor: 'variable access'!
  55383. ui: aUi 
  55384.     ui := aUi! !
  55385.  
  55386. !DetailWindow methodsFor: 'aspects'!
  55387. destinationAspect
  55388.     "This method was generated by UIDefiner. The initialization provided 
  55389.     below may have been preempted by an initialize method."
  55390.  
  55391.     ^destinationAspect isNil ifTrue: [destinationAspect := SelectionInList new] ifFalse: [destinationAspect]! !
  55392.  
  55393. !DetailWindow methodsFor: 'aspects'!
  55394. functionAspect
  55395.     "This method was generated by UIDefiner. The initialization provided 
  55396.     below may have been preempted by an initialize method."
  55397.  
  55398.     ^functionAspect isNil ifTrue: [functionAspect := String new asValue] ifFalse: [functionAspect]! !
  55399.  
  55400. !DetailWindow methodsFor: 'aspects'!
  55401. guardAspect
  55402.     "This method was generated by UIDefiner. The initialization provided 
  55403.     below may have been preempted by an initialize method."
  55404.  
  55405.     ^guardAspect isNil ifTrue: [guardAspect := String new asValue] ifFalse: [guardAspect]! !
  55406.  
  55407. !DetailWindow methodsFor: 'aspects'!
  55408. lowerBoundAspect
  55409.     "This method was generated by UIDefiner. The initialization provided 
  55410.     below may have been preempted by an initialize method."
  55411.  
  55412.     ^lowerBoundAspect isNil ifTrue: [lowerBoundAspect := String new asValue] ifFalse: [lowerBoundAspect]! !
  55413.  
  55414. !DetailWindow methodsFor: 'aspects'!
  55415. newDestinationList
  55416.     | temp |
  55417.     temp := OrderedCollection new.
  55418.     newDestination do: [:x | temp add: (self blanks: (x at: 2)
  55419.                     - 1 * 4)
  55420.                 , ((x at: 1) av at: 1) , ' : ' , (x at: 1) myName].
  55421.     ^temp asArray! !
  55422.  
  55423. !DetailWindow methodsFor: 'aspects'!
  55424. sharedAspect
  55425.     ^sharedAspect! !
  55426.  
  55427. !DetailWindow methodsFor: 'aspects'!
  55428. sourceAspect
  55429.     "This method was generated by UIDefiner. The initialization provided 
  55430.     below may have been preempted by an initialize method."
  55431.  
  55432.     ^sourceAspect isNil ifTrue: [sourceAspect := SelectionInList new] ifFalse: [sourceAspect]! !
  55433.  
  55434. !DetailWindow methodsFor: 'aspects'!
  55435. upperBoundAspect
  55436.     "This method was generated by UIDefiner. The initialization provided 
  55437.     below may have been preempted by an initialize method."
  55438.  
  55439.     ^upperBoundAspect isNil ifTrue: [upperBoundAspect := String new asValue] ifFalse: [upperBoundAspect]! !
  55440.  
  55441. !DetailWindow methodsFor: 'actions'!
  55442. doAcceptNewDest
  55443.     "This stub method was generated by UIDefiner"
  55444.  
  55445.     transition defaultDestinationAssignments: defaultDestinationDictionary copy.! !
  55446.  
  55447. !DetailWindow methodsFor: 'actions'!
  55448. doAcceptNewSource
  55449.     "This stub method was generated by UIDefiner"
  55450.  
  55451.     transition defaultSourceAssignments: defaultSourceDictionary copy.! !
  55452.  
  55453. !DetailWindow methodsFor: 'actions'!
  55454. doRevertToDestinationDefaults
  55455.     "This stub method was generated by UIDefiner"
  55456.  
  55457.     defaultDestinationDictionary := Dictionary new.
  55458.     newDestination := editingController
  55459.                 findAV: transition endingAt
  55460.                 withDefault: defaultDestinationDictionary
  55461.                 newDictionary: defaultDestinationDictionary.
  55462.     destinationAspect list: self newDestinationList.
  55463.     transition defaultDestinationAssignments: nil! !
  55464.  
  55465. !DetailWindow methodsFor: 'actions'!
  55466. doRevertToSourceDefault
  55467.     "This stub method was generated by UIDefiner"
  55468.  
  55469.     defaultSourceDictionary := Dictionary new.
  55470.     newSource := editingController
  55471.                 findAVSource: transition startingAt
  55472.                 withDefault: defaultSourceDictionary
  55473.                 newDictionary: defaultSourceDictionary.
  55474.     sourceAspect list: self newSourceList.
  55475.     transition defaultSourceAssignments: nil! !
  55476.  
  55477. !DetailWindow methodsFor: 'actions'!
  55478. updateSharedStatus
  55479.     sharedAspect value = #setShared
  55480.         ifTrue: [transition shared: true]
  55481.         ifFalse: [transition shared: false]! !
  55482.  
  55483. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  55484.  
  55485. DetailWindow class
  55486.     instanceVariableNames: ''!
  55487.  
  55488. !DetailWindow class methodsFor: 'instance creation'!
  55489. new: aTransition from: aController 
  55490.     | temp t2 |
  55491.     aTransition detailWindow notNil
  55492.         ifTrue: 
  55493.             [SimpleDialog new warn: 'A Detail Window is already open for this transition'.
  55494.             ^nil].
  55495.     temp := super new editingController: aController.
  55496.     temp openFor2: aTransition.
  55497.     t2 := temp open window label: 'Transition:  ' , aTransition myName , '   TTM: ' , aController model ttm named.
  55498.     temp ui: t2! !
  55499.  
  55500. !DetailWindow class methodsFor: 'interface specs'!
  55501. windowSpec
  55502.     "UIPainter new openOnClass: self andSelector: #windowSpec"
  55503.  
  55504.     ^#(#FullSpec #window: #(#WindowSpec #label: '' #min: #(#Point 364 429 ) #bounds: #(#Rectangle 393 243 757 672 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 0 0.0357143 0 0.0979021 0 0.494505 0 0.351981 ) #flags: 15 #model: #sourceAspect #menu: #sourceMenu ) #(#SequenceViewSpec #layout: #(#LayoutFrame 0 0.510989 0 0.0979021 0 0.950549 0 0.34965 ) #flags: 15 #model: #destinationAspect #menu: #destinationMenu ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0851648 0 0.041958 ) #label: 'Source Activities' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.532967 0 0.041958 ) #label: 'Destination Activities' ) #(#GroupBoxSpec #layout: #(#LayoutFrame 0 0.0164835 0 0.034965 0 0.972527 0 0.505827 ) ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.546703 0 0.361305 0 0.917582 0 0.424242 ) #model: #doRevertToDestinationDefaults #label: 'Revert to Default' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0604396 0 0.363636 0 0.453297 0 0.428904 ) #model: #doRevertToSourceDefault #label: 'Revert to Default' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.549451 0 0.428904 0 0.92033 0 0.484848 ) #model: #doAcceptNewDest #label: 'Accept New Dest.' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.526807 ) #label: 'Lower Bound' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.354396 0 0.531468 0 0.681319 0 0.58042 ) #model: #lowerBoundAspect #isReadOnly: false #type: #string ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.717033 0 0.937063 0 0.934066 0 0.993007 ) #model: #closeDetail #label: 'Close' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.596737 ) #label: 'Upper Bound' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0576923 0 0.680653 ) #label: 'Guard' ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0604396 0 0.764569 ) #label: 'Function' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.357143 0 0.594406 0 0.684066 0 0.645688 ) #model: #upperBoundAspect #isReadOnly: false ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0.0604396 0 0.428904 0 0.456044 0 0.48951 ) #model: #doAcceptNewSource #label: 'Accept New Source' #defaultable: true ) #(#MenuButtonSpec #layout: #(#LayoutFrame 0 0.354396 0 0.862471 0 0.958791 0 0.925408 ) #model: #sharedAspect #menu: #sharedMenu ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.0631868 0 0.876457 ) #label: 'Scope' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.258242 0 0.680653 0 0.96978 0 0.741259 ) #model: #guardAspect ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.258242 0 0.762238 0 0.975275 0 0.820513 ) #model: #functionAspect ) ) ) )! !
  55505.  
  55506. !DetailWindow class methodsFor: 'resources'!
  55507. destinationMenu
  55508.     "UIMenuEditor new openOnClass: self andSelector: #destinationMenu"
  55509.  
  55510.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  55511.  
  55512. !DetailWindow class methodsFor: 'resources'!
  55513. destinationMenu2
  55514.     "UIMenuEditor new openOnClass: self andSelector: #destinationMenu"
  55515.  
  55516.     ^#(#PopUpMenu #('Range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  55517.  
  55518. !DetailWindow class methodsFor: 'resources'!
  55519. dingus
  55520.     "UIMenuEditor new openOnClass: self andSelector: #dingus"
  55521.  
  55522.     ^#(#PopUpMenu #('range' ) #() #(#destinationRange ) ) decodeAsLiteralArray! !
  55523.  
  55524. !DetailWindow class methodsFor: 'resources'!
  55525. functionMenu
  55526.     "UIMenuEditor new openOnClass: self andSelector: #functionMenu"
  55527.  
  55528.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditFunction ) ) decodeAsLiteralArray! !
  55529.  
  55530. !DetailWindow class methodsFor: 'resources'!
  55531. guardMenu
  55532.     "UIMenuEditor new openOnClass: self andSelector: #guardMenu"
  55533.  
  55534.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditGuard ) ) decodeAsLiteralArray! !
  55535.  
  55536. !DetailWindow class methodsFor: 'resources'!
  55537. lowerBoundMenu
  55538.     "UIMenuEditor new openOnClass: self andSelector: #lowerBoundMenu"
  55539.  
  55540.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditLowerBound ) ) decodeAsLiteralArray! !
  55541.  
  55542. !DetailWindow class methodsFor: 'resources'!
  55543. sharedMenu
  55544.     "UIMenuEditor new openOnClass: self andSelector: #sharedMenu"
  55545.  
  55546.     ^#(#PopUpMenu #('Transition is not shared' 'Transition is shared' ) #() #(#setNoShare #setShared ) ) decodeAsLiteralArray! !
  55547.  
  55548. !DetailWindow class methodsFor: 'resources'!
  55549. upperBoundMenu
  55550.     "UIMenuEditor new openOnClass: self andSelector: #upperBoundMenu"
  55551.  
  55552.     ^#(#PopUpMenu #('Edit' ) #() #(#performEditUpperBound ) ) decodeAsLiteralArray! !
  55553.  
  55554. ListView subclass: #AlteredListView
  55555.     instanceVariableNames: ''
  55556.     classVariableNames: ''
  55557.     poolDictionaries: ''
  55558.     category: 'Build'!
  55559.  
  55560. !AlteredListView methodsFor: 'initialize-release'!
  55561. initialize
  55562.     "Altered method of class ListView. 
  55563.     
  55564.     Changed so that it uses the altered version of 
  55565.     
  55566.     TextList below. Used so that display is in 
  55567.     
  55568.     fixed font style and no delimiters used."
  55569.  
  55570.     super initialize.
  55571.     isEmpty := true.
  55572.     list := AlteredTextList onList: Array new.
  55573.     self setToTop.
  55574.     selection := 0! !
  55575.  
  55576. AlteredListView subclass: #AlteredTableView
  55577.     instanceVariableNames: 'itemList partMsg listMsg '
  55578.     classVariableNames: ''
  55579.     poolDictionaries: ''
  55580.     category: 'Build'!
  55581.  
  55582. !AlteredTableView methodsFor: 'initialize-release'!
  55583. on: anObject aspect: m1 list: m2 
  55584.     "Set the instance variables for the receiver."
  55585.  
  55586.     partMsg := m1.
  55587.     listMsg := m2.
  55588.     self noTopDelimiter; noBottomDelimiter.
  55589.     self model: anObject! !
  55590.  
  55591. !AlteredTableView methodsFor: 'list/controller access'!
  55592. changeModelSelection: anInteger 
  55593.  
  55594.      "Called by controller so this method should 
  55595.  
  55596.      not be deleted although it does nothing."! !
  55597.  
  55598. !AlteredTableView methodsFor: 'list/controller access'!
  55599. defaultControllerClass
  55600.     ^"SelectionInListController" Controller! !
  55601.  
  55602. !AlteredTableView methodsFor: 'list/controller access'!
  55603. list: anArray 
  55604.  
  55605.     "Set the receiver's list to be anArray."
  55606.  
  55607.  
  55608.  
  55609.     itemList := anArray.
  55610.  
  55611.     anArray == nil
  55612.  
  55613.         ifTrue: 
  55614.  
  55615.             [isEmpty := true.
  55616.  
  55617.             selection := 0.
  55618.  
  55619.             self listLines: nil.
  55620.  
  55621.             ^self changeModelSelection: 0].
  55622.  
  55623.     isEmpty := false.
  55624.  
  55625.     self listLines: anArray.
  55626.  
  55627.     offset := 6 @ 0.
  55628.  
  55629.     selection := 0! !
  55630.  
  55631. !AlteredTableView methodsFor: 'list/controller access'!
  55632. yellowButtonMenu
  55633.  
  55634.      "Called by the controller, so this method 
  55635.  
  55636.      should not be deleted."
  55637.  
  55638.  
  55639.  
  55640.      ^nil! !
  55641.  
  55642. !AlteredTableView methodsFor: 'updating'!
  55643. update: aSymbol 
  55644.  
  55645.     "If aSymbol is equal to partMst then change the receiver's 
  55646.  
  55647.     list and list selection. 
  55648.  
  55649.     If aSymbol is equal to initialSelectionMsg then only change 
  55650.  
  55651.     the receiver's selection. 
  55652.  
  55653.     If aSymbol is equal to #empty then reset the receiver."
  55654.  
  55655.  
  55656.  
  55657.     self isOpen ifFalse: [^self].
  55658.  
  55659.     aSymbol == partMsg ifTrue: [^self setNewList].
  55660.  
  55661.     aSymbol == nil ifTrue: [^self setNewSelection].
  55662.  
  55663.     aSymbol == #empty ifTrue: [isEmpty
  55664.  
  55665.             ifFalse: 
  55666.  
  55667.                 [self reset.
  55668.  
  55669.                 self invalidate.
  55670.  
  55671.                 self updateControls]]! !
  55672.  
  55673. !AlteredTableView methodsFor: 'model/region access'!
  55674. clippingBox
  55675.  
  55676.     "Answer the rectangle in which the model can be 
  55677.  
  55678.     displayed--this 
  55679.  
  55680.     is the displayBox inset by the height of a line for an 
  55681.  
  55682.     item."
  55683.  
  55684.  
  55685.  
  55686.     | box grid |
  55687.  
  55688.     box := self bounds.
  55689.  
  55690.     grid := self lineGrid.
  55691.  
  55692.     box height: (box height truncateTo: grid).
  55693.  
  55694.     ^box! !
  55695.  
  55696. !AlteredTableView methodsFor: 'model/region access'!
  55697. getList
  55698.  
  55699.      "Answer the list to be displayed."
  55700.  
  55701.  
  55702.  
  55703.      ^model perform: listMsg! !
  55704.  
  55705. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  55706.  
  55707. AlteredTableView class
  55708.     instanceVariableNames: ''!
  55709.  
  55710. !AlteredTableView class methodsFor: 'instance creation'!
  55711. on: anObject aspect: aspectMsg list: listMsg 
  55712.     "This is a reduced version of SelectionInListView. 
  55713.     
  55714.     It uses an index; oneItem, printItem, and initialSelection 
  55715.     
  55716.     are false; and it does not use a menu. Basically, 
  55717.     
  55718.     it is used to display a scrolling array of lines that 
  55719.     
  55720.     can be formatted with regard to style and spacing."
  55721.  
  55722.     ^self new
  55723.         on: anObject
  55724.         aspect: aspectMsg
  55725.         list: listMsg! !
  55726.  
  55727. TTMList open!
  55728.  
  55729. '----SNAPSHOT----'!
  55730.  
  55731. "Build0985.im created at 16 December 1994 12:41:50 pm"!
  55732.  
  55733. selection anExistingDV: (v at: 1)!
  55734.  
  55735. !TTM methodsFor: 'variable maintenance'!
  55736. anExistingDV2: aString 
  55737.     "Return true if aString is one of the existing data 
  55738.     
  55739.     variables of the TTM."
  55740.  
  55741.     self datavariable do: [:x | aString = (x at: 1) ifTrue: [^true]].
  55742.     ^false! !
  55743.  
  55744. selection anExistingDV2: (v at: 1)!
  55745.  
  55746. !TTMList methodsFor: 'As yet unclassified'!
  55747. makeTypesFor: prologType 
  55748.     | table current count leftmargin v inset |
  55749.     table := OrderedCollection new.
  55750.     leftmargin := '        '.
  55751.     count := 1.
  55752.     [count > variableSet size]
  55753.         whileFalse: 
  55754.             [v := variableSet at: count.
  55755.             current := self variableTypeFor: v noName: #false.
  55756.             prologType = #quintus
  55757.                 ifTrue: [current := current , ' :- ']
  55758.                 ifFalse: [current := current , ' {'].
  55759.             table add: current.
  55760.             current := leftmargin.
  55761.             (selection anExistingDV2: (v at: 1))
  55762.                 ifTrue: 
  55763.                     [(v at: 2)
  55764.                         = '-infinity' ifFalse: [current := current , (v at: 1) , ' >= ' , (v at: 2)].
  55765.                     (v at: 3)
  55766.                         = 'infinity'
  55767.                         ifFalse: 
  55768.                             [(v at: 2)
  55769.                                 ~= '-infinity'
  55770.                                 ifTrue: 
  55771.                                     [current := current , ','.
  55772.                                     table add: current].
  55773.                             current := leftmargin , (v at: 1) , ' =< ' , (v at: 3).
  55774.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  55775.                             current := current , '.'.
  55776.                             table add: current]
  55777.                         ifTrue: 
  55778.                             [(v at: 2)
  55779.                                 = '-infinity' ifTrue: [current := leftmargin , (v at: 1) , ' >= 0; ' , (v at: 1) , ' < 0'].
  55780.                             prologType = #prolog3 ifTrue: [current := current , '}'].
  55781.                             current := current , '. '.
  55782.                             table add: current]]
  55783.                 ifFalse: 
  55784.                     [inset := self makeTypeForAV: v.
  55785.                     prologType = #quintus
  55786.                         ifTrue: [current := current , '(' , inset , '). ']
  55787.                         ifFalse: [current := current , inset , '}. '].
  55788.                     table add: current].
  55789.             count := count + 1].
  55790.     ^table! !
  55791.  
  55792. selection anExistingDV2: (v at: 1)!
  55793.  
  55794. v at: 1!