#823. DSL hardcore

Original in Russian: http://18delphi.blogspot.ru/2013/04/dsl.html

Some people concentrate on “code self-descriptiveness”. They are quite right. I have not yet thought up ways or recommendations which I could describe. I can only say trivial things like "the function name has to represent what it does".

I will give practical findings on the topic.

There is a file below that parses the input stream and composes the other one. (Full text is here - https://www.box.com/s/p7dzynlw7d9klk2gwez1)

Since it is kind of “self-descriptive”, I’ll reserve my comments.

USES
 'W:\shared\models\NewSchool\Templates\MDATuning.tpl.script'
; 

: "Do nothing"
; // "Do nothing"

: log
 .
 //DROP
; // log

WORDWORKER "begins with" W-STRING IN aStr
 WordToWork DO aStr WString:Starts
; // "begins with"

// InitedVarProducer VAR-I

: "Parse MDA templates"

 ARRAY "Processed files"

 FORWARD "Process file"

 : "Process file" STRING IN "Input the file name"

  "Processed files" "Input the file name" array:HasText ? (
   [[ 'duplicated: ' "Input the file name" ' skipped' ]] strings:Cat log
   EXIT
  ) // "Processed files" "Input the file name" array:HasString ?
  
  "Input the file name" >>>[] "Processed files"

  STRING VAR "Input the file path"
  "Input the file name" sysutils:ExtractFilePath =: "Input the file path"
  "Input the file path" log

  VAR "Output the file name" 
  "Input the file name" '.script' Cat =: "Output the file name"
  
  CONST "Space" ' '
  CONST "Blank string" ''
  CONST "Quote" ''''
  CONST "Opening bracket" '('
  CONST "Closing bracket" ')'
  CONST "Comma" ','
  CONST "Per cent mark" '%'
  CONST "Special symbols" '\%[]{}<>#()'
  CONST "Numbers" '1234567890'
  CONST "Separation symbol for stereotype parts" '::'
  
  STRING VAR "Disc name"
  "Output the file name" sysutils:ExtractFileDrive =: "Disc name"
  
  '\' string:SplitTo! "Output the file name"
  "Disc name" ?== 'Disc name not defined in file name' ASSERTS
  
  [[ "Disc name" '\NewSchool\' "Output the file name" ]] strings:Cat =: "Output the file name"
  
  "Output the file name" log
  
  STRING VAR "Output the file path"
  "Output the file name" sysutils:ExtractFilePath =: "Output the file path"
  "Output the file path" log
  
  "Output the file path" sysutils:ForceDirectories 'Failed to create directories' ASSERTS
  
  //script:FileName sysutils:ExtractFileName "Blank string"  "Space" Cat "Output the file name" sysutils:ExtractFileName Cat =: "Output the file name"
  
  FILE VAR "Input the file"
  "Input the file name" file:OpenRead =: "Input the file"
  TRY
   FILE VAR "Output the file"
   "Output the file name" file:OpenWrite =: "Output the file"
   TRY
   
    W-STRING VAR "Current string of the input file"
    
    : "Blank string"
     "Current string of the input file" WString:IsNil
    ; // "Blank string"
    
    WORDWORKER "string begins with"
     VAR l_Begin
     WordToWork DO =: l_Begin
     "Current string of the input file" "begins with" l_Begin
    ; // "string begins with"
   
    WORDWORKER "string equals"
     VAR l_EQ
     WordToWork DO =: l_EQ
     "Current string of the input file" l_EQ ?==
    ; // "String begins with"
    
     BOOLEAN VAR "Storing Blank string"
     BOOLEAN VAR "Quote added"
      
     : "Output the string"
      "Output the file" file:WriteStr
     ; // "Output the string"
    
     : "Output the quote"
      "Quote" "Output the string"
     ; // "Output the quote"
     
     : "Close the quote, if there was one"
      "Quote added" ? (
       "Output the quote"
       false =: "Quote added"
      ) // "Quote added" ?
     ; // "Close the quote, if there was one"
      
     : "Output Space"
      "Space" "Output the string"
     ; // "Output Space"
     
     : "Reset stored string without skipping"
      "Storing Blank string" ! ? (
      
       "Close the quote, if there was one"
        
       "Output Space" 
       true =: "Storing blank string"
       false =: "Quote added"
      ) // "Storing string" string:Len !=0 ?
     ; // "Reset stored string without skipping"
     
     BOOLEAN VAR "Space added"
     
     : "Skip the string"
      "Close the quote, if there was one"
      "Blank string" "Output the file" file:WriteLn
      false =: "Space added"
      "Quote added" ! 'Quote appears to be not closed' ASSERTS 
      //false =: "Quote added"
     ; // "Skip the string"
     
     : "Reset stored string"
      "Storing blank string" ! ? (
      
       "Close the quote, if there was one"
        
       "Skip the string"
       true =: "Storing blank string"
      ) // "Storing string" string:Len !=0 ?
     ; // "Reset stored string"
     
     : "Reset stored string, so Quote does not move to the other string by accident"
      "Reset stored string"
     ; // "Reset stored string, so Quote does not move to the other string by accident"
      
     : "Output the string unchanged"
      "Current string of the input file" "Output the file" file:WriteWStrLn
     ; // "Output the string unchanged"
     
     : "Add to string / and Output"
      "Reset stored string, so Quote does not move to the other string by accident"
      '/' "Output the string"
      "Output the string unchanged"
     ; // "Add to string / and Output"
     
     : "Output the string as a commentary so to compare in the resulting file"
      "Reset stored string, so Quote does not move to the other string by accident"
      "Space added"  ? "Skip the string"
      '//' "Output the string"
      "Output the string unchanged"
      false =: "Space added"
     ; // "Output the string as a commentary so to compare in the resulting file"
     
     BOOLEAN VAR "Stereotype opened" 
      false =: "Stereotype opened"
     STRING VAR "Stereotype name"
      "Blank string" =: "Stereotype name" 
     STRING VAR "Stereotype class name"
      "Blank string" =: "Stereotype class name" 
     STRING VAR "Substereotype name"
      "Blank string" =: "Substereotype name" 
     STRING VAR "Substereotype class name"
      "Blank string" =: "Substereotype class name" 
     STRING VAR "Sub-substereotype name"
      "Blank string" =: "Sub-substereotype name" 
     STRING VAR "Sub-substereotype class name"
      "Blank string" =: "Sub-substereotype class name"
     
     BOOLEAN VAR "Function opened"
      false =: "Function opened" 
     STRING VAR "Function name"
      "Blank string" =: "Function name"
     BOOLEAN VAR "Transformer opened"
      false =: "Transformer opened" 
     STRING VAR "Transformer name"
      "Blank string" =: "Transformer name"
     
     BOOLEAN VAR "Generator opened"
      false =: "Generator opened"
     STRING VAR "Generator name"
      "Blank string" =: "Generator name"
     
     CONST Separation symbols ' '
     CONST "Double Quote" '"'
     CONST "Self parameter" ' OBJECT IN %S'
     CONST "Function closing bracket" '; // '
     CONST "Open the stereotype bracket" '<<'
     CONST "Close the stereotype bracket" '>>'
     CONST "Tabulation" #9
     
     : "Output the string with skipping"
      "Output the string"
      "Skip the string"
     ; // "Output the string with skipping"
     
     : "Output source string"
      "Current string of the input file" "Output the file" file:WriteWStr
     ; // "Output source string"
     
     : "Write Stereotype name"
      "Substereotype name" string:Len !=0 IF
       ':: ' "Output the string"
       "Stereotype name" "Output the string"
       "Space" "Output the string"
       "Substereotype name" "Output the string"
       
       "Sub-substereotype name" string:Len !=0 IF
        "Space" "Output the string"
        "Sub-substereotype name" "Output the string"
       ENDIF // "Sub-substereotype name" string:Len !=0 IF
       
       ' ;' "Output the string"
       
      ELSE
       "Stereotype name" "Output the string"
      ENDIF //  "Substereotype name" string:Len !=0
      "Skip the string"
     ; // "Write Stereotype name"
     
     : "Write Function name"
      "Function name" "Output the string"
     ; // "Write Function name"
     
     : "Write Transformer name"
      "Transformer name" "Output the string"
     ; // "Write Transformer name"
     
     : "Write Generator name"
      "Generator name" "Output the string"
     ; // "Write Generator name"
     
     FORWARD "Close nested definitions"
     
     : "Close the stereotype"
      "Stereotype opened" ?
       ( 
        "Close nested definitions"
        'end. // ' "Output the string" 
        "Write Stereotype name"
        "Skip the string"
       ) // "Stereotype opened" ?
      false =: "Stereotype opened"
     ; // "Close the stereotype"
     
     INTEGER VAR "Space"
     INTEGER VAR "Number of opened IF"
     INTEGER VAR "Number of opened cycles"
     INTEGER VAR "Number of opened brackets of function parameters"
      
     : "Close all brackets"
      0 =: "Space"
      0 =: "Number of opened IF"
      0 =: "Number of opened cycles"
      0 =: "Number of opened brackets of function parameters"
      "Close nested definitions"
      "Close the stereotype"
     ; // "Close all brackets"
     
     : "Quote Stereotype name"
      Separation symbols "Stereotype name" string:HasAnyOf ? (
       [[ "Double Quote" "Stereotype name" "Double Quote" ]]
        strings:Cat =: "Stereotype name"
      )
     
      "Stereotype class name" 'MDAGenerator' ?!= ? (
       [[ "Open the stereotype bracket" "Stereotype name" "Close the stereotype bracket" ]] 
        strings:Cat =: "Stereotype name"
      )
     ; // "Quote Stereotype name"
     
     : "Quote Substereotype name"
      "Substereotype name" string:Len !=0 ? (
       Separation symbols "Substereotype name" string:HasAnyOf ? (
        [[ "Double Quote" "Substereotype name" "Double Quote" ]]
         strings:Cat =: "Substereotype name"
       ) // Separation symbols "Substereotype name" string:HasAnyOf ?
      
       // "Stereotype class name" 'MDAGenerator' ?!= 
       true ? (
        [[ "Open the stereotype bracket" "Substereotype name" "Close the stereotype bracket" ]] 
         strings:Cat =: "Substereotype name"
       ) // true ?
      ) // "Substereotype name" string:Len !=0 ?
     ; // "Quote Substereotype name"
     
     : "Open the stereotype"
      "Stereotype opened" ! ? (
        'implementation @ ' "Output the string"
        
        "Write Stereotype name"
        true =: "Stereotype opened"
      ) // "Stereotype opened" !
     ; // "Open the stereotype"
     
     : "Parse the header of stereotype"
     
      "Close the stereotype"
      
      2 WString:+! "Current string of the input the file"
      "Current string of the input file" WString:ToString =: "Stereotype name"
      
      "Stereotype name" "Separation symbol for stereotype parts" string:Split
      
      =: "Stereotype class name"
      =: "Stereotype name"
      
      "Stereotype class name" "Separation symbol for stereotype parts" string:Split
      =: "Substereotype name"
      =: "Stereotype class name"
      
      "Substereotype name" "Separation symbol for stereotype parts" string:Split
      =: "Substereotype class name"
      =: "Substereotype name"
      
      "Substereotype class name" "Separation symbol for stereotype parts" string:Split
      =: "Sub-substereotype name"
      =: "Substereotype class name"
      
      "Quote Stereotype name"
      "Quote Substereotype name"
      
      "Open the stereotype"
      
     ; // "Parse the header of stereotype"
     
     : "Close function"
      "Function opened" ? ( "Function closing bracket" "Output the string" "Write function name" 
      "Skip the string"
      "Skip the string"
      )
      false =: "Function opened"
     ; // "Close function"
     
     : "Close transformer"
      "Transformer opened" ? ( "Function closing bracket" "Output the string" "Write transformer name" 
      "Skip the string"
      "Skip the string"
      )
      false =: "Transformer opened"
     ; // "Close transformer"
     
     : "Close generator"
      "Generator opened" ? ( "Function closing bracket" "Output the string" "Write generator name" 
      "Skip the string"
      "Skip the string"
      )
      false =: "Generator opened"
     ; // "Close generator"
     
//     : "Any nested definition opened"
//      "Function opened" %|| 
//      "Transformer opened" %|| 
//      "Generator opened"
//     ; // "Any nested definition opened"
     
     : "Close nested definitions"
      "Close generator"
      "Close function"
      "Close transformer"
      false =: "Space added"
     ; // "Close nested definitions"
     
     : "Write the function parameters" BOOLEAN IN aGlobal
      "Self parameter" "Output the string"
     ; // "Write the function parameters"
     
     : "Write the transformer parameters" BOOLEAN IN aGlobal
      "Self parameter" "Output the string"
     ; // "Write the transformer parameters"
     
     : "Parse the header of the function" BOOLEAN IN aGlobal
      "Close nested definitions"
      aGlobal IF
       "Close the stereotype"
      ELSE
       "Open the stereotype"
      ENDIF 
      
      aGlobal IF
       2 WString:+! "Current string of the input file"
       // - cut f
      ELSE 
       3 WString:+! "Current string of the input file"
       // - cut %f
      ENDIF
       
      "String begins with" '_' ? WString:++! "Current string of the input file"
      // - cut underlining
      "Current string of the input file" WString:ToString =: "Function name"
      // - get the name of the current function
      
      ': ' "Output the string"
      "Write Function name"
      
      aGlobal "Write the function parameters"
      
      "Skip the string"
      
      true =: "Function opened"
     ; // "Parse the header of the function"
     
     : "Parse the header of the transformer" IN aGlobal
      "Close nested definitions"
      aGlobal IF
       "Close the stereotype"
      ELSE
       "Open the stereotype"
      ENDIF 
      
      aGlobal IF
       2 WString:+! "Current string of the input file"
       // - cut t
      ELSE 
       3 WString:+! "Current string of the input file"
       // - cut %t
      ENDIF
       
      "string begins with" '_' ? WString:++! "Current string of the input file"
      // - cut underlining
      "Current string of the input file" WString:ToString =: "Transformer name"
      // - get the name of the current transformer
      
      '<> ' "Output the string"
      "Write Transformer name"
      
      aGlobal "Write the transformer parameters"
      
      "Skip the string"
      
      true =: "Transformer opened"
     ; // "Parse the header of the transformer"
     
     : "Parse the header of the stereotype function"
      false "Parse the header of the function"
     ; // "Parse the header of the stereotype function"
     
     : "Parse the header of the global function"
      true "Parse the header of the function"
     ; // "Parse the header of the global function"
     
     : "Parse the header of the stereotype transformer"
      false "Parse the header of the transformer"
     ; // "Parse the header of the stereotype transformer"
     
     : "Parse the header of the global transformer"
      true "Parse the header of the transformer"
     ; // "Parse the header of the global transformer"
     
     : "Write generator parameters"
      "Self parameter" "Output the string"
     ; // "Write generator parameters"
     
     : "Parse the header of the generator"
      "Close nested definitions"
      
      2 WString:+! "Current string of the input file"
      "Current string of the input file" WString:ToString =: "Generator name"
      
      "Open the stereotype"
      
      '<> ' "Output the string"
      "Write Generator name"
      
      "Write generator parameters"
      
      "Skip the string"
      
      true =: "Generator opened"
     ; // "Parse the header of the generator"
     
     BOOLEAN FUNCTION "Process meaningless strings" BOOLEAN IN "String skipping needed"
     
      : "Output the commentary from the source file"
       "Reset stored string, so Quote does not move to the other string by accident"
       "String skipping needed" IF
        "Skip the string"
       ELSE
        "Space added"  ? "Skip the string"
       ENDIF // "String skipping needed"
       "Output the string unchanged"
      ; // "Output the commentary from the source file"
     
      : "Indicate the failure"
       false =: Result
      ; // "Indicate the failure"
      
      true =: Result
      // - let’s be optimistic
      RULES
       "Blank string"
        ( 
         "Close the quote, if there was one"
         "String skipping needed" ? "Skip the string"
         "Output the string unchanged"
        ) // "Blank string"
       "string begins with" '//#UC END# *'
        (
         "Output the commentary from the source file"
         "Close nested definitions"
          // - since, most probably, function, transformer or generator ended
        ) 
       "String begins with" '//'
        "Output the commentary from the source file"
       "String begins with" '/'
        (
         "String skipping needed" ? "Skip the string"
         "Add to string / and Output"
        ) // "String begins with" '/'
       DEFAULT
        "Indicate the failure"
      ; // RULES
     ; // "Process meaningless strings"
     
     : "Process meaningless strings without skipping the previous string"
      false "Process meaningless strings"
     ; // "Process meaningless strings without skipping the previous string"

Full text is here - https://www.box.com/s/p7dzynlw7d9klk2gwez1

I do not insist on using it all “cut and dried”, moreover, made by me, it would not be requested. I only try to share one of the possible approaches to the “self-descriptive code” and using languages oriented to the domain areas of the solved problems (DSL) instead of high-level general-purpose languages.

Try to think in this string. May be you will like it.

Corresponding topic - http://18delphi.blogspot.com/2013/04/forth-vs-lisp.html