Populate Semantic Model, using oMeta in ABAP

*&---------------------------------------------------------------------*
*& Report  Z_SEMANTIC_MODEL_EXAMPLE
*&
*& Populating the semantic model from a rule, entered as text
*& In this case, the resulting model will be a template
*&
*& The "real" pallets then can be filled by processing the template
*&
*& Requires oMeta Core (subroutine pool Z_OMETA_BASE)
*& See http://pastebin.com/hunE6vsy (self contained)
*&
*&---------------------------------------------------------------------*

report  z_semantic_model_example.

* ----------------------------------------------------------------------
* Definition of the semantic model:
* A pallet can be filled with deliveries and/or other pallets
* The resulting data structure consists of
* - A table DELIVERY_NUMBERS of placeholder id's for all deliveries in use
* - A table PALLET_NUMBERS of placeholder id's  for all pallets in use
* - A table PALLETS containing the pallet contents
* ----------------------------------------------------------------------
types:

  ty_doc_number(10) type c,
  ty_item_number(6) type c,
  ty_pallet_item_type(2) type c,
  ty_doc_numbers type standard table of ty_doc_number with non-unique default key,

  begin of ty_pallet_item,
      pallet_no   type ty_doc_number,
      item_no     type ty_item_number,
      type        type ty_pallet_item_type,
      content     type ty_doc_number,
    end of ty_pallet_item,
  ty_pallets type standard table of ty_pallet_item
    with key pallet_no item_no,

   begin of ty_model,
    pallet_numbers    type ty_doc_numbers,
    delivery_numbers  type ty_doc_numbers,
    pallets           type ty_pallets,
  end of ty_model.

constants: begin of gc_pallet_item_type,
  pallet   type ty_pallet_item_type value 'PA',
  delivery type ty_pallet_item_type value 'DL',
end of gc_pallet_item_type.
* ----------------------------------------------------------------------

* A "Stop" signal
class lcx_end_program definition final inheriting from cx_no_check.
endclass.                    "lcx_end_program DEFINITION

load-of-program.
  perform on_load.

start-of-selection.
  perform start.

* ---
form start.

  data: lv_rule type string,
        ls_model type ty_model,
        lv_parse_errors type flag value abap_undefined.

  try.

      while lv_parse_errors ne abap_false.

        perform input_rule
          changing lv_rule.

        perform rule_to_model
          using lv_rule
          changing ls_model lv_parse_errors.

      endwhile.

      perform output_model
        using ls_model.

    catch lcx_end_program.
  endtry.

endform.                    "start


* --- Apply parser to input, populating the semantic model
form rule_to_model using iv_rule type string
                   changing es_model type ty_model
                            ev_parse_errors type flag.

  data: lv_error_code type i,
        lv_result type string.

  clear es_model.

* Bind the semantic model
  perform bind(z_ometa_base)
    using 'pallets.model' es_model.

* Execute the parser
  perform match(z_ometa_base)
    using 'HandlingUnitDefinition' 'expr' iv_rule
    changing lv_result lv_error_code.

  if lv_error_code <> 0.
    ev_parse_errors = abap_true.
    message 'The rule entered is syntactically incorrect' type 'I'.
  else.
    ev_parse_errors = abap_false.
    perform normalize_model changing es_model.
  endif.

endform.                    "rule_to_tree

* ---
form normalize_model changing cs_model type ty_model.

* We would prefer sorted tables with unique key,
* but JS/ABAP binding currently only allows standard tables
* Therefore, sort by hand

  sort: cs_model-pallets,
        cs_model-delivery_numbers,
        cs_model-pallet_numbers.
  delete adjacent duplicates from :
        cs_model-delivery_numbers,
        cs_model-pallet_numbers.

endform.                    "normalize_model

* ---
form output_model using is_model type ty_model.

  call function 'RS_COMPLEX_OBJECT_EDIT'
    exporting
      object_name          = 'SEMANTIC MODEL'
      mode                 = ' '
    changing
      object               = is_model
    exceptions
      object_not_supported = 1
      others               = 2.
  if sy-subrc <> 0.
    message id sy-msgid type 'I' number sy-msgno
      with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  endif.


endform.                    "output_model

* ---
form on_load.
  try.
      perform set_parser.
    catch lcx_end_program.
      leave program.
  endtry.
endform.                    "on_load

* ---
form set_parser.

  data: lv_grammar type string,
        lv_result type string,
        lv_error_code type i.

  perform get_grammar_as_string changing lv_grammar.
  perform set_builder.
  perform translate(z_ometa_base)
    using lv_grammar
    changing lv_result lv_error_code.
  perform check_error using 'set parser' lv_error_code.

