[BACK]Return to dr.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/dr.sm1 between version 1.40 and 1.46

version 1.40, 2004/09/14 01:57:15 version 1.46, 2004/09/17 00:47:08
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.39 2004/09/12 02:47:45 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.45 2004/09/17 00:10:41 takayama Exp $
 %% dr.sm1 (Define Ring) 1994/9/25, 26  %% dr.sm1 (Define Ring) 1994/9/25, 26
 %% This file is error clean.  %% This file is error clean.
   
Line 342 
Line 342 
      0 1 << set0 length 1 sub >>       0 1 << set0 length 1 sub >>
      {       {
         /i set          /i set
         << set0 i get >> a eq          set0 i get tag , a tag , eq {
         {            << set0 i get >> a eq
            /flag 1 def            {
          }               /flag 1 def  exit
         { }             }
         ifelse            { }
             ifelse
           } {  } ifelse
      } for       } for
   ] pop    ] pop
   /arg1 flag def    /arg1 flag def
Line 1718 
Line 1720 
  [( string .. universalNumber)   [( string .. universalNumber)
   (Parse the << string >> as a universalNumber.)    (Parse the << string >> as a universalNumber.)
   (Example:  (123431232123123).. /n set)    (Example:  (123431232123123).. /n set)
     ({ commands }..  executes the commands.  << .. >> is equivalent to exec.)
 ]] putUsages  ]] putUsages
 /.. { (universalNumber) data_conversion } def  /.. { dup tag 3 eq { exec } { (universalNumber) data_conversion} ifelse } def
   
 [(dc)  [(dc)
  [(Abbreviation of data_conversion.)   [(Abbreviation of data_conversion.)
Line 4151  $ [ff ff] fromVectors :: $ 
Line 4154  $ [ff ff] fromVectors :: $ 
 /getNode {  /getNode {
   /arg2 set    /arg2 set
   /arg1 set    /arg1 set
   [/in-getNode /ob /key /rr /rr /ii] pushVariables    [/in-getNode /ob /key /rr /tt /ii] pushVariables
   [    [
     /ob arg1 def      /ob arg1 def
     /key arg2 def      /key arg2 def
     /rr null def      /rr null def
     {      {
         ob isArray {
           ob length 1 gt {
             ob 0 get isString {
               ob 0 get , key eq {
                 /rr ob 1 get def exit
               } {  } ifelse
             } { } ifelse
           }{ } ifelse
           ob { key getNode , dup tag 0 eq {pop} { } ifelse }  map /tt set
           tt length 0 gt { /rr tt 0 get def exit }
           {/rr null def exit } ifelse
         } { } ifelse
   
       ob isClass {        ob isClass {
         ob (array) dc /ob set          ob (array) dc /ob set
       } { exit } ifelse        } { } ifelse
         ob isClass , ob isArray or { } { exit } ifelse
       ob 0 get key eq {        ob 0 get key eq {
         /rr ob def          /rr ob def
         exit          exit
Line 4178  $ [ff ff] fromVectors :: $ 
Line 4195  $ [ff ff] fromVectors :: $ 
   arg1    arg1
 } def  } def
 [(getNode)  [(getNode)
 [(ob key getNode)  [(ob key getNode node-value)
  (ob is a class object.)   (ob is a class object or an array.)
  (The operator getNode returns the node with the key in ob.)   (The operator getNode returns the node with the key in ob.)
  (The node is an array of the format [key attr-list node-list])   (When ob is a class, the node is an array of the format [key attr-list node-list])
    (When ob is an array, the node is a value of key-value pairs.)
  (Example:)   (Example:)
  (  /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)   (  /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)
  (  /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)   (  /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)
  (  /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)   (  /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)
  (  ma (dog) getNode )   (  ma (dog) getNode )
    (Example 2:)
    ( [ [1 ] [2 3] [[(dog) 2]]] (dog) getNode ::)
 ]] putUsages  ]] putUsages
   
 /cons {  /cons {
Line 4252  $ [ff ff] fromVectors :: $ 
Line 4272  $ [ff ff] fromVectors :: $ 
 [(list listToArray a)  [(list listToArray a)
 ]] putUsages  ]] putUsages
   
 /makeInfix {  % Body is moved to smacro.sm1
   [(or_attr) 4   4 -1 roll ] extension  
 } def  
 [(makeInfix)  [(makeInfix)
 [(literal makeInfix)  [(literal makeInfix)
  (Change literal to an infix operator.)   (Change literal to an infix operator.)
Line 4273  $ [ff ff] fromVectors :: $ 
Line 4291  $ [ff ff] fromVectors :: $ 
     {  % begin loop      {  % begin loop
   
        name isArray {         name isArray {
          /ukeys @.usages { 0 get } map def           /ukeys @.usages { 0 get } map shell def
          name { /key set [(regexec) key ukeys] extension           name { /key set [(regexec) key ukeys] extension
                 { 0 get } map } map /sss set                  { 0 get } map } map /sss set
          exit           exit
Line 4322  $ [ff ff] fromVectors :: $ 
Line 4340  $ [ff ff] fromVectors :: $ 
   (num usages list-of-key-words)    (num usages list-of-key-words)
   ([key1 key2 ... ] usages list-of-key-words  : it accepts regular expressions.)    ([key1 key2 ... ] usages list-of-key-words  : it accepts regular expressions.)
 ]] putUsages  ]] putUsages
   
   /setMinus {
     /arg2 set /arg1 set
     [/aa /bb /i ] pushVariables
     [
       /aa arg1 def /bb arg2 def
       [
         0 1 aa length 1 sub {
           /i set
           aa i get bb memberQ {
           } { aa i get } ifelse
         } for
       ] /arg1 set
     ] pop
     popVariables
     arg1
   } def
   [(setMinus)
   [(a b setMinus c)
   ]] putUsages
   
   % Define  some infix operators
   /~add~ { add } def /~add~ makeInfix
   /~sub~ { sub } def /~sub~ makeInfix
   /~mul~ { mul } def /~mul~ makeInfix
   /~div~ { div } def /~div~ makeInfix
   /~power~ { power } def /~power~ makeInfix
   /~put~ {
     dup tag 3 eq { exec } {  } ifelse  put
   } def
   /~put~ makeInfix
   
   
 ;  ;
   
Legend:
Removed from v.1.40  
changed lines
  Added in v.1.46
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>