endform.                    "set_parser

* ---
form check_error using iv_step type string
                       iv_error_code type i.
  data: lv_error type string.
  if iv_error_code <> 0.
    perform get_last_error(z_ometa_base) changing lv_error.
    concatenate `Error in step '` iv_step `': `  lv_error
      into lv_error respecting blanks.
    message lv_error type 'I' display like 'I'.
    raise exception type lcx_end_program.
  endif.
endform.                    "check_error

* --- Helper functions for the semantic actions
form set_builder.

  data: lv_build type string,
        lv_result type string,
        lv_error_code type i.

* Passing the relevant parts of the input to the model
* It is here where the ABAP/JS binding syntax (proxy objects) is required
  concatenate
    `function addDelivery(n) {`
    `  return addDocNumber(pallets.model.delivery_numbers,"DL"+n);`
    `  }`
    `function addPallet(n) {`
    `  return addDocNumber(pallets.model.pallet_numbers,"PA"+n);`
    `  }`
    `function buildPallet( id, content ) {`
    `  var p = pallets.model.pallets;`
    `  var wa, i;`
    `  for (i=0;i<content.length;i++) {`
    `    p.appendLine();`
    `    wa = p[p.length-1];`
    `    wa.pallet_no = id;`
    `    wa.item_no = i+1;`
    `    wa.type = content[i].substring(0,2);`
    `    wa.content = content[i];`
    `    }`
    ` return id;`
    ` }`
    `function addDocNumber(table,id) {`
    `  table.appendLine(); `
    `  table[table.length-1] = id;`
    `  return id;`
    `  }`
    into lv_build
    separated by cl_abap_char_utilities=>cr_lf.

  perform do_it(z_ometa_base) using lv_build changing lv_result lv_error_code.
  perform check_error using 'set builder' lv_error_code.

endform.                    "set_builder

* ---
form input_rule changing ev_rule type string.

  data: lt_text type jstexttab.

* Memorize last input (for the error case)
  statics: st_last_text type jstexttab.

  field-symbols: <lv_text> type c.

  if st_last_text is not initial.
    lt_text = st_last_text.
  else.
    perform get_rule_proposal changing lt_text.
  endif.

* Enter the packing rule in a free text window
  call function 'TERM_CONTROL_EDIT'
    exporting
      titel          = 'Please enter rule'
    tables
      textlines      = lt_text
    exceptions
      user_cancelled = 1
      others         = 2.
  if sy-subrc <> 0.
    if sy-msgid ne space.
      message id sy-msgid type 'I' number sy-msgno
        with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    endif.
    raise exception type lcx_end_program.
  endif.

  st_last_text = lt_text.

* Map table to string
  clear ev_rule.
  loop at lt_text assigning <lv_text>.
    if ev_rule is initial.
      ev_rule = <lv_text>.
    else.
      concatenate ev_rule <lv_text> into ev_rule
        separated by cl_abap_char_utilities=>cr_lf.
    endif.
  endloop.

* Ignore packing rules containing only whitespace
  find regex '\S' in ev_rule.
  if sy-subrc ne 0.
    raise exception type lcx_end_program.
  endif.

endform.                    "input_rule

* --- Some lines of oMeta code,
*     defining the syntax AND semantics
form get_grammar_as_string changing ev_grammar type string.

  concatenate
    `ometa HandlingUnitDefinition <: Parser {`
    `  expr      = fullPallet+,      `
    `  delivery  = ordnum:n ( "Lieferung" | "Lief" | "LF"  )`
    `          -> {addDelivery(n)},`
    `  pallet  = ordnum:n ( "Palette"  | "Pal" | "SSCC" )`
    `          -> {addPallet(n)},`
    `  fullPallet  = pallet:s "(" content:c ")"`
    `          -> { buildPallet( s, c ) },`
    `  contentPart = fullPallet | delivery | pallet,`
    `  content = (spaces contentPart)*:xs, `
    `  ordnum  = spaces digit+:ds "." -> parseInt(ds.join(''))`
    `  }`
    into ev_grammar
    separated by cl_abap_char_utilities=>cr_lf.

endform.                    "get_grammar_as_string

* --- Just a proposal for the text popup
form get_rule_proposal changing ct_text type jstexttab.
  define _add_line.
    append &2 to &1.
  end-of-definition.

  _add_line ct_text :
    `1. Palette (`,
    `  1. Lieferung`,
    `  2. Palette`,
    `  )`,
    `2. Palette (`,
    `  2. Lieferung`,
    `  3. Palette ( 3. Lieferung )`,
    `  )`.

endform.                    "get_rule_proposal