Registration

Dear SAP Community Member,
In order to fully benefit from what the SAP Community has to offer, please register at:
http://scn.sap.com
Thank you,
The SAP Community team.
Skip to end of metadata
Go to start of metadata

Author: JNN
Submitted: 28.07.2015
Related Links:

Lambda the Ultimate

Lispers go gaga over lambda, the fundamental command in a Lisp system (Conrad Barski's Land of LISP chapter 6.5). When Martin Ceronio published a LISP interpreter in ABAP I was curious to understand code evaluation. After converting the tests to an automated regression suite in ABAP Unit , I could safely explore the code. I learned more about Scheme (now we have a symbol for false #f that is not nil) and ended up with the following additions:

  • more validation to avoid dumps from incorrect syntax
  • a workbench that makes it easier to play with the interpreter
  • Comments using the ; delimiter
  • native operations: set!, let (no named let yet), let*, letrec, cond, and, or, reverse, append!
  • predicates: number? string? symbol? hash? procedure? list? zero? positive? negative? odd? even? eq?
  • trigonometric functions: sin cos tan sinh cosh tanh asin acos atan asinh acosh atanh
  • math: quotient remainder modulo abs floor ceiling truncate round expt exp sqrt
  • display / newline - are not working properly yet

The original functions:

FunctionArgumentsFirst-class*Description
+, -, *, /1-nYesBasic arithmetic functions
appendnYesCreates a new list by append the last element to the concatenation of all previous lists
list1-nYesMakes a list out of all given arguments
length1YesLength of the given list
car1YesReturns the first item in a list, or nil given an empty list (or nil)
cdr1YesReturns the tail of a list, which will be a list, or nil, given an empty list (or nil)
cons2YesConstructs a new list, making the first element the head and the second input (usually a list) the tail (like prepending, almost)
nil?, null?1YesTests if the input is nil or not (null? is an alias added for compatibility with Scheme-based tests)
>, >=, <, <=1-nYesComparison operators
equal?2YesTests if the given arguments are equal (either by symbol or number) or, in the case of a list, whether it is the same list.
quote1NoReturns the argument verbatim, without evaluating it
if2-3NoEvaluates the first argument. If true, the second argument is evaluated. If not, a third argument is evaluated, otherwise nil (false) is returned
define2No

(define <variable> <expression>) binds one identifier to an expression. (define (<variable>> <formal>) <body>) defines a function

lambda2NoDefines an anonymous function; first input is a list of formal parameters; second is the body to be evaluated
begin0-nNoEvaluates all arguments as expressions in turn; a nice way to string a lot of expressions together to be executed
and0-nNo 
or0-nNo 
set!1No 


There are many ways to improve, a challenge would be a simple macro system that can do define-syntax.

How to implement Workbench

Double click on the source to select, then copy and paste to generate the report ZZ_LISP_IDE from the sources

    • Report ZZ_LISP_IDE - Main report
    • Include YY_LIB_LISP - Custom version of ABAP LISP
    • Include YY_LISP_AUNIT - ABAP Unit tests

Create an empty screen 0100, then define the OK code

    • G_OK_CODE

and the flow logic:

Error rendering macro 'code': Invalid value specified for parameter 'lang'
PROCESS BEFORE OUTPUT.
MODULE status_0100.

PROCESS AFTER INPUT.
MODULE cancel_0100 AT EXIT-COMMAND.
MODULE user_command_0100.

Create a GUI Status STATUS_100 with

Application Toolbar

    • EXECUTE - Execute / Evaluate - F8 - ICON_EXECUTE_OBJECT
    • CLEAR - Delete / Delete Source - Shift-F2 - ICON_REFRESH

Function Keys

    • BACK (F3) Exit-Command
    • EXIT (Shift-F3) Exit-Command
    • CANCEL (F12) Exit-Command

Create a GUI Title
TITLE_100 - ABAP LISP Workbench

Activate and try it out!

Error rendering macro 'code': Invalid value specified for parameter 'lang'
REPORT zz_lisp_ide.

INCLUDE yy_lib_lisp.
INCLUDE yy_lisp_aunit.

*----------------------------------------------------------------------*
*       CLASS lcl_container DEFINITION
*----------------------------------------------------------------------*
CLASS lcl_container DEFINITION.
  PUBLIC SECTION.
    METHODS constructor.
    METHODS free_controls.
    DATA mo_input TYPE REF TO cl_gui_container READ-ONLY.
    DATA mo_output TYPE REF TO cl_gui_container READ-ONLY.
    DATA mo_log TYPE REF TO cl_gui_container READ-ONLY.
    DATA mo_alv TYPE REF TO cl_gui_container READ-ONLY.
  PRIVATE SECTION.
    DATA mo_splitter_h TYPE REF TO cl_gui_splitter_container.
    DATA mo_splitter_v TYPE REF TO cl_gui_splitter_container.
    DATA mo_splitter_v_h TYPE REF TO cl_gui_splitter_container.
    DATA mo_left TYPE REF TO cl_gui_container.
    DATA mo_right TYPE REF TO cl_gui_container.
ENDCLASS.                    "lcl_container DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_editor DEFINITION
*----------------------------------------------------------------------*
CLASS lcl_editor DEFINITION INHERITING FROM cl_gui_textedit.
  PUBLIC SECTION.
    CONSTANTS c_comments_string TYPE char01 VALUE ';'.

    METHODS constructor IMPORTING io_container TYPE REF TO cl_gui_container
                                  iv_read_only TYPE flag DEFAULT abap_true
                                  iv_toolbar TYPE flag DEFAULT abap_false.
    METHODS append_source IMPORTING iv_text TYPE string.
    METHODS append_to IMPORTING io_editor TYPE REF TO lcl_editor.
    METHODS to_string RETURNING value(rv_text) TYPE string.
    METHODS update_status IMPORTING iv_string TYPE string.
    METHODS append_string IMPORTING iv_text TYPE string.
  PRIVATE SECTION.
    DATA mv_counter TYPE i.

    METHODS format_input IMPORTING code TYPE string
                         RETURNING value(rv_text) TYPE string.
ENDCLASS.                    "lcl_editor DEFINITION

*----------------------------------------------------------------------*
*       INTERFACE lif_unit_test IMPLEMENTATION
*----------------------------------------------------------------------*
INTERFACE lif_unit_test.
ENDINTERFACE.                    "lif_unit_test IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_ide DEFINITION
*----------------------------------------------------------------------*
CLASS lcl_ide DEFINITION CREATE PRIVATE.
  PUBLIC SECTION.
    CLASS-METHODS: main,
      free,
      pbo,
      pai IMPORTING iv_code        TYPE syucomm
          RETURNING value(rv_flag) TYPE flag.
    METHODS first_output.

    INTERFACES lif_port.
  PRIVATE SECTION.
    CLASS-DATA go_ide TYPE REF TO lcl_ide.
    DATA mv_first TYPE flag VALUE abap_true.
    DATA mo_cont TYPE REF TO lcl_container.
    DATA mo_int TYPE REF TO lcl_lisp_profiler. "The Lisp interpreter

    DATA mo_source TYPE REF TO lcl_editor.
    DATA mo_output TYPE REF TO lcl_editor.
    DATA mo_log TYPE REF TO lcl_editor.
    DATA mo_alv TYPE REF TO cl_salv_table.

    METHODS:
      constructor,
      evaluate,
      refresh,
      free_controls,
      user_command IMPORTING iv_code        TYPE syucomm
                   RETURNING value(rv_flag) TYPE flag.
    METHODS welcome RETURNING value(text) TYPE string.

ENDCLASS.                    "lcl_ide DEFINITION

DATA g_ok_code TYPE syucomm.

START-OF-SELECTION.
  lcl_ide=>main( ).

*----------------------------------------------------------------------*
*       CLASS lcl_ide IMPLEMENTATION
*----------------------------------------------------------------------*
CLASS lcl_ide IMPLEMENTATION.

  METHOD constructor.
    CREATE OBJECT:
      mo_cont,

      mo_source
        EXPORTING
          io_container = mo_cont->mo_input
          iv_read_only = abap_false
          iv_toolbar = abap_true,
      mo_output
        EXPORTING
          io_container = mo_cont->mo_output
          iv_toolbar = abap_true,
      mo_log
        EXPORTING
          io_container = mo_cont->mo_log.
    refresh( ).
  ENDMETHOD.                    "constructor

  METHOD main.
    CREATE OBJECT go_ide.
    CALL SCREEN 100.
  ENDMETHOD.                    "main

  METHOD refresh.
    mo_source->delete_text( ).
    mo_output->delete_text( ).
    mo_log->delete_text( ).
    CREATE OBJECT mo_int   " LISP Interpreter
      EXPORTING ii_port = me.
  ENDMETHOD.                    "refresh

  METHOD lif_port~write.
    FIELD-SYMBOLS <lt_table> TYPE STANDARD TABLE.
    DATA lx_error TYPE REF TO cx_root.
    DATA lo_functions TYPE REF TO cl_salv_functions.

    CASE element->type.
      WHEN lcl_lisp=>type_abap_table.
        TRY.
            ASSIGN element->data->* TO <lt_table>.
            cl_salv_table=>factory(
              EXPORTING r_container    = mo_cont->mo_alv
              IMPORTING r_salv_table   = mo_alv
              CHANGING  t_table        = <lt_table> ).

            lo_functions = mo_alv->get_functions( ).
            lo_functions->set_all( abap_true ).
            mo_alv->display( ).

          CATCH cx_root INTO lx_error.
            lcl_lisp=>throw( lx_error->get_text( ) ).
        ENDTRY.

      WHEN OTHERS.
    ENDCASE.
  ENDMETHOD.                    "lif_console~write

  METHOD welcome.
    text = |==> Welcome to ABAP List Processing!\n|.
  ENDMETHOD.                    "welcome

  METHOD first_output.
    CHECK mv_first EQ abap_true.
    CLEAR mv_first.
    cl_gui_textedit=>set_focus( mo_source ).
    mo_log->append_string( |{ welcome( ) }\n| ).
  ENDMETHOD.                    "first_output

  METHOD evaluate.
    DATA code TYPE string.
    DATA response TYPE string.
    DATA lx_root TYPE REF TO cx_root.

    TRY.
        code = mo_source->to_string( ).
        response = mo_int->eval_repl( code ).

        mo_output->append_source( code ).

        mo_source->delete_text( ).
        mo_source->update_status( |[ { mo_int->runtime } µs ] { response }| ).

      CATCH cx_root INTO lx_root.
        response = lx_root->get_text( ).
        mo_source->update_status( |{ response }| ).
    ENDTRY.
    mo_log->append_string( |{ code }\n=> { response }\n| ).
  ENDMETHOD.                    "evaluate

  METHOD free.
    go_ide->free_controls( ).
  ENDMETHOD.                    "free

  METHOD free_controls.
    FREE mo_alv.
    mo_log->free( ).
    mo_output->free( ).
    mo_source->free( ).
    mo_cont->free_controls( ).
  ENDMETHOD.                    "free_controls

  METHOD pbo.
    SET PF-STATUS 'STATUS_100'.
    SET TITLEBAR  'TITLE_100'.
    go_ide->first_output( ).
  ENDMETHOD.                    "pbo

  METHOD pai.
    rv_flag = go_ide->user_command( iv_code ).
  ENDMETHOD.                    "pai

  METHOD user_command.
    rv_flag = abap_false.

    CASE iv_code.
      WHEN 'EXECUTE'.
        evaluate( ).
      WHEN 'CLEAR'.
        refresh( ).
      WHEN OTHERS.
        RETURN.
    ENDCASE.

    rv_flag = abap_true.
  ENDMETHOD.                    "user_command

ENDCLASS.                    "lcl_ide IMPLEMENTATION

*----------------------------------------------------------------------*
*  MODULE status_0100 OUTPUT
*----------------------------------------------------------------------*
MODULE status_0100 OUTPUT.
  lcl_ide=>pbo( ).
ENDMODULE.                    "status_0100 OUTPUT

*----------------------------------------------------------------------*
*  MODULE cancel_0100 INPUT
*----------------------------------------------------------------------*
MODULE cancel_0100 INPUT.
  lcl_ide=>free( ).
  LEAVE PROGRAM.
ENDMODULE.                    "cancel_0100 INPUT

*----------------------------------------------------------------------*
*  MODULE user_command_0100
*----------------------------------------------------------------------*
MODULE user_command_0100.
  CHECK lcl_ide=>pai( g_ok_code ) EQ abap_true.
  CLEAR g_ok_code.
ENDMODULE.                    "user_command_0100

*----------------------------------------------------------------------*
*       CLASS lcl_container IMPLEMENTATION
*----------------------------------------------------------------------*
CLASS lcl_container IMPLEMENTATION.

  METHOD constructor.
*   Splitter Container
    CREATE OBJECT mo_splitter_h
      EXPORTING
        link_dynnr = '0100'
        link_repid = sy-repid
        parent     = cl_gui_container=>screen0
        rows       = 1
        columns    = 2.
    mo_splitter_h->set_border( border = cl_gui_cfw=>false ).

    mo_splitter_h->set_column_mode( mode = mo_splitter_h->mode_absolute ).
    mo_splitter_h->set_column_width( id = 1
                                     width = 750 ).
    mo_left = mo_splitter_h->get_container( row = 1
                                             column = 1 ).
    mo_right = mo_splitter_h->get_container( row = 1
                                              column = 2 ).
    CREATE OBJECT mo_splitter_v_h
      EXPORTING
        parent  = mo_right
        rows    = 2
        columns = 1.
    mo_splitter_v_h->set_border( border = cl_gui_cfw=>false ).
    mo_splitter_v_h->set_row_mode( mode = mo_splitter_v_h->mode_relative ).

    mo_output  = mo_splitter_v_h->get_container( row = 1 column = 1 ).
    mo_alv = mo_splitter_v_h->get_container( row = 2 column = 1 ).

    CREATE OBJECT mo_splitter_v
      EXPORTING
        parent  = mo_left
        rows    = 2
        columns = 1.
    mo_splitter_v->set_border( border = cl_gui_cfw=>false ).
    mo_splitter_v->set_row_mode( mode = mo_splitter_v->mode_relative ).

    mo_input  = mo_splitter_v->get_container( row = 1 column = 1 ).
    mo_log = mo_splitter_v->get_container( row = 2 column = 1 ).
  ENDMETHOD.                    "constructor

  METHOD free_controls.
    FREE: mo_input,
          mo_output,
          mo_log,
          mo_alv.
    FREE mo_left.
    FREE mo_splitter_h.
    FREE mo_splitter_v.
    FREE mo_splitter_v_h.
  ENDMETHOD.                    "free_controls

ENDCLASS.                    "lcl_container IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_editor IMPLEMENTATION
*----------------------------------------------------------------------*
CLASS lcl_editor IMPLEMENTATION.

  METHOD constructor.
    DATA mode TYPE i.
    io_container->set_visible( abap_true ).
    super->constructor( io_container ).
    set_comments_string( c_comments_string ).
    set_highlight_comments_mode( ).
    IF iv_toolbar EQ abap_true.
      mode = 1.
    ELSE.
      mode = 0.
    ENDIF.
    set_toolbar_mode( mode ).
    cl_gui_cfw=>flush( ).

    IF iv_read_only EQ abap_true.
      set_readonly_mode( cl_gui_textedit=>true ).
      mode = 0.
    ELSE.
      mode = 1.
    ENDIF.
    set_statusbar_mode( mode ).
*   Work around to avoid NO DATA dump on first read
    delete_text( ).
  ENDMETHOD.                    "constructor

  METHOD append_string.
    set_textstream( |{ to_string( ) }{ iv_text }| ).
  ENDMETHOD.                    "append_string

  METHOD format_input.
    ADD 1 TO mv_counter.
    rv_text = |${ mv_counter }> { code }\n|.
  ENDMETHOD.                    "format_input

  METHOD append_source.
    append_string( format_input( iv_text ) ).
  ENDMETHOD.                    "append_string

  METHOD append_to.
    io_editor->append_string( to_string( ) ).
  ENDMETHOD.                    "append_to

  METHOD to_string.
    get_textstream( IMPORTING text = rv_text ).
    cl_gui_cfw=>flush( ).
  ENDMETHOD.                    "to_string

  METHOD update_status.
    DATA lv_status_text TYPE char72.

    lv_status_text = iv_string.
    set_status_text( lv_status_text ).
  ENDMETHOD.                    "update_status

ENDCLASS.                    "lcl_editor IMPLEMENTATION
  
Error rendering macro 'code': Invalid value specified for parameter 'lang'
 
*&---------------------------------------------------------------------*
*&  Include           YY_LIB_LISP
*& https://github.com/mydoghasworms/abap-lisp
*& Lisp interpreter written in ABAP
*& Copy and paste this code into a type I (include) program
*&---------------------------------------------------------------------*
*& Martin Ceronio, martin.ceronio@infosize.co.za
*& June 2015
*& MIT License (see below)
*& Updated by Jacques Nomssi Nzali, www.informatik-dv.com Sept. 2015
*&---------------------------------------------------------------------*
*  The MIT License (MIT)
*
*  Copyright (c) 2015 Martin Ceronio
*
*  Permission is hereby granted, free of charge, to any person obtaining a copy
*  of this software and associated documentation files (the "Software"), to deal
*  in the Software without restriction, including without limitation the rights
*  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
*  copies of the Software, and to permit persons to whom the Software is
*  furnished to do so, subject to the following conditions:
*
*  The above copyright notice and this permission notice shall be included in
*  all copies or substantial portions of the Software.
*
*  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
*  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
*  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
*  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
*  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
*  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
*  THE SOFTWARE.

* Macro to simplify the definition of a native procedure
   DEFINE _proc_meth.
     methods &1
     importing list type ref to lcl_lisp
       returning value(result) type ref to lcl_lisp
       raising lcx_lisp_eval_err.
   END-OF-DEFINITION.

   DEFINE validate_number.
     if &1->type ne lcl_lisp=>type_number.
       throw( |{ &1->to_string( ) } is not a number | && &2 ).
     endif.
   END-OF-DEFINITION.

   DEFINE validate_integer.
     if &1->type ne lcl_lisp=>type_number or frac( &1->number ) ne 0.
       throw( |{ &1->to_string( ) } is not an integer | && &2 ).
     endif.
   END-OF-DEFINITION.

*  Macro that implements the logic for the comparison native
*  procedures, where only the comparison operator differs
   DEFINE _comparison.
     data cell type ref to lcl_lisp.
     data carry type decfloat34.

     result = false.
     validate: list, list->car.
     validate_number list->car &2.
     cell = list->cdr.
     carry = list->car->number.
     while cell ne nil.
       validate cell->car.
       validate_number list->car &2.
       if carry &1 cell->car->number.
         return.
       endif.
       carry = cell->car->number.
       cell = cell->cdr.
     endwhile.
     result = true.
   END-OF-DEFINITION.

   DEFINE _sign.
     data carry type decfloat34.

     result = false.
     validate: list, list->car.
     validate_number list->car &2.
     carry = list->car->number.
     if sign( carry ) NE &1.
       return.
     endif.
     result = true.
   END-OF-DEFINITION.

   DEFINE _is_type.
     result = false.
     check list is bound AND list->car is bound.
     if list->car->type eq lcl_lisp=>type_&1.
       result = true.
     endif.
   END-OF-DEFINITION.

   DEFINE _is_last_param.
     if &1->cdr ne nil.
       throw( |{ &1->to_string( ) } Parameter mismatch| ).
     endif.
   END-OF-DEFINITION.

  DEFINE _catch_arithmetic_error.
     data lx_error type ref to cx_root.
       catch cx_sy_arithmetic_error into lx_error.
         throw( lx_error->get_text( ) ).
   END-OF-DEFINITION.

* Macro that implements the logic for call of ABAP math statements
   DEFINE _math.
     result = nil.
     validate: list, list->car.
     validate_number list->car &2.
     _is_last_param list.
     try.
         result = lcl_lisp=>new_number( &1( list->car->number ) ).
       _catch_arithmetic_error.
     endtry.
   END-OF-DEFINITION.

   DEFINE _trigonometric.
     data carry type f.

     result = nil.
     validate: list, list->car.
     validate_number list->car &2.
     _is_last_param list.
     try.
         carry = list->car->number.
         result = lcl_lisp=>new_number( &1( carry ) ).
       _catch_arithmetic_error.
     endtry.
   END-OF-DEFINITION.

   DEFINE validate.
     if &1 is not bound.
       lcl_lisp=>throw( |Incorrect input| ).
     endif.
   END-OF-DEFINITION.

*--------------------------------------------------------------------*
* EXCEPTIONS
*--------------------------------------------------------------------*

*----------------------------------------------------------------------*
*  CLASS lcx_lisp_exception DEFINITION
*----------------------------------------------------------------------*
*  General Lisp exception
*----------------------------------------------------------------------*
   CLASS lcx_lisp_exception DEFINITION INHERITING FROM cx_dynamic_check.
     PUBLIC SECTION.
       METHODS constructor IMPORTING message TYPE string OPTIONAL.
       METHODS get_text REDEFINITION.
     PROTECTED SECTION.
       DATA mv_area TYPE string.
       DATA message TYPE string.
   ENDCLASS.                    "lcx_lisp_exception DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcx_lisp_exception IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcx_lisp_exception IMPLEMENTATION.
     METHOD constructor.
       super->constructor( ).
       me->message = message.
     ENDMETHOD.                    "constructor

     METHOD get_text.
       result = message.
       IF result IS INITIAL.
         result = |Error in processing|.
       ENDIF.
       IF mv_area IS NOT INITIAL.
         result = |{ mv_area }: { result }|.
       ENDIF.
     ENDMETHOD.                    "get_text

   ENDCLASS.                    "lcx_lisp_exception IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcx_lisp_parse_err DEFINITION
*----------------------------------------------------------------------*
* Parse exception
*----------------------------------------------------------------------*
   CLASS lcx_lisp_parse_err DEFINITION INHERITING FROM lcx_lisp_exception.
     PUBLIC SECTION.
       METHODS constructor IMPORTING message TYPE string OPTIONAL.
   ENDCLASS.                    "lcx_lisp_parse_err DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcx_lisp_parse_err IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS lcx_lisp_parse_err IMPLEMENTATION.

     METHOD constructor.
       super->constructor( message ).
       mv_area = |Parse|.
     ENDMETHOD.                    "constructor

   ENDCLASS.                    "lcx_lisp_parse_err IMPLEMENTATION
*----------------------------------------------------------------------*
*       CLASS lcx_lisp_eval_err DEFINITION
*----------------------------------------------------------------------*
* Evaluation exception
*----------------------------------------------------------------------*
   CLASS lcx_lisp_eval_err DEFINITION INHERITING FROM lcx_lisp_exception.
     PUBLIC SECTION.
       METHODS constructor IMPORTING message TYPE string OPTIONAL.
   ENDCLASS.                    "lcx_lisp_eval_err DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcx_lisp_eval_err IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcx_lisp_eval_err IMPLEMENTATION.

     METHOD constructor.
       super->constructor( message ).
       mv_area = |Eval|.
     ENDMETHOD.                    "constructor

   ENDCLASS.                    "lcx_lisp_eval_err IMPLEMENTATION

   CLASS lcl_lisp_environment DEFINITION DEFERRED.

* Single element that will capture cons cells, atoms etc.
*----------------------------------------------------------------------*
*       CLASS lcl_lisp DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_lisp DEFINITION.
     PUBLIC SECTION.
       TYPES tv_type TYPE char1.

       DATA type TYPE char1.
       DATA value TYPE string.
       DATA number TYPE decfloat34.
       DATA data TYPE REF TO data.            " for ABAP integration

*      Type definitions for the various elements
       CONSTANTS:
         type_symbol   TYPE tv_type VALUE 'S',
         type_number   TYPE tv_type VALUE 'N',
         type_string   TYPE tv_type VALUE '"',
         type_conscell TYPE tv_type VALUE 'C',
         type_lambda   TYPE tv_type VALUE 'λ',
         type_native   TYPE tv_type VALUE 'P',
         type_hash     TYPE tv_type VALUE 'H'.
*      Types for ABAP integration:
       CONSTANTS:
         type_abap_data     TYPE tv_type VALUE 'D',
         type_abap_table    TYPE tv_type VALUE 'T',
         type_abap_function TYPE tv_type VALUE 'F',
         type_abap_class    TYPE tv_type VALUE 'R',
         type_abap_method   TYPE tv_type VALUE 'M'.
       CONSTANTS:
         c_open_paren   TYPE char1 VALUE '(',
         c_close_paren  TYPE char1 VALUE ')'.

       CLASS-METHODS class_constructor.

       CLASS-DATA nil TYPE REF TO   lcl_lisp READ-ONLY.
       CLASS-DATA false TYPE REF TO  lcl_lisp READ-ONLY.
       CLASS-DATA true TYPE REF TO  lcl_lisp READ-ONLY.

*      Specifically for cons cells:
       DATA car TYPE REF TO lcl_lisp. "Contents of Address portion of Register
       DATA cdr TYPE REF TO lcl_lisp. "Contents of Decrement portion of Register

*      Specifically for lambdas:
       DATA environment TYPE REF TO lcl_lisp_environment.
*      Format
       METHODS to_string RETURNING value(str) TYPE string
                         RAISING   lcx_lisp_eval_err.
*      Utilities
       METHODS first RETURNING value(ro_car) TYPE REF TO lcl_lisp.
       METHODS rest RETURNING value(ro_cdr) TYPE REF TO lcl_lisp.

*      Factories
       CLASS-METHODS new_atom IMPORTING value          TYPE any
                              RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_symbol IMPORTING value          TYPE any
                                RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_number IMPORTING value          TYPE any
                                RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_string IMPORTING value          TYPE any
                                RETURNING value(ro_elem) TYPE REF TO lcl_lisp.

       CLASS-METHODS new_elem IMPORTING type           TYPE tv_type
                                        value          TYPE any
                              RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_data IMPORTING ref            TYPE REF TO data OPTIONAL
                              RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_table IMPORTING ref            TYPE REF TO data OPTIONAL
                               RETURNING value(ro_elem) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_cons IMPORTING io_car         TYPE REF TO lcl_lisp OPTIONAL
                                        io_cdr         TYPE REF TO lcl_lisp OPTIONAL
                              RETURNING value(ro_cons) TYPE REF TO lcl_lisp.
       CLASS-METHODS new_lambda IMPORTING io_car           TYPE REF TO lcl_lisp
                                          io_cdr           TYPE REF TO lcl_lisp
                                          io_env           TYPE REF TO lcl_lisp_environment
                                RETURNING value(ro_lambda) TYPE REF TO lcl_lisp.

       CLASS-METHODS throw IMPORTING message TYPE string
                           RAISING   lcx_lisp_eval_err.
     PROTECTED SECTION.
       CLASS-METHODS new IMPORTING type           TYPE tv_type
                                   io_car         TYPE REF TO lcl_lisp DEFAULT nil
                                   io_cdr         TYPE REF TO lcl_lisp DEFAULT nil
                         RETURNING value(ro_elem) TYPE REF TO lcl_lisp.

       METHODS list_to_string RETURNING value(str) TYPE string
                              RAISING   lcx_lisp_eval_err.
   ENDCLASS.                    "lcl_lisp DEFINITION

   INTERFACE lif_port.
     METHODS write IMPORTING element TYPE REF TO lcl_lisp.
   ENDINTERFACE.

   CLASS lcl_console DEFINITION.
     PUBLIC SECTION.
       INTERFACES lif_port.
       ALIASES write FOR lif_port~write.
   ENDCLASS.                    "lcl_console DEFINITION

   CLASS lcl_console IMPLEMENTATION.

     METHOD write.
     ENDMETHOD.

   ENDCLASS.                    "lcl_console DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_iterator DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_iterator DEFINITION CREATE PRIVATE.
     PUBLIC SECTION.
       CLASS-METHODS new IMPORTING io_elem        TYPE REF TO lcl_lisp
                         RETURNING value(ro_iter) TYPE REF TO lcl_lisp_iterator
                         RAISING   lcx_lisp_eval_err.
       METHODS has_next RETURNING value(rv_flag) TYPE flag.
       METHODS next RETURNING value(ro_elem) TYPE REF TO lcl_lisp
                    RAISING   cx_dynamic_check.
     PRIVATE SECTION.
       DATA first TYPE flag VALUE abap_true.
       DATA elem TYPE REF TO lcl_lisp.
   ENDCLASS.                    "lcl_lisp_iterator DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_hash DEFINITION
*----------------------------------------------------------------------*
* Hash is a specialized ABAP Lisp type for quick lookup of elements
* using a symbol or string key (backed by an ABAP hash table)
*----------------------------------------------------------------------*
   CLASS lcl_lisp_hash DEFINITION INHERITING FROM lcl_lisp.
     PUBLIC SECTION.

       CLASS-METHODS new_hash IMPORTING list           TYPE REF TO lcl_lisp
                              RETURNING value(ro_elem) TYPE REF TO lcl_lisp_hash
                              RAISING   lcx_lisp_exception.
       CLASS-METHODS from_list IMPORTING list           TYPE REF TO lcl_lisp
                                         msg            TYPE string
                               RETURNING value(ro_hash) TYPE REF TO lcl_lisp_hash
                               RAISING   lcx_lisp_exception.

       METHODS get IMPORTING list          TYPE REF TO lcl_lisp
                   RETURNING value(result) TYPE REF TO lcl_lisp
                   RAISING   lcx_lisp_exception.
       METHODS insert IMPORTING list          TYPE REF TO lcl_lisp
                      RETURNING value(result) TYPE REF TO lcl_lisp
                      RAISING   lcx_lisp_exception.
       METHODS delete IMPORTING list          TYPE REF TO lcl_lisp
                      RETURNING value(result) TYPE REF TO lcl_lisp
                      RAISING   lcx_lisp_exception.
       METHODS get_hash_keys RETURNING value(result) TYPE REF TO lcl_lisp.

     PROTECTED SECTION.
       TYPES: BEGIN OF ts_hash,
                key     TYPE string,
                element TYPE REF TO lcl_lisp,
              END OF ts_hash.
       TYPES tt_hash TYPE HASHED TABLE OF ts_hash WITH UNIQUE KEY key.
       DATA hash TYPE tt_hash.

   ENDCLASS.                    "lcl_lisp_hash DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_abapfunction DEFINITION
*----------------------------------------------------------------------*
* Specialized element representing an ABAP function module that can
* be called
*----------------------------------------------------------------------*
   CLASS lcl_lisp_abapfunction DEFINITION INHERITING FROM lcl_lisp.
     PUBLIC SECTION.
       CLASS-METHODS new_function
         IMPORTING list           TYPE REF TO lcl_lisp
         RETURNING value(ro_func) TYPE REF TO lcl_lisp_abapfunction
         RAISING   lcx_lisp_exception.

       METHODS call IMPORTING list           TYPE REF TO lcl_lisp
                    RETURNING value(ro_elem) TYPE REF TO lcl_lisp
                    RAISING   lcx_lisp_exception.

       METHODS get_function_parameter IMPORTING identifier TYPE REF TO lcl_lisp
                                      RETURNING value(rdata) TYPE REF TO data
                                      RAISING   lcx_lisp_eval_err.
     PROTECTED SECTION.
       TYPES tt_rsexc TYPE STANDARD TABLE OF rsexc WITH DEFAULT KEY.   " Exceptions
       TYPES tt_rsexp TYPE STANDARD TABLE OF rsexp WITH DEFAULT KEY.   " Exporting
       TYPES tt_rsimp TYPE STANDARD TABLE OF rsimp WITH DEFAULT KEY.   " Importing
       TYPES tt_rscha TYPE STANDARD TABLE OF rscha WITH DEFAULT KEY.   " Changing
       TYPES tt_rstbl TYPE STANDARD TABLE OF rstbl WITH DEFAULT KEY.   " Tables

       TYPES: BEGIN OF ts_interface,
                exc TYPE tt_rsexc,
                exp TYPE tt_rsexp,
                imp TYPE tt_rsimp,
                cha TYPE tt_rscha,
                tbl TYPE tt_rstbl,
                enh_exp TYPE tt_rsexp,
                enh_imp TYPE tt_rsimp,
                enh_cha TYPE tt_rscha,
                enh_tbl TYPE tt_rstbl,
                REMOTE_CALL TYPE RS38L-REMOTE,
                UPDATE_TASK TYPE RS38L-UTASK,
              END OF ts_interface.

       DATA parameters TYPE abap_func_parmbind_tab.
       DATA exceptions TYPE abap_func_excpbind_tab.
       DATA interface TYPE ts_interface.

       METHODS read_interface IMPORTING iv_name TYPE csequence
                              RETURNING VALUE(function_name) TYPE rs38l-name
                              RAISING   lcx_lisp_exception.
       METHODS create_parameters IMPORTING list TYPE REF TO lcl_lisp
                                 RAISING   lcx_lisp_exception.
       METHODS create_exceptions.

       METHODS error_message RETURNING VALUE(rv_message) TYPE string.
     PRIVATE SECTION.
       CONSTANTS c_error_message TYPE i VALUE 99.

       TYPES: BEGIN OF ts_params,
               PARAMETER TYPE PARAMETER,
               DBFIELD   TYPE LIKEFIELD,
               TYP       TYPE RS38L_TYP,

               DEFAULT  TYPE DEFAULT__3,
               OPTIONAL TYPE RS38L_OPTI,
              END OF ts_params.
       TYPES tt_params TYPE STANDARD TABLE OF ts_params.
       DATA parameters_generated TYPE flag.

       METHODS create_table_params IMPORTING it_table TYPE tt_rstbl.
       METHODS create_params IMPORTING it_table TYPE STANDARD TABLE
                                       iv_kind TYPE i.
   ENDCLASS.                    "lcl_lisp_abapfunction DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_environment DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_environment DEFINITION CREATE PRIVATE.
     PUBLIC SECTION.

*      Reference to outer (parent) environment:
       DATA outer TYPE REF TO lcl_lisp_environment.

       CLASS-METHODS
         new IMPORTING io_outer      TYPE REF TO lcl_lisp_environment OPTIONAL
             RETURNING value(ro_env) TYPE REF TO lcl_lisp_environment.

       METHODS:
         find IMPORTING symbol     TYPE any
              RETURNING value(env) TYPE REF TO lcl_lisp_environment
              RAISING   lcx_lisp_eval_err,
         lookup IMPORTING symbol      TYPE any
                RETURNING value(cell) TYPE REF TO lcl_lisp
                RAISING   lcx_lisp_eval_err,
         define IMPORTING symbol  TYPE string
                          element TYPE REF TO lcl_lisp,
*        Convenience method to add a value and create the cell
         define_value IMPORTING symbol         TYPE string
                                type           TYPE lcl_lisp=>tv_type
                                value          TYPE any OPTIONAL
                      RETURNING value(element) TYPE REF TO lcl_lisp.

       METHODS parameters_to_symbols IMPORTING io_pars       TYPE REF TO lcl_lisp
                                               io_args       TYPE REF TO lcl_lisp
                                     RETURNING value(ro_env) TYPE REF TO lcl_lisp_environment
                                     RAISING   lcx_lisp_eval_err.
     PROTECTED SECTION.

       TYPES: BEGIN OF ts_map,
                symbol TYPE string,
                value  TYPE REF TO lcl_lisp,
              END OF ts_map.
       TYPES tt_map TYPE HASHED TABLE OF ts_map WITH UNIQUE KEY symbol.

       DATA map TYPE tt_map.

       METHODS unbound_symbol IMPORTING symbol TYPE any
                              RAISING lcx_lisp_eval_err.
   ENDCLASS.                    "lcl_lisp_environment DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_parser DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_parser DEFINITION.
     PUBLIC SECTION.
       TYPES tt_element TYPE STANDARD TABLE OF REF TO lcl_lisp WITH DEFAULT KEY.

       METHODS:
         constructor,
         parse IMPORTING code            TYPE clike
               RETURNING value(elements) TYPE tt_element
               RAISING   lcx_lisp_parse_err.
     PRIVATE SECTION.
       CONSTANTS:
         c_escape_char  TYPE char1 VALUE '\',
         c_text_quote   TYPE char1 VALUE '"',
         c_lisp_quote   TYPE char1 VALUE '''', "LISP single quote = QUOTE
         c_lisp_comment TYPE char1 VALUE ';'.
       DATA code TYPE string.
       DATA length TYPE i.
       DATA index TYPE i.
       DATA char TYPE char1.

       DATA mv_eol TYPE char1.
       DATA mv_whitespace TYPE char04.
       DATA mv_delimiters TYPE char05.

       METHODS:
         next_char RAISING lcx_lisp_parse_err,
         skip_whitespace
           RETURNING value(rv_has_next) TYPE flag
           RAISING lcx_lisp_parse_err,
         parse_list RETURNING value(result) TYPE REF TO lcl_lisp
                    RAISING   lcx_lisp_parse_err,
         parse_token RETURNING value(element) TYPE REF TO lcl_lisp
                     RAISING   lcx_lisp_parse_err.
       METHODS match_string CHANGING cv_val TYPE string.
       METHODS run_to_delimiter CHANGING cv_val TYPE string.
   ENDCLASS.                    "lcl_parser DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_interpreter DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_interpreter DEFINITION INHERITING FROM lcl_parser.

     PUBLIC SECTION.
       DATA env TYPE REF TO lcl_lisp_environment. "Global environment
       DATA nil TYPE REF TO lcl_lisp READ-ONLY.
       DATA false TYPE REF TO lcl_lisp READ-ONLY.
       DATA true TYPE REF TO lcl_lisp READ-ONLY.

       METHODS constructor IMPORTING ii_port TYPE REF TO lif_port OPTIONAL.

*      Methods for evaluation
       METHODS:
         eval
           IMPORTING element       TYPE REF TO lcl_lisp
                     environment   TYPE REF TO lcl_lisp_environment
           RETURNING value(result) TYPE  REF TO lcl_lisp
           RAISING   lcx_lisp_eval_err,
* To enable a REPL, the following convenience method wraps parsing and evaluating
* and stringifies the response/error
         eval_source
           IMPORTING code            TYPE clike
           RETURNING value(response) TYPE string,
         eval_repl
           IMPORTING code            TYPE clike
           RETURNING value(response) TYPE string
           RAISING   lcx_lisp_eval_err.

* Functions for dealing with lists:
       _proc_meth:
       proc_append,   ##called
       proc_append_unsafe,   ##called
       proc_reverse,  ##called
       proc_car,      ##called
       proc_cdr,      ##called
       proc_cons,     ##called

       proc_memq,     ##called
       proc_memv,     ##called
       proc_member,   ##called
       proc_assq,     ##called
       proc_assv,     ##called
       proc_assoc,    ##called

       proc_length,   ##called
       proc_list,     ##called
       proc_nilp.     ##called

* Native functions:
       _proc_meth:
       proc_add,      ##called
       proc_subtract, ##called
       proc_multiply, ##called
       proc_divide,   ##called
       proc_gt,       ##called
       proc_gte,      ##called
       proc_lt,       ##called
       proc_lte,      ##called
       proc_eql,      ##called
       proc_eqv,      ##called

       proc_is_number,     ##called
       proc_is_string,     ##called
       proc_is_symbol,     ##called
       proc_is_hash,       ##called
       proc_is_type,       ##called
       proc_is_procedure,  ##called
       proc_is_list,       ##called
       proc_is_alist,      ##called

* Math
       proc_abs,      ##called
       proc_quotient, ##called
       proc_sin,      ##called
       proc_cos,      ##called
       proc_tan,      ##called
       proc_asin,     ##called
       proc_acos,     ##called
       proc_atan,     ##called
       proc_sinh,     ##called
       proc_cosh,     ##called
       proc_tanh,     ##called
       proc_asinh,    ##called
       proc_acosh,    ##called
       proc_atanh,    ##called
       proc_exp,      ##called
       proc_expt,     ##called
       proc_log,      ##called
       proc_sqrt,     ##called

       proc_is_zero,      ##called
       proc_is_positive,  ##called
       proc_is_negative,  ##called
       proc_is_odd,       ##called
       proc_is_even,      ##called

       proc_floor,        ##called
       proc_ceiling,      ##called
       proc_truncate,     ##called
       proc_round,        ##called

       proc_remainder,    ##called
       proc_modulo,       ##called
* Not in the spec: Just adding it anyway
       proc_eq,           ##called
       proc_equal.        ##called

* Functions for dealing with hashes:
       _proc_meth:
       proc_make_hash,    ##called "Create new hash
       proc_hash_get,     ##called "Get an element from a hash
       proc_hash_insert,  ##called "Insert a new element into a hash
       proc_hash_remove,  ##called "Delete an item from a hash
       proc_hash_keys.    ##called "Delete an item from a hash

* Built-in functions for ABAP integration:
       _proc_meth:
       proc_abap_data,          ##called
       proc_abap_function,      ##called
       proc_abap_table,         ##called
       proc_abap_append_row,    ##called
       proc_abap_delete_row,    ##called
       proc_abap_get_row,       ##called
       proc_abap_get_value,     ##called
       proc_abap_set_value,     ##called
       proc_abap_set,           ##called
       proc_abap_get,           ##called
* Called internally only:
       proc_abap_function_call. ##called

     PROTECTED SECTION.
       METHODS assign_symbol
         IMPORTING element       TYPE REF TO lcl_lisp
                   environment   TYPE REF TO lcl_lisp_environment
         RETURNING value(result) TYPE  REF TO lcl_lisp
         RAISING   lcx_lisp_eval_err.

       METHODS re_assign_symbol
         IMPORTING element       TYPE REF TO lcl_lisp
                   environment   TYPE REF TO lcl_lisp_environment
         RETURNING value(result) TYPE  REF TO lcl_lisp
         RAISING   lcx_lisp_eval_err.

*----  ABAP Integration support functions; mapping -----
       METHODS:
*        Convert ABAP data to Lisp element
         data_to_element IMPORTING value(data)    TYPE any
                         RETURNING value(element) TYPE REF TO lcl_lisp
                         RAISING   lcx_lisp_eval_err,
*        Convert Lisp element to ABAP Data
         element_to_data IMPORTING value(element) TYPE REF TO lcl_lisp
                         CHANGING  value(data)    TYPE any "ref to data
                         RAISING   lcx_lisp_eval_err,
*        Determine an ABAP data component from an element and an identifier
         get_element IMPORTING list         TYPE REF TO lcl_lisp
                     RETURNING value(rdata) TYPE REF TO data
                     RAISING   lcx_lisp_eval_err.

       METHODS console IMPORTING io_elem TYPE REF TO lcl_lisp
                       RETURNING VALUE(result) TYPE REF TO lcl_lisp.

       DATA mi_port TYPE REF TO lif_port.

     PRIVATE SECTION.
       METHODS throw IMPORTING message TYPE string
                     RAISING   lcx_lisp_eval_err.


       METHODS proc_equivalence IMPORTING a TYPE REF TO lcl_lisp
                                          b TYPE REF TO lcl_lisp
                                RETURNING VALUE(result) TYPE REF TO lcl_lisp
                                RAISING lcx_lisp_eval_err.
       METHODS proc_compare IMPORTING a TYPE REF TO lcl_lisp
                                      b TYPE REF TO lcl_lisp
                            RETURNING VALUE(result) TYPE REF TO lcl_lisp
                            RAISING lcx_lisp_eval_err.
       METHODS create_element_from_data
         IMPORTING ir_data       TYPE REF TO data
         RETURNING value(result) TYPE REF TO lcl_lisp.

       METHODS structure_to_element IMPORTING value(struct)  TYPE any
                                    RETURNING value(element) TYPE REF TO lcl_lisp
                                    RAISING   lcx_lisp_eval_err.
       METHODS get_structure_field IMPORTING element           TYPE REF TO lcl_lisp
                                             value(identifier) TYPE REF TO lcl_lisp
                                   RETURNING value(rdata)      TYPE REF TO data
                                   RAISING   lcx_lisp_eval_err.
       METHODS get_table_row_with_key IMPORTING element           TYPE REF TO lcl_lisp
                                                value(identifier) TYPE REF TO lcl_lisp
                                      RETURNING value(rdata)      TYPE REF TO data
                                      RAISING   lcx_lisp_eval_err.
       METHODS get_index_table_row IMPORTING element           TYPE REF TO lcl_lisp
                                              value(identifier) TYPE REF TO lcl_lisp
                                    RETURNING value(rdata)      TYPE REF TO data
                                    RAISING   lcx_lisp_eval_err.

       METHODS evaluate_parameters IMPORTING io_list        TYPE REF TO lcl_lisp
                                             environment    TYPE REF TO lcl_lisp_environment
                                   RETURNING value(ro_args) TYPE REF TO lcl_lisp
                                   RAISING   lcx_lisp_eval_err.
       METHODS eval_function IMPORTING io_head       TYPE REF TO lcl_lisp
                                       io_args       TYPE REF TO lcl_lisp
                                       environment   TYPE REF TO lcl_lisp_environment
                             RETURNING value(result) TYPE  REF TO lcl_lisp
                             RAISING   lcx_lisp_eval_err.

       METHODS extract_arguments IMPORTING io_head TYPE REF TO lcl_lisp
                                 EXPORTING eo_pars TYPE REF TO lcl_lisp
                                           eo_args TYPE REF TO lcl_lisp
                                 RAISING   lcx_lisp_eval_err.
       METHODS evaluate_list IMPORTING io_head       TYPE REF TO lcl_lisp
                                       io_env        TYPE REF TO lcl_lisp_environment
                             RETURNING value(result) TYPE REF TO lcl_lisp
                             RAISING   lcx_lisp_eval_err.

       METHODS evaluate_in_sequence IMPORTING io_pars  TYPE REF TO lcl_lisp
                                              io_args  TYPE REF TO lcl_lisp
                                              io_env   TYPE REF TO lcl_lisp_environment
                                    RAISING   lcx_lisp_eval_err.
       METHODS init_letrec IMPORTING io_pars TYPE REF TO lcl_lisp
                                     io_env        TYPE REF TO lcl_lisp_environment
                           RAISING   lcx_lisp_eval_err.
       METHODS init_named_let IMPORTING io_pars TYPE REF TO lcl_lisp
                                        io_env        TYPE REF TO lcl_lisp_environment
                              RAISING   lcx_lisp_eval_err.
   ENDCLASS.                    "lcl_lisp_interpreter DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_parser IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_parser IMPLEMENTATION.

     METHOD constructor.
*      End of line value
       mv_eol = cl_abap_char_utilities=>newline.
*      Whitespace values
       CLEAR mv_whitespace.
       mv_whitespace+0(1) = ' '.
       mv_whitespace+1(1) = cl_abap_char_utilities=>newline.
       mv_whitespace+2(1) = cl_abap_char_utilities=>cr_lf(1).
       mv_whitespace+3(1) = cl_abap_char_utilities=>horizontal_tab.
*      Delimiters value
       mv_delimiters = mv_whitespace.
       mv_delimiters+3(1) = lcl_lisp=>c_close_paren.
       mv_delimiters+4(1) = lcl_lisp=>c_open_paren.
     ENDMETHOD.                    "constructor

     METHOD skip_whitespace.
       WHILE char CA mv_whitespace AND index LT length.
         next_char( ).
       ENDWHILE.
       rv_has_next = boolc( index LT length ).
       CHECK char EQ c_lisp_comment AND rv_has_next EQ abap_true.
*      skip until end of line
       WHILE char CN mv_eol AND index LT length.
         next_char( ).
       ENDWHILE.
       rv_has_next = skip_whitespace( ).
     ENDMETHOD.                    "skip_whitespace

     METHOD next_char.
       index = index + 1.
       IF index < length.
         char = code+index(1).
       ELSEIF index = length.
         char = space.
       ELSEIF index > length.
*        Unexpected end
         RAISE EXCEPTION TYPE lcx_lisp_parse_err.
       ENDIF.
     ENDMETHOD.                    "next_char

     METHOD parse.
*      Entry point for parsing code. This is not thread-safe, but as an ABAP
*      process does not have the concept of threads, we are safe :-)
       me->code = code.
       length = strlen( code ).
       IF length = 0.
         APPEND lcl_lisp=>nil TO elements.
         RETURN.
       ENDIF.

       index = 0.
       char = code+index(1).           "Kick off things by reading first char
       WHILE skip_whitespace( ) EQ abap_true.
         IF char = lcl_lisp=>c_open_paren.
           APPEND parse_list( ) TO elements.
         ELSEIF index < length.
           APPEND parse_token( ) TO elements.
         ENDIF.
       ENDWHILE.
     ENDMETHOD.                    "parse

     METHOD parse_list.
       DATA lo_cell TYPE REF TO lcl_lisp.
       DATA lv_empty_list TYPE boole_d VALUE abap_true.

*      Set pointer to start of list
       lo_cell = result = lcl_lisp=>new_cons( ).

       next_char( ).                 " Skip past opening paren
       WHILE skip_whitespace( ) EQ abap_true.
         IF char = lcl_lisp=>c_close_paren.
           IF lv_empty_list = abap_true.
             result = lcl_lisp=>nil.           " Result = empty list
           ELSE.
             lo_cell->cdr = lcl_lisp=>nil.     " Terminate list
           ENDIF.
           next_char( ).              " Skip past closing paren
           RETURN.
         ENDIF.
         IF lv_empty_list = abap_false.
*          On at least the second item; add new cell and move pointer
           lo_cell = lo_cell->cdr = lcl_lisp=>new_cons( ).
         ENDIF.
         lv_empty_list = abap_false. " Next char was not closing paren
         lo_cell->car = parse_token( ).
       ENDWHILE.
     ENDMETHOD.                    "parse_list

     METHOD match_string.
       DATA pchar TYPE char1.

       next_char( ).                 " Skip past opening quote
       WHILE index < length
         AND NOT ( char = c_text_quote AND pchar NE c_escape_char ).
*         cv_val = |{ cv_val }{ char }|.
         CONCATENATE cv_val char INTO cv_val RESPECTING BLANKS.
         pchar = char.
         next_char( ).
       ENDWHILE.
       next_char( ).                 "Skip past closing quote
     ENDMETHOD.                    "match_string

     METHOD run_to_delimiter.
       WHILE index < length.
         cv_val = |{ cv_val }{ char }|.
         next_char( ).
         CHECK char CA mv_delimiters.
         EXIT.
       ENDWHILE.
       CONDENSE cv_val.
       IF cv_val = cl_abap_char_utilities=>newline.
         cv_val = space.
       ENDIF.
     ENDMETHOD.                    "run_to_delimiter

     METHOD parse_token.
       DATA sval TYPE string.

       skip_whitespace( ).
*      create object cell.
       CASE char.
         WHEN lcl_lisp=>c_open_paren.
           element = parse_list( ).

         WHEN c_lisp_quote.
* ' is just a shortcut for QUOTE, so we wrap the consecutive element in a list starting with the quote symbol
* so that when it is evaluated later, it returns the quote elements unmodified
           next_char( ).            " Skip past single quote
           element = lcl_lisp=>new_cons( io_car = lcl_lisp=>new_symbol( 'quote' )
                                         io_cdr = lcl_lisp=>new_cons( io_cdr = lcl_lisp=>nil
                                                                      io_car = parse_token( ) ) ).
         WHEN c_text_quote.
           match_string( CHANGING cv_val = sval ).
           element = lcl_lisp=>new_string( sval ).

         WHEN OTHERS.
           run_to_delimiter( CHANGING cv_val = sval ).
           IF sval IS INITIAL.
             element = lcl_lisp=>nil.
           ELSE.
             element = lcl_lisp=>new_atom( sval ).
           ENDIF.

       ENDCASE.

     ENDMETHOD.                    "parse_token

   ENDCLASS.                    "lcl_parser IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_interpreter IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_interpreter IMPLEMENTATION.

     METHOD constructor.
       super->constructor( ).

       IF ii_port IS BOUND.
         mi_port = ii_port.
       ELSE.
         CREATE OBJECT mi_port TYPE lcl_console.
       ENDIF.

       env = lcl_lisp_environment=>new( ).

*      Create symbols for nil, true and false values
       nil = lcl_lisp=>nil.
       true = lcl_lisp=>true.
       false = lcl_lisp=>false.
       env->define( symbol = 'nil'  element = nil ).
       env->define( symbol = '#f' element = false ).
       env->define( symbol = '#t' element = true ).

*      Add native functions to environment
       env->define_value( symbol = '+'       type = lcl_lisp=>type_native value   = 'PROC_ADD' ).
       env->define_value( symbol = '-'       type = lcl_lisp=>type_native value   = 'PROC_SUBTRACT' ).
       env->define_value( symbol = '*'       type = lcl_lisp=>type_native value   = 'PROC_MULTIPLY' ).
       env->define_value( symbol = '/'       type = lcl_lisp=>type_native value   = 'PROC_DIVIDE' ).
       env->define_value( symbol = 'append'  type = lcl_lisp=>type_native value   = 'PROC_APPEND' ).
       env->define_value( symbol = 'append!' type = lcl_lisp=>type_native value   = 'PROC_APPEND_UNSAFE' ).
       env->define_value( symbol = 'list'    type = lcl_lisp=>type_native value   = 'PROC_LIST' ).
       env->define_value( symbol = 'length'  type = lcl_lisp=>type_native value   = 'PROC_LENGTH' ).
       env->define_value( symbol = 'reverse' type = lcl_lisp=>type_native value   = 'PROC_REVERSE' ).

       env->define_value( symbol = 'memq'    type = lcl_lisp=>type_native value   = 'PROC_MEMQ' ).
       env->define_value( symbol = 'memv'    type = lcl_lisp=>type_native value   = 'PROC_MEMV' ).
       env->define_value( symbol = 'member'  type = lcl_lisp=>type_native value   = 'PROC_MEMBER' ).

       env->define_value( symbol = 'assq'    type = lcl_lisp=>type_native value   = 'PROC_ASSQ' ).
       env->define_value( symbol = 'assv'    type = lcl_lisp=>type_native value   = 'PROC_ASSV' ).
       env->define_value( symbol = 'assoc'   type = lcl_lisp=>type_native value   = 'PROC_ASSOC' ).

       env->define_value( symbol = 'car'     type = lcl_lisp=>type_native value   = 'PROC_CAR' ).
       env->define_value( symbol = 'cdr'     type = lcl_lisp=>type_native value   = 'PROC_CDR' ).
       env->define_value( symbol = 'cons'    type = lcl_lisp=>type_native value   = 'PROC_CONS' ).
       env->define_value( symbol = 'nil?'    type = lcl_lisp=>type_native value   = 'PROC_NILP' ).
       env->define_value( symbol = 'null?'   type = lcl_lisp=>type_native value   = 'PROC_NILP' ).
       env->define_value( symbol = '>'       type = lcl_lisp=>type_native value   = 'PROC_GT' ).
       env->define_value( symbol = '>='      type = lcl_lisp=>type_native value   = 'PROC_GTE' ).
       env->define_value( symbol = '<'       type = lcl_lisp=>type_native value   = 'PROC_LT' ).
       env->define_value( symbol = '<='      type = lcl_lisp=>type_native value   = 'PROC_LTE' ).
       env->define_value( symbol = '='       type = lcl_lisp=>type_native value   = 'PROC_EQL' ). "Math equal
       env->define_value( symbol = 'eq?'     type = lcl_lisp=>type_native value   = 'PROC_EQ' ).
       env->define_value( symbol = 'eqv?'    type = lcl_lisp=>type_native value   = 'PROC_EQV' ).
       env->define_value( symbol = 'equal?'  type = lcl_lisp=>type_native value   = 'PROC_EQUAL' ).
*      Hash-related functions
       env->define_value( symbol = 'make-hash'   type = lcl_lisp=>type_native value   = 'PROC_MAKE_HASH' ).
       env->define_value( symbol = 'hash-get'    type = lcl_lisp=>type_native value   = 'PROC_HASH_GET' ).
       env->define_value( symbol = 'hash-insert' type = lcl_lisp=>type_native value   = 'PROC_HASH_INSERT' ).
       env->define_value( symbol = 'hash-remove' type = lcl_lisp=>type_native value   = 'PROC_HASH_REMOVE' ).
       env->define_value( symbol = 'hash-keys'   type = lcl_lisp=>type_native value   = 'PROC_HASH_KEYS' ).
*      Functions for type:
       env->define_value( symbol = 'string?'     type = lcl_lisp=>type_native value = 'PROC_IS_STRING' ).
       env->define_value( symbol = 'hash?'       type = lcl_lisp=>type_native value = 'PROC_IS_HASH' ).
       env->define_value( symbol = 'number?'     type = lcl_lisp=>type_native value = 'PROC_IS_NUMBER' ).
       env->define_value( symbol = 'list?'       type = lcl_lisp=>type_native value = 'PROC_IS_LIST' ).
       env->define_value( symbol = 'alist?'      type = lcl_lisp=>type_native value = 'PROC_IS_ALIST' ).
       env->define_value( symbol = 'procedure?'  type = lcl_lisp=>type_native value = 'PROC_IS_PROCEDURE' ).
       env->define_value( symbol = 'symbol?'     type = lcl_lisp=>type_native value = 'PROC_IS_SYMBOL' ).
       env->define_value( symbol = 'type'        type = lcl_lisp=>type_native value = 'PROC_IS_TYPE' ).

*      Math
       env->define_value( symbol = 'abs' type = lcl_lisp=>type_native value = 'PROC_ABS' ).
       env->define_value( symbol = 'sin' type = lcl_lisp=>type_native value = 'PROC_SIN' ).
       env->define_value( symbol = 'cos' type = lcl_lisp=>type_native value = 'PROC_COS' ).
       env->define_value( symbol = 'tan' type = lcl_lisp=>type_native value = 'PROC_TAN' ).
       env->define_value( symbol = 'asin' type = lcl_lisp=>type_native value = 'PROC_ASIN' ).
       env->define_value( symbol = 'acos' type = lcl_lisp=>type_native value = 'PROC_ACOS' ).
       env->define_value( symbol = 'atan' type = lcl_lisp=>type_native value = 'PROC_ATAN' ).
       env->define_value( symbol = 'sinh' type = lcl_lisp=>type_native value = 'PROC_SINH' ).
       env->define_value( symbol = 'cosh' type = lcl_lisp=>type_native value = 'PROC_COSH' ).
       env->define_value( symbol = 'tanh' type = lcl_lisp=>type_native value = 'PROC_TANH' ).
       env->define_value( symbol = 'asinh' type = lcl_lisp=>type_native value = 'PROC_ASINH' ).
       env->define_value( symbol = 'acosh' type = lcl_lisp=>type_native value = 'PROC_ACOSH' ).
       env->define_value( symbol = 'atanh' type = lcl_lisp=>type_native value = 'PROC_ATANH' ).
       env->define_value( symbol = 'expt' type = lcl_lisp=>type_native value = 'PROC_EXPT' ).
       env->define_value( symbol = 'exp' type = lcl_lisp=>type_native value = 'PROC_EXP' ).
       env->define_value( symbol = 'log' type = lcl_lisp=>type_native value = 'PROC_LOG' ).
       env->define_value( symbol = 'sqrt' type = lcl_lisp=>type_native value = 'PROC_SQRT' ).

       env->define_value( symbol = 'floor'    type = lcl_lisp=>type_native value = 'PROC_FLOOR' ).
       env->define_value( symbol = 'ceiling'  type = lcl_lisp=>type_native value = 'PROC_CEILING' ).
       env->define_value( symbol = 'truncate' type = lcl_lisp=>type_native value = 'PROC_TRUNCATE' ).
       env->define_value( symbol = 'round'    type = lcl_lisp=>type_native value = 'PROC_ROUND' ).

       env->define_value( symbol = 'remainder' type = lcl_lisp=>type_native value = 'PROC_REMAINDER' ).
       env->define_value( symbol = 'modulo'    type = lcl_lisp=>type_native value = 'PROC_MODULO' ).
       env->define_value( symbol = 'quotient'  type = lcl_lisp=>type_native value = 'PROC_QUOTIENT' ).

       env->define_value( symbol = 'zero?'     type = lcl_lisp=>type_native value = 'PROC_IS_ZERO' ).
       env->define_value( symbol = 'positive?' type = lcl_lisp=>type_native value = 'PROC_IS_POSITIVE' ).
       env->define_value( symbol = 'negative?' type = lcl_lisp=>type_native value = 'PROC_IS_NEGATIVE' ).
       env->define_value( symbol = 'odd?'      type = lcl_lisp=>type_native value = 'PROC_IS_ODD' ).
       env->define_value( symbol = 'even?'     type = lcl_lisp=>type_native value = 'PROC_IS_EVEN' ).

*      Native functions for ABAP integration
       env->define_value( symbol = 'ab-data'       type = lcl_lisp=>type_native value   = 'PROC_ABAP_DATA' ).
       env->define_value( symbol = 'ab-function'   type = lcl_lisp=>type_native value   = 'PROC_ABAP_FUNCTION' ).
       env->define_value( symbol = 'ab-table'      type = lcl_lisp=>type_native value   = 'PROC_ABAP_TABLE' ).
       env->define_value( symbol = 'ab-append-row' type = lcl_lisp=>type_native value   = 'PROC_ABAP_APPEND_ROW' ).
       env->define_value( symbol = 'ab-delete-row' type = lcl_lisp=>type_native value   = 'PROC_ABAP_DELETE_ROW' ).
       env->define_value( symbol = 'ab-get-row'    type = lcl_lisp=>type_native value   = 'PROC_ABAP_GET_ROW' ).
       env->define_value( symbol = 'ab-get-value'  type = lcl_lisp=>type_native value   = 'PROC_ABAP_GET_VALUE' ).
       env->define_value( symbol = 'ab-set-value'  type = lcl_lisp=>type_native value   = 'PROC_ABAP_SET_VALUE' ).

       env->define_value( symbol = 'ab-get' type = lcl_lisp=>type_native value = 'PROC_ABAP_GET' ).
       env->define_value( symbol = 'ab-set' type = lcl_lisp=>type_native value = 'PROC_ABAP_SET' ).

       DATA lr_ref TYPE REF TO data.
*      Define a value in the environment for SYST
       GET REFERENCE OF syst INTO lr_ref.
       env->define( symbol = 'ab-sy' element = lcl_lisp=>new_data( lr_ref ) ).
     ENDMETHOD.                    "constructor

     METHOD throw.
       RAISE EXCEPTION TYPE lcx_lisp_eval_err
         EXPORTING
           message = message.
     ENDMETHOD.                    "throw

     METHOD assign_symbol.
       CASE element->car->type.
         WHEN lcl_lisp=>type_symbol.
           environment->define( symbol  = element->car->value
                                element = eval( element = element->cdr->car
                                                environment = environment ) ).
           result = lcl_lisp=>new_symbol( element->car->value ).
*        Function shorthand (define (id arg ... ) body ...+)
         WHEN lcl_lisp=>type_conscell.
*         define's function shorthand allows us to define a function by specifying a list as the
*         first argument where the first element is a symbol and consecutive elements are arguments
           result = lcl_lisp=>new_lambda( io_car = element->car->cdr  "List of params following function symbol
                                          io_cdr = element->cdr
                                          io_env = environment ).
*          Add function to the environment with symbol
           environment->define( symbol  = element->car->car->value
                                element = result ).
*          TODO: Here and above: Scheme does not return a value for define; should we?
           result = lcl_lisp=>new_symbol( element->car->car->value ).
         WHEN OTHERS.
           throw( |{ element->car->to_string( ) } cannot be a variable identifier| ).
       ENDCASE.
     ENDMETHOD.                    "assign_symbol

     METHOD re_assign_symbol.
       DATA lo_env TYPE REF TO lcl_lisp_environment.

       result = element->car.
       CASE result->type.
         WHEN lcl_lisp=>type_symbol.
           lo_env = environment->find( result->value ).
*          re-define in the original environment LO_ENV, but
*          evaluate parameters in the current ENVIRONMENT
           lo_env->define( symbol  = result->value
                           element = eval( element = element->cdr->car
                                           environment = environment ) ).
         WHEN OTHERS.
           throw( |{ result->to_string( ) } must be a symbol| ).
       ENDCASE.
     ENDMETHOD.                    "re_assign_symbol

     METHOD evaluate_parameters.
*      Before execution of the procedure or lambda, all parameters must be evaluated
       DATA lo_arg TYPE REF TO lcl_lisp.
       DATA lo_iter TYPE REF TO lcl_lisp_iterator.

       ro_args = nil.
       CHECK io_list NE nil AND io_list->car NE nil.

       lo_arg = ro_args = lcl_lisp=>new_cons( ).

       lo_iter = lcl_lisp_iterator=>new( io_list ).
       WHILE lo_iter->has_next( ) EQ abap_true.
         lo_arg->car = eval( element = lo_iter->next( )
                             environment = environment ).
         IF lo_iter->has_next( ) EQ abap_false.
           lo_arg->cdr = nil.
           EXIT.
         ENDIF.
         lo_arg = lo_arg->cdr = lcl_lisp=>new_cons( ).
       ENDWHILE.
     ENDMETHOD.                    "evaluate_parameters

     METHOD eval_function.
*      The function (LAMBDA) receives its own local environment in which to execute,
*      where parameters become symbols that are mapped to the corresponding arguments
       DATA lo_args TYPE REF TO lcl_lisp.
       DATA lo_env TYPE REF TO lcl_lisp_environment.

       validate io_head.
       lo_args = evaluate_parameters( io_list = io_args           " Pointer to arguments
                                      environment = environment ).
       lo_env = lcl_lisp_environment=>new( io_head->environment ).
       lo_env->parameters_to_symbols( io_args = lo_args
                                      io_pars = io_head->first( ) ).   " Pointer to formal parameters
       result = evaluate_list( io_head = io_head->rest( )
                               io_env = lo_env ).
     ENDMETHOD.                    "eval_function

     METHOD evaluate_list.
       DATA lo_iter TYPE REF TO lcl_lisp_iterator.
*      Evaluate lambda
       result = nil.
       lo_iter = lcl_lisp_iterator=>new( io_head ).
       WHILE lo_iter->has_next( ) EQ abap_true.
         result = eval( element = lo_iter->next( )
                        environment = io_env ).
       ENDWHILE.
     ENDMETHOD.                    "evaluate_list

     METHOD extract_arguments.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_pair TYPE REF TO lcl_lisp.
       DATA lo_par TYPE REF TO lcl_lisp.
       DATA lo_arg TYPE REF TO lcl_lisp.

       eo_args = eo_pars = nil.                "list of parameters

       CHECK io_head->car IS BOUND AND io_head->car NE nil.
       lo_ptr = io_head->car.

       validate lo_ptr->car.
       eo_pars = lcl_lisp=>new_cons( io_car = lo_ptr->car ).
       IF lo_ptr->cdr IS BOUND AND lo_ptr->cdr NE nil.
         eo_args = lcl_lisp=>new_cons( io_car = lo_ptr->cdr->car ).
       ENDIF.
       lo_par = eo_pars.
       lo_arg = eo_args.
       lo_ptr = io_head.
       WHILE lo_ptr->cdr IS BOUND AND lo_ptr->cdr NE nil.
         lo_ptr = lo_ptr->cdr.
*        Rest of list, pick head
         lo_pair = lo_ptr->car.
         IF lo_pair IS BOUND AND lo_pair->car NE nil.
           lo_par = lo_par->cdr = lcl_lisp=>new_cons( io_car = lo_pair->car ).
         ENDIF.
         IF lo_pair->cdr IS BOUND AND lo_pair->cdr NE nil.
           lo_arg = lo_arg->cdr = lcl_lisp=>new_cons( io_car = lo_pair->cdr->car ).
         ENDIF.
       ENDWHILE.
       lo_par->cdr = lo_arg->cdr = nil.

*     Debug help: DATA lv_debug TYPE string.
*      lv_debug = |params { eo_pars->to_string( ) }\n arg { eo_args->to_string( ) }\n|.
     ENDMETHOD.                    "extract_arguments

* A letrec expression is equivalent to a let where the bindings are initialized with dummy values,
* and then the initial values are computed and assigned into the bindings.
* letrec lets us create an environment before evaluating the initial value expressions, so that the
* initial value computions execute inside the new environment.
*
*(define (some-procedure...)
*   (letrec ((helper (lambda (x)
*                       ...
*                       (if some-test?
*                           (helper ...))))) ; recursive call
*     ...
*     (helper ...)  ; call to recursive local procedure
*     ...))
* Note the procedure helper can "see its own name," since the lambda expression is evaluated in the
* environment where helper is bound. The above example is equivalent to:
*
*(define (some-procedure ...)
*   (let ((helper '*dummy-value*))
*      (set! helper (lambda (x)
*                      ...
*                      (if some-test?
*                          (helper ...))))) ; recursive call
*     ...
*     (helper ...)  ; call to recursive local procedure
*     ...))
     METHOD init_letrec.
*       Before evaluating the parameter, we create them all with dummy values
        DATA lo_par TYPE REF TO lcl_lisp. " Parameter
        DATA lo_dummy TYPE REF TO lcl_lisp.

        lo_dummy = lcl_lisp=>new_string( '*letrec-dummy*' ).
        lo_par = io_pars.                         " Pointer to formal parameters
        WHILE lo_par IS BOUND AND lo_par NE nil.  " Nil means no parameters to map
          io_env->define( symbol = lo_par->car->value
                          element = lo_dummy ).
          lo_par = lo_par->cdr.
        ENDWHILE.
     ENDMETHOD.

*Here's an example loop, which prints out the integers from 0 to 9:
* (  let loop ((i 0))
*     (display i)
*     (if (< i 10)
*         (loop (+ i 1))))
*
*The example is exactly equivalent to:
*  (letrec ((loop (lambda (i)      ; define a recursive
*                    (display i)   ; procedure whose body
*                    (if (< i 10)  ; is the loop body
*                        (loop (+ i 1))))))
*     (loop 0)) ; start the recursion with 0 as arg i
     METHOD init_named_let.
     ENDMETHOD.

     METHOD evaluate_in_sequence.
*      Before execution of the procedure or lambda, all parameters must be evaluated
       DATA lo_iter_arg TYPE REF TO lcl_lisp_iterator.
       DATA lo_iter_par TYPE REF TO lcl_lisp_iterator.

       DATA lo_par TYPE REF TO lcl_lisp.

       lo_iter_arg = lcl_lisp_iterator=>new( io_args ).
       lo_iter_par = lcl_lisp_iterator=>new( io_pars ).

       WHILE lo_iter_arg->has_next( ) EQ abap_true
         AND lo_iter_par->has_next( ) EQ abap_true.

         lo_par = lo_iter_par->next( ).
         CHECK lo_par NE nil.        " Nil would mean no parameters to map
*        Assign argument to its corresponding symbol in the newly created environment
*        NOTE: element of the argument list is evaluated before being defined in the environment
         io_env->define( symbol = lo_par->value
                         element = eval( element = lo_iter_arg->next( )
                                         environment = io_env ) ).
       ENDWHILE.
     ENDMETHOD.                    "environment_from_sequence

**********************************************************************
*
*------------------------------- EVAL( ) ----------------------------
*; eval takes an expression and an environment to a value
*;(define (eval e env) (cond
*;  ((symbol? e)       (cadr (assq e env)))
*;  ((eq? (car e) 'λ)  (cons e env))
*;  (else              (apply (eval (car e) env) (eval (cadr e) env)))))
**********************************************************************
     METHOD eval.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_clause TYPE REF TO lcl_lisp.
       validate element.
*      Return predefined symbols as themselves to save having to look them up in the environment
       IF element = nil. result = nil. RETURN. ENDIF.
       IF element = true. result = true. RETURN. ENDIF.
       IF element = false. result = false. RETURN. ENDIF.

       CASE element->type.
         WHEN lcl_lisp=>type_number OR lcl_lisp=>type_string.
           result = element.  "Number or string evaluates to itself

         WHEN lcl_lisp=>type_symbol. "Symbol
           result = environment->lookup( element->value ).

*---     ### EVAL LIST
         WHEN lcl_lisp=>type_conscell. "Cons Cell = List
*          To evaluate list, we must first evaluate head value
           DATA lr_head TYPE REF TO lcl_lisp.
           DATA lr_tail TYPE REF TO lcl_lisp.
*          Evaluate first element of list to determine if it is a native procedure or lambda
           lr_head = element->car. "Unevaluated value
           lr_tail = element->cdr.

           CASE lr_head->value.

             WHEN 'quote'. " Return the argument to quote unevaluated
               IF lr_tail->cdr NE nil.
                 throw( |QUOTE can only take a single argument| ).
               ENDIF.
               result = lr_tail->car.

             WHEN 'newline'.
               result = lcl_lisp=>new_string( |\n| ).

             WHEN 'display'.
               result = console( eval( element = lr_tail->car
                                       environment = environment )  ).

             WHEN 'if'.
               IF eval( element = lr_tail->car
                        environment = environment  ) NE false.
                 result = eval( element = lr_tail->cdr->car
                                environment = environment  ).
               ELSEIF lr_tail->cdr->cdr = nil.
                 result = false.
               ELSE.
                 result = eval( element = lr_tail->cdr->cdr->car
                                environment = environment ).
               ENDIF.

             WHEN 'and'.
               result = true.
               lo_ptr = lr_tail.
               WHILE lo_ptr IS BOUND AND lo_ptr NE nil AND result NE false.
                 result = eval( element = lo_ptr->car
                                environment = environment ).
                 lo_ptr = lo_ptr->cdr.
               ENDWHILE.

             WHEN 'or'.
               result = false.
               lo_ptr = lr_tail.
               WHILE lo_ptr IS BOUND AND lo_ptr NE nil AND result EQ false.
                 result = eval( element = lo_ptr->car
                                environment = environment ).
                 lo_ptr = lo_ptr->cdr.
               ENDWHILE.

             WHEN 'cond'.
               lo_ptr = lr_tail.
               WHILE lo_ptr NE nil.
                 lo_clause = lo_ptr->car.
                 IF lo_clause->car->value EQ 'else'
                    OR eval( element = lo_clause->car
                             environment = environment ) NE false.
                   result = evaluate_list( io_head = lo_clause->cdr
                                           io_env = environment ).
                   EXIT.
                 ENDIF.
                 lo_ptr = lo_ptr->cdr.
               ENDWHILE.

             WHEN 'define'.
               result = assign_symbol( element = lr_tail
                                       environment = environment ).

             WHEN 'set!'.                        " Re-Assign symbol
               result = re_assign_symbol( element     = lr_tail
                                          environment = environment ).

             WHEN 'let'.
*              (let ((x 10) (y 5)) (+ x y)) is syntactic sugar for  ( (lambda (x y) (+ x y)) 10 5)
               DATA lo_pars TYPE REF TO lcl_lisp.
               DATA lo_args TYPE REF TO lcl_lisp.
               DATA lo_env TYPE REF TO lcl_lisp_environment.

               extract_arguments( EXPORTING io_head = lr_tail->car
                                  IMPORTING eo_pars = lo_pars
                                            eo_args = lo_args ).
               lo_env = lcl_lisp_environment=>new( environment ).
               init_named_let( io_pars = lo_pars
                               io_env = lo_env ).

               lo_args = evaluate_parameters( io_list = lo_args           " Pointer to arguments
                                              environment = environment ).
               lo_env->parameters_to_symbols( io_args = lo_args
                                              io_pars = lo_pars ).   " Pointer to formal parameters
               result = evaluate_list( io_head = lr_tail->cdr
                                       io_env = lo_env ).

             WHEN 'letrec'.
               extract_arguments( EXPORTING io_head = lr_tail->car
                                  IMPORTING eo_pars = lo_pars
                                            eo_args = lo_args ).
               lo_env = lcl_lisp_environment=>new( environment ).
               init_letrec( io_pars = lo_pars
                            io_env = lo_env ).

               lo_args = evaluate_parameters( io_list = lo_args           " Pointer to arguments
                                              environment = lo_env ).
               lo_env->parameters_to_symbols( io_args = lo_args
                                              io_pars = lo_pars ).   " Pointer to formal parameters
               result = evaluate_list( io_head = lr_tail->cdr
                                       io_env = lo_env ).

             WHEN 'let*'.
               extract_arguments( EXPORTING io_head = lr_tail->car
                                  IMPORTING eo_pars = lo_pars
                                            eo_args = lo_args ).
               lo_env = lcl_lisp_environment=>new( environment ).
               evaluate_in_sequence( io_args = lo_args      " Pointer to arguments e.g. (4, (+ x 4)
                                     io_pars = lo_pars      " Pointer to formal parameters (x y)
                                     io_env = lo_env ).
               result = evaluate_list( io_head = lr_tail->cdr
                                       io_env = lo_env ).

             WHEN 'lambda'.
               result = lcl_lisp=>new_lambda( io_car = lr_tail->car         " List of parameters
                                              io_cdr = lr_tail->cdr         " Body
                                              io_env = environment ).
             WHEN 'begin'.
               result = evaluate_list( io_head = lr_tail
                                       io_env = environment ).
             WHEN OTHERS.
*---           NATIVE PROCEDURES AND LAMBDAS
*              Other symbols at the start of the list must be evaluated first
*              The evaluated head must be either a native procedure or lambda
               lr_head = eval( element = element->car
                               environment = environment ).

               CASE lr_head->type.

                 WHEN lcl_lisp=>type_native.
*---               NATIVE FUNCTION
*                  Evaluate native function:
                   CALL METHOD (lr_head->value)
                     EXPORTING
                       list   = evaluate_parameters( io_list = lr_tail
                                                     environment = environment )
                     RECEIVING
                       result = result.

                 WHEN lcl_lisp=>type_lambda.
                   result = eval_function( io_head = lr_head
                                           io_args = lr_tail
                                           environment = environment ).

                 WHEN lcl_lisp=>type_abap_function.
*>>> TEST:         Support evaluation of ABAP function directly
*                    Recompose as if calling a PROC (which we are). This is part of the test. If we make an ABAP function
*                    call first-class, then we would need to revisit evaluating the whole of ELEMENT in one shot
                   result = proc_abap_function_call( lcl_lisp=>new_cons( io_car = lr_head
                                                                         io_cdr = lr_tail ) ).
*<<< TEST
                 WHEN OTHERS.
                   throw( |Cannot evaluate { lr_head->to_string( ) } - not a function| ).

               ENDCASE.

           ENDCASE.

       ENDCASE.
       CHECK result IS NOT BOUND.
*      this should not happen if the code is correct!
       throw( |EVAL( ) came up empty-handed| ).
     ENDMETHOD.                    "eval

     METHOD console.
       mi_port->write( io_elem ).
       result = lcl_lisp=>new_string( io_elem->to_string( ) ).
     ENDMETHOD.

     METHOD eval_source.
       DATA lx_root TYPE REF TO cx_root.
       TRY.
           response = eval_repl( code ).
         CATCH cx_root INTO lx_root.
           response = lx_root->get_text( ).
       ENDTRY.
     ENDMETHOD.                    "eval_source

     METHOD eval_repl.
       DATA lo_element TYPE REF TO lcl_lisp.
       DATA lt_element TYPE tt_element.
       DATA lv_value TYPE string.

       lt_element = parse( code ).
       LOOP AT lt_element INTO lo_element.
         lv_value = eval( element = lo_element
                          environment = env )->to_string( ).
         IF response IS INITIAL.
           response = lv_value.
         ELSE.
           response = |{ response } { lv_value }|.
         ENDIF.
       ENDLOOP.
     ENDMETHOD.                    "eval_source

**********************************************************************
* NATIVE PROCEDURES
**********************************************************************
     METHOD proc_append.
*      All parameters execpt the last must be lists, the last must be
*      a cons cell. Creates a new list appending all parameters
       DATA lo_iter TYPE REF TO lcl_lisp_iterator.

*      But if the last element in the list is not a cons cell, we cannot append
       result = nil.
       CHECK list IS BOUND.
       validate list->car.
       result = list->car.

       CHECK list->cdr IS BOUND AND list->cdr NE NIL.
       validate list->cdr->car.
       result = list->cdr->car.

       CHECK list->car NE nil.
       lo_iter = lcl_lisp_iterator=>new( proc_reverse( list ) ).
       WHILE lo_iter->has_next( ) EQ abap_true.
         result = lcl_lisp=>new_cons( io_car = lo_iter->next( )
                                      io_cdr = result ).
       ENDWHILE.
     ENDMETHOD.                    "proc_append

     METHOD proc_reverse.
       DATA iter TYPE REF TO lcl_lisp_iterator.
*      But if the last element in the list is not a cons cell, we cannot append
       validate: list, list->car.

       result = nil.
       iter = lcl_lisp_iterator=>new( list->car ).
       WHILE iter->has_next( ) EQ abap_true.
         result = lcl_lisp=>new_cons( io_car = iter->next( )
                                      io_cdr = result ).
       ENDWHILE.
     ENDMETHOD.                    "proc_reverse

     METHOD proc_append_unsafe.  " append! (non functional)
*      Takes two parameters: the first must be a list, and the second can
*      be of any type. Appends the second param to the first.
       DATA lo_last TYPE REF TO lcl_lisp.

*      But if the last element in the list is not a cons cell, we cannot append
       validate: list, list->car, list->cdr.

       IF list->car EQ nil.
         result = list->cdr->car.
       ELSE.
*        Get to last element in list - this can make APPEND expensive, like LENGTH
         lo_last = list->car.
         IF lo_last->type NE lcl_lisp=>type_conscell.
           throw( |{ lo_last->to_string( ) } is not a list| ).
         ENDIF.

         WHILE lo_last->cdr IS BOUND AND lo_last->cdr NE nil.
           lo_last = lo_last->cdr.
         ENDWHILE.

         IF lo_last->type NE lcl_lisp=>type_conscell.
*          If the last item is not a cons cell, return an error
           throw( |{ list->car->to_string( ) } is not a proper list| ).
         ENDIF.

*        Last item is a cons cell; tack on the new value
         lo_last->cdr = list->cdr->car.
         result = list->car.
       ENDIF.
     ENDMETHOD.                    "proc_append_unsafe

     METHOD proc_car.
       validate: list, list->car.
       IF list->car = nil.
         result = nil.
         RETURN.
       ENDIF.
       result = list->car->car.
     ENDMETHOD.                    "proc_car

     METHOD proc_cdr.
       validate: list, list->car, list->cdr.

       IF list->cdr = nil AND list->car = nil.
         result = nil.
         RETURN.
       ENDIF.
       result = list->car->cdr.
     ENDMETHOD.                    "proc_cdr

     METHOD proc_cons.
*      Create new cell and prepend it to second parameter
       validate: list, list->car, list->cdr.

       result = lcl_lisp=>new_cons( io_car = list->car
                                    io_cdr = list->cdr->car ).
     ENDMETHOD.                    "proc_cons

* (defun list-length (x)
*   (do ((n 0 (+ n 2))           ;Counter.
*        (fast x (cddr fast))    ;Fast pointer: leaps by 2.
*        (slow x (cdr slow)))    ;Slow pointer: leaps by 1.
*       (nil)
*     ;; If fast pointer hits the end, return the count.
*     (when (endp fast) (return n))
*     (when (endp (cdr fast)) (return (+ n 1)))
*     ;; If fast pointer eventually equals slow pointer, then we must be stuck in a circular list.
*     ;; (A deeper property is the converse: if we are stuck in a circular list, then eventually
*     ;; the fast pointer will equal the slow pointer. That fact justifies this implementation.
*     (when (and (eq fast slow) (> n 0)) (return nil))))
     METHOD proc_length.
       DATA lo_elem TYPE REF TO lcl_lisp.

       validate: list, list->cdr.
       IF list->cdr NE nil.
         throw( |LIST takes only one argument| ).
       ENDIF.

       result = lcl_lisp=>new_number( 0 ).
       CHECK list NE nil AND ( list->car NE nil OR list->cdr NE nil ).

*      Iterate over list to count the number of items
       result->number = 1.
       lo_elem = list->car.
       WHILE lo_elem->cdr IS BOUND AND lo_elem->cdr NE nil.
         lo_elem = lo_elem->cdr.
         ADD 1 TO result->number.
       ENDWHILE.
       CHECK lo_elem->type NE lcl_lisp=>type_conscell
         AND list->car->type NE lcl_lisp=>type_conscell.
*      If the last item is not a cons cell, return an error
       throw( |{ list->car->to_string( ) } is not a proper list| ).
     ENDMETHOD.                    "proc_length

     METHOD proc_list.
*      The items given to us are already in a list and evaluated; we just need to return the head
       result = list.
     ENDMETHOD.                    "proc_list

     METHOD proc_nilp.
       validate: list, list->car.
       IF list->car = nil. " or
         result = true.
       ELSE.
         result = false.
       ENDIF.
     ENDMETHOD.                    "proc_nilp

* TO BE IMPLEMENTED
     METHOD proc_memq.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_ref TYPE REF TO lcl_lisp.
       validate: list, list->car.

       result = false.
       lo_ref = list->car.
       CHECK list->cdr IS BOUND.

       lo_ptr = list->cdr->car.
       WHILE lo_ptr IS BOUND AND lo_ptr NE nil
         AND lo_ptr->car->type EQ lo_ref->type.

         CASE lo_ref->type.
           WHEN lcl_lisp=>type_number.
             IF lo_ref->number = lo_ptr->car->number.
               result = lo_ptr.
               RETURN.
             ENDIF.

           WHEN lcl_lisp=>type_symbol OR lcl_lisp=>type_string.
             IF lo_ref->value = lo_ptr->car->value.
               result = lo_ptr.
               RETURN.
             ENDIF.

           WHEN OTHERS.
             IF lo_ref = lo_ptr->car.
               result = lo_ptr.
               RETURN.
             ENDIF.
         ENDCASE.

         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
     ENDMETHOD.

     METHOD proc_memv.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_ref TYPE REF TO lcl_lisp.
       validate: list, list->car.

       result = false.
       lo_ref = list->car.
       CHECK list->cdr IS BOUND.
       lo_ptr = list->cdr->car.
       WHILE lo_ptr IS BOUND AND lo_ptr NE nil.
         IF proc_equivalence( a = lo_ptr->car
                              b = lo_ref ) NE false.
           result = lo_ptr.
           RETURN.
         ENDIF.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
     ENDMETHOD.

     METHOD proc_member.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_ref TYPE REF TO lcl_lisp.
       validate: list, list->car.

       result = false.
       lo_ref = list->car.
       CHECK list->cdr IS BOUND.
       lo_ptr = list->cdr->car.
       WHILE lo_ptr IS BOUND AND lo_ptr NE nil.
         IF proc_compare( a = lo_ptr->car
                          b = lo_ref ) NE false.
           result = lo_ptr.
           RETURN.
         ENDIF.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
     ENDMETHOD.

     METHOD proc_assq.
       throw( |In implementation| ).
       validate: list, list->car, list->cdr.
     ENDMETHOD.

     METHOD proc_assv.
       throw( |In implementation| ).
       validate: list, list->car, list->cdr.
     ENDMETHOD.

     METHOD proc_assoc.
       throw( |In implementation| ).
       validate: list, list->car, list->cdr.
     ENDMETHOD.

**********************************************************************

     METHOD proc_add.
       DATA iter TYPE REF TO lcl_lisp_iterator.
       DATA cell TYPE REF TO lcl_lisp.

       iter = lcl_lisp_iterator=>new( list ).
       result = lcl_lisp=>new_number( 0 ).

       WHILE iter->has_next( ) EQ abap_true.
         cell = iter->next( ).
         validate_number cell '[+]'.
         ADD cell->number TO result->number.
       ENDWHILE.
     ENDMETHOD.                    "proc_add

     METHOD proc_subtract.
       DATA iter TYPE REF TO lcl_lisp_iterator.
       DATA cell TYPE REF TO lcl_lisp.

       iter = lcl_lisp_iterator=>new( list ).

       cell = iter->next( ).
       validate cell.
       result = lcl_lisp=>new_number( cell->number ).

       IF iter->has_next( ) EQ abap_false.
         result->number = 0 - result->number.
       ELSE.
*        Subtract all consecutive numbers from the first
         WHILE iter->has_next( ) EQ abap_true.
           cell = iter->next( ).
           validate_number cell '[-]'.
           result->number = result->number - cell->number.
         ENDWHILE.
       ENDIF.
     ENDMETHOD.                    "proc_subtract

     METHOD proc_multiply.
       DATA iter TYPE REF TO lcl_lisp_iterator.
       DATA cell TYPE REF TO lcl_lisp.

       iter = lcl_lisp_iterator=>new( list ).
       cell = iter->next( ).
       validate cell.
       result = lcl_lisp=>new_number( cell->number ).

       WHILE iter->has_next( ) EQ abap_true.
         cell = iter->next( ).
         validate_number cell '[*]'.
         result->number = result->number * cell->number.
       ENDWHILE.
     ENDMETHOD.                    "proc_multiply

     METHOD proc_divide.
       DATA iter TYPE REF TO lcl_lisp_iterator.
       DATA cell TYPE REF TO lcl_lisp.

       iter = lcl_lisp_iterator=>new( list ).
       cell = iter->next( ).
       validate cell.
       result = lcl_lisp=>new_number( cell->number ).

       TRY.
           IF iter->has_next( ) EQ abap_false.
             result->number = 1 / result->number.
           ELSE.
             WHILE iter->has_next( ) EQ abap_true.
               cell = iter->next( ).
               validate_number cell '[/]'.
               result->number = result->number / cell->number.
             ENDWHILE.
           ENDIF.
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_divide

**********************************************************************
     METHOD proc_gt.
       _comparison <= '[>]'.
     ENDMETHOD.                    "proc_gt

     METHOD proc_gte.
       _comparison < '[>=]'.
     ENDMETHOD.                    "proc_gte

     METHOD proc_lt.
       _comparison >= '[<]'.
     ENDMETHOD.                    "proc_lt

     METHOD proc_lte.
       _comparison > '[<=]'.
     ENDMETHOD.                    "proc_lte

     METHOD proc_is_zero.
       _sign 0 '[zero?]'.
     ENDMETHOD.                    "proc_gt

     METHOD proc_is_positive.
       _sign 1 '[positive?]'.
     ENDMETHOD.                    "proc_gte

     METHOD proc_is_negative.
       _sign -1 '[negative?]'.
     ENDMETHOD.                    "proc_lt

     METHOD proc_is_odd.
       result = false.
       validate: list, list->car.
       validate_integer list->car '[odd?]'.
       CHECK list->car->number mod 2 NE 0.
       result = true.
     ENDMETHOD.                    "proc_lte

     METHOD proc_is_even.
       result = false.
       validate: list, list->car.
       validate_integer list->car '[even?]'.
       CHECK list->car->number mod 2 EQ 0.
       result = true.
     ENDMETHOD.                    "proc_lte

**********************************************************************
     METHOD proc_eql.
       DATA lo_ptr TYPE REF TO lcl_lisp.

       validate: list, list->car, list->cdr.

       result = nil.
       lo_ptr = list.
       WHILE lo_ptr->cdr NE nil.
         validate_number: lo_ptr->car '[=]',
                          lo_ptr->cdr->car '[=]'.
         IF lo_ptr->car->number = lo_ptr->cdr->car->number.
           result = true.
         ELSE.
           result = false.
           EXIT.
         ENDIF.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
     ENDMETHOD.                    "proc_eql

     METHOD proc_eq.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_ref TYPE REF TO lcl_lisp.

       validate: list, list->car, list->cdr.

       result = nil.
       lo_ptr = list.
       lo_ref = lo_ptr->car.
       WHILE lo_ptr->cdr NE nil.
         IF lo_ref->type NE lo_ptr->cdr->car->type.
           result = false.
           EXIT.
         ENDIF.
         CASE lo_ptr->car->type.
           WHEN lcl_lisp=>type_number.
             IF lo_ref->number = lo_ptr->cdr->car->number.
               result = true.
             ELSE.
               result = false.
               EXIT.
             ENDIF.

           WHEN lcl_lisp=>type_symbol OR lcl_lisp=>type_string.
             IF lo_ref->value = lo_ptr->cdr->car->value.
               result = true.
             ELSE.
               result = false.
               EXIT.
             ENDIF.
           WHEN OTHERS.
             IF lo_ref = lo_ptr->cdr->car.
               result = true.
             ELSE.
               result = false.
               EXIT.
             ENDIF.
         ENDCASE.

         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
     ENDMETHOD.                    "proc_eq

     METHOD proc_equivalence.
       validate: a, b.

       result = false.

       IF ( a EQ true AND b EQ true )
         OR ( a EQ false AND b EQ false )
         OR ( a EQ nil AND b EQ nil ).
         result = true.
         RETURN.
       ENDIF.

       CHECK a->type EQ b->type.

       CASE a->type.
         WHEN lcl_lisp=>type_number.
           CHECK a->number = b->number.
         WHEN lcl_lisp=>type_symbol OR lcl_lisp=>type_string.
           CHECK a->value = b->value.
         WHEN lcl_lisp=>type_conscell OR lcl_lisp=>type_lambda.
            CHECK a->car EQ b->car AND a->cdr EQ b->cdr.
         WHEN OTHERS.
           CHECK a = b.
       ENDCASE.
       result = true.
     ENDMETHOD.

     METHOD proc_compare.
       validate: a, b.

       result = false.
       CHECK a->type EQ b->type.

       CASE a->type.
         WHEN lcl_lisp=>type_number.
           CHECK a->number = b->number.
         WHEN lcl_lisp=>type_symbol OR lcl_lisp=>type_string.
           CHECK a->value = b->value.
         WHEN lcl_lisp=>type_conscell OR lcl_lisp=>type_lambda.
            CHECK proc_compare( a = a->car
                                b = b->car ) NE false
              AND proc_compare( a = a->cdr
                                b = b->cdr ) NE false.
         WHEN OTHERS.
           CHECK a = b.
       ENDCASE.
       result = true.
     ENDMETHOD.

     METHOD proc_equal.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_next TYPE REF TO lcl_lisp.

       validate: list, list->car.
       result = false.
       lo_ptr = list.

       WHILE lo_ptr->cdr NE nil.
         lo_next = lo_ptr->cdr->car.

         result = proc_compare( a = lo_next
                                b = lo_ptr->car ).
         IF result EQ false.
           EXIT.
         ENDIF.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.

     ENDMETHOD.                    "proc_equal

     METHOD proc_eqv.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA lo_next TYPE REF TO lcl_lisp.

       validate: list, list->car.
       result = false.

       lo_ptr = list.
       WHILE lo_ptr->cdr NE nil.
         lo_next = lo_ptr->cdr->car.

         result = proc_equivalence( a = lo_next
                                    b = lo_ptr->car ).
         IF result EQ false.
           EXIT.
         ENDIF.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.

     ENDMETHOD.

*--------------------------------------------------------------------*
*    Hash-related functions
     METHOD proc_make_hash.
       result = lcl_lisp_hash=>new_hash( list ).
     ENDMETHOD.                    "proc_make_hash

*    Get an element from a hash
     METHOD proc_hash_get.
       result = lcl_lisp_hash=>from_list( list = list
                                          msg = 'HASH-GET' )->get( list->cdr ).
     ENDMETHOD.                    "proc_hash_get

*    Insert an element into a hash
     METHOD proc_hash_insert.
       result = lcl_lisp_hash=>from_list( list = list
                                          msg = 'HASH-INSERT' )->insert( list->cdr ).
     ENDMETHOD.                    "proc_hash_insert

*    Remove an element from a hash
     METHOD proc_hash_remove.
       result = lcl_lisp_hash=>from_list( list = list
                                          msg = 'HASH-REMOVE' )->delete( list->cdr ).
     ENDMETHOD.                    "proc_hash_delete

*    Return the keys of a hash
     METHOD proc_hash_keys.
       result = lcl_lisp_hash=>from_list( list = list
                                          msg = 'HASH-KEYS' )->get_hash_keys( ).
     ENDMETHOD.                    "proc_hash_keys

     METHOD proc_is_string.
       _is_type string.
     ENDMETHOD.                    "proc_is_string

     METHOD proc_is_hash.
       _is_type hash.
     ENDMETHOD.                    "proc_is_hash

     METHOD proc_is_number.
       _is_type number.
     ENDMETHOD.                    "proc_is_number

     METHOD proc_is_symbol.
       _is_type symbol.
     ENDMETHOD.

     METHOD proc_is_list.
       DATA lo_ptr TYPE REF TO lcl_lisp.

       result = false.
       CHECK list IS BOUND.

       lo_ptr = list->car.
       WHILE lo_ptr->cdr IS BOUND AND lo_ptr->cdr NE nil.
         lo_ptr = lo_ptr->cdr.
       ENDWHILE.
       IF list EQ nil OR lo_ptr EQ NIL.
         result = true.
         RETURN.
       ENDIF.
       IF lo_ptr IS BOUND AND lo_ptr->cdr EQ nil
         AND lo_ptr->type = lcl_lisp=>type_conscell.
         result = true.
       ENDIF.
     ENDMETHOD.                    "proc_is_list

     METHOD proc_is_procedure.
       result = false.
       check list is bound        " paramater (car) must not be valid
         and list->car is bound.  " Body
       CASE list->car->type.
         WHEN lcl_lisp=>type_lambda
           OR lcl_lisp=>type_native.
         result = true.
       endcase.
     ENDMETHOD.

     METHOD proc_is_alist.
       result = proc_is_list( list ).
       throw( |Not supported yet ALIST?| ).
     ENDMETHOD.                    "proc_is_alist

     METHOD proc_is_type.
       throw( |Not supported yet IS_TYPE?| ).
     ENDMETHOD.                    "proc_is_type

     METHOD proc_abs.
       _math abs '[abs]'.
     ENDMETHOD.                    "proc_abs

     METHOD proc_sin.
       _trigonometric sin '[sin]'.
     ENDMETHOD.                    "proc_sin

     METHOD proc_cos.
       _trigonometric cos '[cos]'.
     ENDMETHOD.                    "proc_cos

     METHOD proc_tan.
       _trigonometric tan '[tan]'.
     ENDMETHOD.                    "proc_tan

     METHOD proc_asin.
       _trigonometric asin '[asin]'.
     ENDMETHOD.                    "proc_asin

     METHOD proc_acos.
       _trigonometric acos '[acos]'.
     ENDMETHOD.                    "proc_acos

     METHOD proc_atan.
       _trigonometric atan '[atan]'.
     ENDMETHOD.                    "proc_atan

     METHOD proc_sinh.
       _trigonometric sinh '[sinh]'.
     ENDMETHOD.                    "proc_sinh

     METHOD proc_cosh.
       _trigonometric cosh '[acosh]'.
     ENDMETHOD.                    "proc_cosh

     METHOD proc_tanh.
       _trigonometric tanh '[atanh]'.
     ENDMETHOD.                    "proc_tanh

     METHOD proc_asinh.
       DATA carry TYPE f.

       result = nil.
       validate: list, list->car.
       validate_number list->car '[asinh]'.
       _is_last_param list.
       TRY.
           carry = list->car->number.
           result = lcl_lisp=>new_number( log( carry + sqrt( carry ** 2 + 1 ) ) ).
          _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_asinh

     METHOD proc_acosh.
       DATA carry TYPE f.

       result = nil.
       validate: list, list->car.
       validate_number list->car '[acosh]'.
       _is_last_param list.
       TRY.
           carry = list->car->number.
           result = lcl_lisp=>new_number( log( carry + sqrt( carry ** 2 - 1 ) ) ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_acosh

     METHOD proc_atanh.
       DATA carry TYPE f.

       result = nil.
       validate: list, list->car.
       validate_number list->car '[atanh]'.
       _is_last_param list.
       TRY.
           carry = list->car->number.
           result = lcl_lisp=>new_number( ( log( 1 + carry ) - log( 1 - carry ) ) / 2 ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_atanh

     METHOD proc_expt.
       result = nil.
       validate: list, list->car, list->cdr.
       validate_number: list->car '[expt]',
                        list->cdr->car '[expt]'.
       _is_last_param list->cdr.
       TRY.
           result = lcl_lisp=>new_number( list->car->number ** list->cdr->car->number ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_expt

     METHOD proc_exp.
       _math exp '[exp]'.
     ENDMETHOD.                    "proc_exp

     METHOD proc_log.
       _math log '[log]'.
     ENDMETHOD.                    "proc_log

     METHOD proc_sqrt.
       _math sqrt '[sqrt]'.
     ENDMETHOD.                    "proc_sqrt

     METHOD proc_floor.
       _math floor '[floor]'.
     ENDMETHOD.                    "proc_floor

     METHOD proc_ceiling.
       _math ceil '[ceil]'.
     ENDMETHOD.                    "proc_ceiling

     METHOD proc_truncate.
       _math trunc '[truncate]'.
     ENDMETHOD.                    "proc_truncate

     METHOD proc_round.
       result = nil.
       validate: list, list->car.
       validate_number list->car '[round]'.
       _is_last_param list.
       TRY.
           result = lcl_lisp=>new_number( round( val = list->car->number dec = 0 ) ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_round

     METHOD proc_remainder.
       result = nil.
       validate: list, list->car, list->cdr.
       validate_number: list->car '[remainder]',
                        list->cdr->car '[remainder]'.
       _is_last_param list->cdr.
       TRY.
           result = lcl_lisp=>new_number( list->car->number -
             list->cdr->car->number * trunc( list->car->number / list->cdr->car->number ) ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_remainder

     METHOD proc_modulo.
       result = nil.
       validate: list, list->car, list->cdr.
       validate_number: list->car '[modulo]',
                        list->cdr->car '[modulo]'.
       _is_last_param list->cdr.
       TRY.
           result = lcl_lisp=>new_number( list->car->number MOD list->cdr->car->number ).
           IF sign( list->cdr->car->number ) LE 0.
             result->number = result->number + list->cdr->car->number.
           ENDIF.
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_modulo

     METHOD proc_quotient.
       result = nil.
       validate: list, list->car, list->cdr.
       validate_number: list->car '[quotient]',
                        list->cdr->car '[quotient]'.
       _is_last_param list->cdr.
       TRY.
           result = lcl_lisp=>new_number( list->car->number DIV list->cdr->car->number ).
         _catch_arithmetic_error.
       ENDTRY.
     ENDMETHOD.                    "proc_quotient

**********************************************************************
*       _                   _           _ _ _        _
*  __ _| |__   __ _ _ __   | |__  _   _(_) | |_     (_)_ __  ___
* / _` | '_ \ / _` | '_ \  | '_ \| | | | | | __|____| | '_ \/ __|
*| (_| | |_) | (_| | |_) | | |_) | |_| | | | ||_____| | | | \__ \
* \__,_|_.__/ \__,_| .__/  |_.__/ \__,_|_|_|\__|    |_|_| |_|___/
*                  |_|
**********************************************************************

     METHOD proc_abap_data.
       validate: list, list->car.

       IF list->car = nil OR ( list->car->type NE lcl_lisp=>type_string
                             AND list->car->type NE lcl_lisp=>type_symbol ).
         throw( |AB-DATA: String or symbol required as name of type| ).
       ENDIF.

       DATA lr_desc TYPE REF TO cl_abap_typedescr.
       cl_abap_typedescr=>describe_by_name( EXPORTING p_name = list->car->value

                                            RECEIVING p_descr_ref = lr_desc
                                            EXCEPTIONS OTHERS = 1 ).
       IF sy-subrc NE 0. "DESCRIBE_BY_NAME has only one exception
         throw( |AB-DATA: Type { list->car->value } not found | ).
       ENDIF.

       CASE lr_desc->kind.
         WHEN cl_abap_typedescr=>kind_table.
           result = lcl_lisp=>new_table( ).
         WHEN cl_abap_typedescr=>kind_elem OR cl_abap_typedescr=>kind_struct.
           result = lcl_lisp=>new_data( ).
         WHEN OTHERS.
           throw( |AB-DATA: Type kind { lr_desc->kind } not supported yet| ).
       ENDCASE.
*      Create data as given type
       CREATE DATA result->data TYPE (list->car->value).
*      Set value if supplied as second parameter
       IF list->cdr NE nil.
         element_to_data(
           EXPORTING
             element = list->cdr->car
           CHANGING
             data    = result->data ).
       ENDIF.
     ENDMETHOD.                    "proc_abap_data

**********************************************************************
     METHOD proc_abap_function.
       result = lcl_lisp_abapfunction=>new_function( list ).
     ENDMETHOD.                    "proc_abap_function

     METHOD proc_abap_table. "Create a table data
       validate: list, list->car.
*      First input: name of data type, second input: value
       result = lcl_lisp=>new_table( ).
       CREATE DATA result->data TYPE TABLE OF (list->car->value).
*      Set value if supplied as second parameter
       IF list->cdr NE nil.
         element_to_data( EXPORTING element = list->cdr->car
                          CHANGING data    = result->data ).
       ENDIF.
     ENDMETHOD.                    "proc_abap_table

**********************************************************************
     METHOD proc_abap_append_row.
     ENDMETHOD.                    "proc_abap_append_row

     METHOD proc_abap_delete_row.
     ENDMETHOD.                    "proc_abap_delete_row

     METHOD proc_abap_get_row.
     ENDMETHOD.                    "proc_abap_get_row

**********************************************************************
     METHOD proc_abap_get_value. "Convert ABAP to Lisp data
       DATA lx_root TYPE REF TO cx_root.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       FIELD-SYMBOLS <data> TYPE any.

       validate: list, list->car.
       lo_ptr = list->car.
       IF lo_ptr->type NE lcl_lisp=>type_abap_data AND
          lo_ptr->type NE lcl_lisp=>type_abap_table.
         throw( |AB-GET-VALUE requires ABAP data or table as parameter| ).
       ENDIF.
       TRY.
           ASSIGN lo_ptr->data->* TO <data>.
           result = data_to_element( <data> ).
         CATCH cx_root INTO lx_root.
           throw( |Mapping error: { lx_root->get_text( ) }| ).
       ENDTRY.
     ENDMETHOD.                    "proc_abap_get_value

     METHOD proc_abap_set_value. "Convert Lisp to ABAP data
       DATA lx_root TYPE REF TO cx_root.
       FIELD-SYMBOLS <data> TYPE any.

       validate: list, list->car.
       IF list->car->type NE lcl_lisp=>type_abap_data AND
          list->car->type NE lcl_lisp=>type_abap_table.
         throw( |AB-SET-VALUE requires ABAP data or table as first parameter| ).
       ENDIF.
       TRY.
           ASSIGN list->car->data->* TO <data>.
           element_to_data(
             EXPORTING
               element = list->cdr->car
             CHANGING
               data    = <data> ).
         CATCH cx_root INTO lx_root.
           throw( |Mapping error: { lx_root->get_text( ) }| ).
       ENDTRY.
       result = nil. "TODO: What should we return here?
     ENDMETHOD.                    "proc_abap_set_value

**********************************************************************
     METHOD proc_abap_function_call. "Called internally only for execution of function module
       DATA lo_func TYPE REF TO lcl_lisp_abapfunction.
       DATA lx_root TYPE REF TO cx_root.

       validate: list, list->car.
*      The first parameter must be a function module instance
       IF list->car->type NE lcl_lisp=>type_abap_function.
         throw( |{ list->car->value } is not a function module reference| ).
       ENDIF.

       TRY.
           lo_func ?= list->car.
           result = lo_func->call( list->car ).
         CATCH cx_root INTO lx_root.
           throw( |Function call error: { lx_root->get_text( ) }| ).
       ENDTRY.
     ENDMETHOD.                    "proc_abap_function_call

     METHOD create_element_from_data.
       DATA lo_ddesc TYPE REF TO cl_abap_typedescr.

*      Perform RTTI on determined data and generate appropriate response
       lo_ddesc = cl_abap_typedescr=>describe_by_data_ref( ir_data ).
       CASE lo_ddesc->kind.
         WHEN cl_abap_typedescr=>kind_table.
           result = lcl_lisp=>new_table( ir_data ).
         WHEN cl_abap_typedescr=>kind_struct.
           result = lcl_lisp=>new_data( ir_data ).
         WHEN cl_abap_typedescr=>kind_elem.
*          Give back immediate value
           FIELD-SYMBOLS <value> TYPE any.

           ASSIGN ir_data->* TO <value>.
           result = data_to_element( <value> ).
         WHEN OTHERS.
           throw( |AB-GET: Type kind { lo_ddesc->kind } not supported yet| ). "Can do AB-TAB-WHERE some other time
       ENDCASE.
     ENDMETHOD.                    "create_element_from_data

     METHOD proc_abap_get.
       DATA lr_data TYPE REF TO data.

*      Ensure a valid first parameter is passed
       IF list->car->type NE lcl_lisp=>type_abap_data
         AND list->car->type NE lcl_lisp=>type_abap_function
         AND list->car->type NE lcl_lisp=>type_abap_table.
         throw( |AB-GET: First parameter must be ABAP data or table or a function| ).
       ENDIF.

*      Determine whether the data is elementary or not to decide if we need to get the element by identifier
       IF list->car->data IS NOT INITIAL AND
         cl_abap_typedescr=>describe_by_data_ref( list->car->data )->kind = cl_abap_typedescr=>kind_elem.
*        Elementary type; can return the value without mapping
         lr_data = list->car->data.
       ELSE.
*        Could short-cut here and provide the value right away
         IF list->cdr = nil.
           throw( |AB-GET: Complex type requires identifier for lookup| ).
         ELSE.
           lr_data = get_element( list ).
         ENDIF.
       ENDIF.

       result = create_element_from_data( lr_data ).

     ENDMETHOD. "proc_abap_get

     METHOD proc_abap_set.
       DATA lr_target TYPE REF TO data.              " Target data
       DATA lo_source TYPE REF TO lcl_lisp.          " Source element
       DATA lo_ddesc TYPE REF TO cl_abap_typedescr.
       FIELD-SYMBOLS <target> TYPE any.
       FIELD-SYMBOLS <source> TYPE any.

*      Ensure a valid first parameter is passed
       IF list->car->type NE lcl_lisp=>type_abap_data
          AND list->car->type NE lcl_lisp=>type_abap_function
          AND list->car->type NE lcl_lisp=>type_abap_table.
         throw( |AB-SET: First parameter must be ABAP data or table or a function| ).
       ENDIF.

*      Determine whether the data is elementary or not to decide if we need to get the element by identifier
       IF list->car->data IS NOT INITIAL AND cl_abap_typedescr=>describe_by_data_ref( list->car->data )->kind = cl_abap_typedescr=>kind_elem.
*        Elementary type; can return the value without mapping
         lr_target = list->car->data.
         lo_source = list->cdr->car.
*        lo_sdata = list->cdr->car->data. "Value to set is second argument
       ELSEIF list->cdr = nil.
         throw( |AB-SET: Complex type requires identifier for lookup| ).
       ELSE.
         lr_target = get_element( list ).
*       lr_sdata = list->cdr->cdr->car->data. "Value to set is third argument
         lo_source = list->cdr->cdr->car.
       ENDIF.

* Do we just assign the reference now? Probably should dereference source value
* and copy the value...
*      Perform RTTI on determined data and generate appropriate response
       ASSIGN lr_target->* TO <target>.

*      For elementary types, set value from second parameter, otherwise third
       IF cl_abap_typedescr=>describe_by_data( <target> )->kind = cl_abap_typedescr=>kind_elem.
*        For now, we will support setting data from a number, string or symbol
         CASE lo_source->type.
           WHEN lcl_lisp=>type_string OR lcl_lisp=>type_symbol.
             <target> = lo_source->value.
           WHEN lcl_lisp=>type_number.
             <target> = lo_source->number.
         ENDCASE.
       ELSE.
*        Complex types will just copy the whole value across
         ASSIGN lo_source->data->* TO <source>.
         <target> = <source>.                        "Set the value
       ENDIF.

       result = nil.

     ENDMETHOD. "proc_abap_set

     METHOD structure_to_element.
       DATA lo_conscell TYPE REF TO lcl_lisp. " Lisp-side (target)
       FIELD-SYMBOLS <field> TYPE any.

       lo_conscell = element = lcl_lisp=>new_cons( ).
       DO.
         ASSIGN COMPONENT sy-index OF STRUCTURE struct TO <field>.
         IF sy-subrc NE 0.
           lo_conscell->cdr = nil. "Terminate list
           EXIT.
         ENDIF.
         IF sy-index > 1.          "Move pointer only from second field onward
           lo_conscell = lo_conscell->cdr = lcl_lisp=>new_cons( ).
         ENDIF.
         lo_conscell->car = data_to_element( <field> ).
       ENDDO.
     ENDMETHOD.                    "structure_to_element

     METHOD data_to_element.
*      Map ABAP Data to Lisp element
       DATA lr_ddesc TYPE REF TO cl_abap_typedescr.   " RTTI
       FIELD-SYMBOLS <table> TYPE ANY TABLE.          " ABAP-side (source)
       DATA line TYPE REF TO data.

*      Determine type of the ABAP value
       lr_ddesc = cl_abap_typedescr=>describe_by_data( data ).
       CASE lr_ddesc->kind.

         WHEN cl_abap_typedescr=>kind_table.
*          Table type
           FIELD-SYMBOLS <line> TYPE any.

           ASSIGN data TO <table>.
           CREATE DATA line LIKE LINE OF <table>.
           ASSIGN line->* TO <line>.

           IF <table> IS INITIAL.
             element = nil.
           ELSE.
             DATA lo_conscell TYPE REF TO lcl_lisp. " Lisp-side  (target)

*            Create list with cell for each row AND Set pointer to start of list
             lo_conscell = element = lcl_lisp=>new_cons( ).
             LOOP AT <table> INTO <line>.
               IF sy-tabix > 1.          "Move pointer only from second line onward
                 lo_conscell = lo_conscell->cdr = lcl_lisp=>new_cons( ).
               ENDIF.
               lo_conscell->car = data_to_element( <line> ).
             ENDLOOP.
             lo_conscell->cdr = nil.     "Terminate list
           ENDIF.

         WHEN cl_abap_typedescr=>kind_struct.
           element = structure_to_element( data ).

         WHEN cl_abap_typedescr=>kind_elem.
*          Elementary type
           IF lr_ddesc->type_kind = cl_abap_typedescr=>typekind_numeric OR
              lr_ddesc->type_kind = cl_abap_typedescr=>typekind_num.
             element = lcl_lisp=>new_number( data ).
           ELSE.
             element = lcl_lisp=>new_string( data ).
           ENDIF.
       ENDCASE.
     ENDMETHOD.                    "data_to_element

*    Map Lisp element to ABAP Data
     METHOD element_to_data.
*      RTTI-relevant:
       DATA lr_ddesc TYPE REF TO cl_abap_typedescr.
       DATA lr_tdesc TYPE REF TO cl_abap_tabledescr.
*      ABAP-side (target) mapping:
       FIELD-SYMBOLS <field> TYPE any.
       FIELD-SYMBOLS <line> TYPE any.
       FIELD-SYMBOLS <table> TYPE ANY TABLE.
       FIELD-SYMBOLS <sotab> TYPE SORTED TABLE.
       FIELD-SYMBOLS <sttab> TYPE STANDARD TABLE.
       "       DATA field TYPE REF TO data.
       DATA line TYPE REF TO data.
       DATA table TYPE REF TO data.
*      Lisp-side (source) mapping:
       DATA lr_conscell TYPE REF TO lcl_lisp.

*      Determine type of the ABAP value
       lr_ddesc = cl_abap_typedescr=>describe_by_data( data ).
       CASE lr_ddesc->kind.
*        Table type
         WHEN cl_abap_typedescr=>kind_table.
*          For this mapping to happen, the element must be a cons cell
           IF element->type NE lcl_lisp=>type_conscell.
             throw( |Mapping failed: Non-cell to table| ).
           ENDIF.
*          Provide reference to table and line
           lr_tdesc ?= lr_ddesc.
           GET REFERENCE OF data INTO table.
           ASSIGN table->* TO <table>.
           IF lr_tdesc->table_kind = cl_abap_tabledescr=>tablekind_sorted OR
              lr_tdesc->table_kind = cl_abap_tabledescr=>tablekind_hashed.
             ASSIGN table->* TO <sotab>. "Sorted table type
             CREATE DATA line LIKE LINE OF <sotab>.
           ELSE.
             ASSIGN table->* TO <sttab>. "Standard table type
             CREATE DATA line LIKE LINE OF <sttab>.
           ENDIF.
           ASSIGN line->* TO <line>.

           lr_conscell = element. "Set pointer to start of list
           DO.
             element_to_data( EXPORTING element = lr_conscell->car
                              CHANGING data    = <line> ).
*            Append or insert, depending on table type (what is assigned)
             IF <sotab> IS ASSIGNED.
               INSERT <line> INTO TABLE <sotab>.
             ELSE.
               APPEND <line> TO <sttab>.
             ENDIF.
             CLEAR <line>.
             lr_conscell = lr_conscell->cdr.
             IF lr_conscell = nil.
               EXIT.
             ENDIF.
           ENDDO.

         WHEN cl_abap_typedescr=>kind_struct.
*          Structure
           IF element->type NE lcl_lisp=>type_conscell.
             throw( |Mapping failed: Non-cell to structure| ).
           ENDIF.

           lr_conscell = element. "Set pointer to start of list
           ASSIGN data TO <line>.
           DO.
             ASSIGN COMPONENT sy-index OF STRUCTURE <line> TO <field>.
             IF sy-subrc NE 0.
               EXIT.
             ENDIF.

             IF sy-index > 1. "Move cons cell pointer only from second element on
               lr_conscell = lr_conscell->cdr.
             ENDIF.
*            Don't map nil values
             CHECK lr_conscell->car NE nil.

             element_to_data( EXPORTING element = lr_conscell->car
                              CHANGING data    = <field> ).
           ENDDO.

         WHEN cl_abap_typedescr=>kind_elem.
*          Elementary type
           ASSIGN data TO <field>.
           IF element->type = lcl_lisp=>type_number.
             <field> = element->number.
           ELSE.
             <field> = element->value.
           ENDIF.

         WHEN OTHERS.
*          Not supported yet
           throw( |Mapping failed: unsupported type| ).
       ENDCASE.
     ENDMETHOD.                    "element_to_data

     METHOD get_structure_field.
       FIELD-SYMBOLS <value> TYPE any.
       FIELD-SYMBOLS <struct> TYPE any.

       IF identifier = nil OR
         ( identifier->type NE lcl_lisp=>type_string AND identifier->type NE lcl_lisp=>type_symbol ).
         throw( `AB-GET: String or symbol required to access structure field` ).
       ENDIF.

       ASSIGN element->data->* TO <struct>.
       ASSIGN COMPONENT identifier->value OF STRUCTURE <struct> TO <value>.
       IF sy-subrc NE 0.
         throw( |AB-GET: Structure has no component { identifier->value }| ).
       ENDIF.
       GET REFERENCE OF <value> INTO rdata.
     ENDMETHOD.                    "get_structure_field

     METHOD get_index_table_row.
*      Second input for reading an index table must be a number (row index)
       FIELD-SYMBOLS <idxtab> TYPE INDEX TABLE.

       IF identifier = nil OR identifier->type NE lcl_lisp=>type_number.
         throw( |AB-GET: Numeric index required to read index table| ). "Can do AB-TAB-WHERE some other time
       ENDIF.
       ASSIGN element->data->* TO <idxtab>.
       READ TABLE <idxtab> REFERENCE INTO rdata INDEX identifier->number.
       CHECK sy-subrc NE 0.
       throw( |AB-GET: No entry at index { identifier->number }| ). "Can do AB-TAB-WHERE some other time
     ENDMETHOD.                    "get_index_table_row

     METHOD get_table_row_with_key.
       "" IMPORTING element    TYPE REF TO lcl_lisp
*          TODO: Read with key, which is a bit more effort
       rdata = get_index_table_row( element = element
                                    identifier = identifier ).
     ENDMETHOD.                    "get_table_row_with_key

     METHOD get_element.
*     RDATA <- Data reference to value pointed to
       DATA element TYPE REF TO lcl_lisp.
       DATA identifier TYPE REF TO lcl_lisp.
*    ELEMENT -> Lisp element containing an ABAP value (data, table or function)
*    IDENTIFIER -> Lisp element, string or symbol or index, to identify subcomponent of value
       element = list->car.
       identifier = list->cdr->car.

       IF element->type = lcl_lisp=>type_abap_function.
*        Get function parameter by name
         DATA lo_func TYPE REF TO lcl_lisp_abapfunction.

         lo_func ?= element.
         rdata = lo_func->get_function_parameter( identifier ).
       ELSE.
         DATA lo_ddesc TYPE REF TO cl_abap_typedescr.
         DATA lo_tdesc TYPE REF TO cl_abap_tabledescr.

*        First parameter is not function, but table or other data; examine the data
         lo_ddesc = cl_abap_typedescr=>describe_by_data_ref( element->data ).

         CASE lo_ddesc->kind.
           WHEN cl_abap_typedescr=>kind_struct.
*            Structure: Use second parameter as field name
             rdata = get_structure_field( element = element
                                          identifier = identifier ).
           WHEN cl_abap_typedescr=>kind_elem.
*            Elementary data: No qualifier / second parameter required
             rdata = element->data.

           WHEN cl_abap_typedescr=>kind_table.
*            Table: Second parameter is index (std table) or key (sorted table)
             lo_tdesc ?= lo_ddesc.

             CASE lo_tdesc->table_kind.
               WHEN cl_abap_tabledescr=>tablekind_sorted
                 OR cl_abap_tabledescr=>tablekind_hashed.
                 rdata = get_table_row_with_key( element = element
                                                 identifier = identifier ).

               WHEN cl_abap_tabledescr=>tablekind_std.
                 "OR cl_abap_tabledescr=>tablekind_index.  - No Test data for this case yet
                 rdata = get_index_table_row( element = element
                                              identifier = identifier ).
             ENDCASE.

         ENDCASE.

       ENDIF.
     ENDMETHOD. "get_element

   ENDCLASS.                    "lcl_lisp_interpreter IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_abapfunction IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_abapfunction IMPLEMENTATION.

     METHOD read_interface.
*      Determine the parameters of the function module to populate parameter table
*  TODO: At the moment, we do not support reference types in function module interfaces
       function_name = iv_name.          "Name of function module
       parameters_generated = abap_false.

*      Read the function module interface
       CALL FUNCTION 'FUNCTION_IMPORT_INTERFACE'
         EXPORTING
           funcname           = function_name  " Name of the function module
           with_enhancements  = 'X'            " X = Enhancement Parameters Will Be Provided
*          ignore_switches    = SPACE           " X = Switches Are Ignored
         IMPORTING
           REMOTE_CALL        = interface-REMOTE_CALL
           UPDATE_TASK        = interface-UPDATE_TASK
         TABLES
           exception_list     = interface-exc
           export_parameter   = interface-exp
           import_parameter   = interface-imp
           changing_parameter = interface-cha
           tables_parameter   = interface-tbl
           ENHA_EXP_PARAMETER = interface-enh_exp
           ENHA_IMP_PARAMETER = interface-enh_imp
           ENHA_CHA_PARAMETER = interface-enh_cha
           ENHA_TBL_PARAMETER = interface-enh_tbl
         EXCEPTIONS
           error_message      = 1
           function_not_found = 2
           invalid_name       = 3
           OTHERS             = 4.
       IF sy-subrc <> 0.
         throw( |Function { function_name }: { error_message( ) }| ).
       ENDIF.
     ENDMETHOD.                    "read_interface

     METHOD new_function.
       validate: list, list->car.

       ro_func ?= new( type_abap_function ).
*      Determine the parameters of the function module to populate parameter table
       ro_func->value = ro_func->read_interface( list->car->value ).
*(let (( profiles
*        (let ( (f3 (ab-function "BAPI_USER_GET_DETAIL"))  )
*        ( begin (ab-set f3 "USERNAME" (ab-get ab-sy "UNAME") )
*                  (f3) (ab-get f3 "PROFILES")  ) )
*        ) )
*   (let ((profile (ab-get profiles 1)) )
*             (ab-get profile "BAPIPROF" )  )
     ENDMETHOD.                    "new_function
*(define bapi-userdetail (ab-function "BAPI_USER_GET_DETAIL"))  ;; Assign interface of BAPI_USER_GET_DETAIL to a symbol
*(ab-set bapi-userdetail "USERNAME" (ab-get ab-sy "UNAME"))     ;; Set parameter "USERNAME" to current user

   METHOD call.
     DATA lv_message TYPE string.

     create_parameters( list ).
*TODO: Map given list to parameters of function module
*      First parameter: Name of function to call;
*      second parameter: data to pass to interface
     CALL FUNCTION list->value
         PARAMETER-TABLE parameters
         EXCEPTION-TABLE exceptions.

     IF sy-subrc EQ c_error_message.
       throw( |Call { list->value }: { error_message( ) }| ).
     ENDIF.
*    Map output parameters to new list
     ro_elem = list.      "Function reference is updated with values after call
   ENDMETHOD.                    "call

   METHOD error_message.
     MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno    "#EC *
        WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
        INTO rv_message.
   ENDMETHOD.

   METHOD get_function_parameter.
*    Get function parameter by name
     DATA ls_param TYPE abap_func_parmbind.

*    IDENTIFIER -> Lisp element, string or symbol or index, to identify subcomponent of value
     IF identifier = nil OR
       ( identifier->type NE lcl_lisp=>type_string AND identifier->type NE lcl_lisp=>type_symbol ).
       throw( `AB-GET: String or symbol required to access function parameter` ).
     ENDIF.

     create_parameters( nil ).

     READ TABLE parameters INTO ls_param WITH KEY name = identifier->value.
     IF sy-subrc NE 0.
       throw( |AB-GET: No parameter { identifier->value } in function| ).
     ENDIF.
     rdata = ls_param-value.
   ENDMETHOD.                    "get_function_parameter

   METHOD create_table_params.
*    Create structures in parameter - TABLES
     DATA ls_table TYPE rstbl.
     DATA ls_par TYPE abap_func_parmbind.
     DATA lv_type TYPE RS38L_TYP.

     ls_par-kind = abap_func_tables.
     LOOP AT it_table INTO ls_table.

       IF ls_table-typ IS INITIAL.
         lv_type = ls_table-dbstruct.
       ELSE.
         lv_type = ls_table-typ.
       ENDIF.
       CREATE DATA ls_par-value TYPE TABLE OF (lv_type).
       CREATE DATA ls_par-tables_wa TYPE (lv_type).

       ls_par-name = ls_table-parameter.
       INSERT ls_par INTO TABLE parameters.
     ENDLOOP.
   ENDMETHOD.

   METHOD create_params.
     DATA ls_params TYPE ts_params.
     FIELD-SYMBOLS <row>   TYPE any.
     DATA ls_par TYPE abap_func_parmbind.
     DATA lv_type TYPE RS38L_TYP.

     ls_par-kind = iv_kind.
     LOOP AT it_table ASSIGNING <row>.
       MOVE-CORRESPONDING <row> TO ls_params.

       lv_type = 'TEXT100'.   "Fallback for untyped parameters
       IF ls_params-dbfield IS NOT INITIAL.
         lv_type = ls_params-dbfield.
       ELSEIF ls_params-typ IS NOT INITIAL.
         lv_type = ls_params-typ.
       ENDIF.
       CREATE DATA ls_par-value TYPE (lv_type).

       ls_par-name = ls_params-parameter.
       INSERT ls_par INTO TABLE parameters.
     ENDLOOP.
   ENDMETHOD.

   METHOD create_parameters.
     CHECK parameters_generated EQ abap_false.

     create_exceptions( ).
*    Tables
     create_table_params( interface-tbl ).         "    input TABLES parameter
     create_table_params( interface-enh_tbl ).
*    Import
     create_params( it_table = interface-imp
                    iv_kind = abap_func_exporting ).
     create_params( it_table = interface-enh_imp
                    iv_kind = abap_func_exporting ).
*    Export
     create_params( it_table = interface-exp
                    iv_kind = abap_func_importing ).
     create_params( it_table = interface-enh_exp
                    iv_kind = abap_func_importing ).
*    Changing
     create_params( it_table = interface-cha
                    iv_kind = abap_func_changing ).
     create_params( it_table = interface-enh_cha
                    iv_kind = abap_func_changing ).

     parameters_generated = abap_true.
   ENDMETHOD.

   METHOD create_exceptions.
     DATA ls_exc TYPE abap_func_excpbind.

     CLEAR exceptions.
     ls_exc-name = 'OTHERS'.
     ls_exc-value = 10.
     INSERT ls_exc INTO TABLE exceptions.
     ls_exc-name = 'error_message'.
     ls_exc-value = c_error_message.
     INSERT ls_exc INTO TABLE exceptions.
   ENDMETHOD.

 ENDCLASS.                    "lcl_lisp_abapfunction IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_environment IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_environment IMPLEMENTATION.

     METHOD new.
       CREATE OBJECT ro_env.
       ro_env->outer = io_outer.
     ENDMETHOD.                    "new

     METHOD unbound_symbol.
       RAISE EXCEPTION TYPE lcx_lisp_eval_err
         EXPORTING
           message = |Symbol { symbol } is unbound|.
     ENDMETHOD.                    "unbound_symbol

     METHOD find.
*      find the environment where the symbol is defined
       READ TABLE map TRANSPORTING NO FIELDS WITH KEY symbol = symbol.
       IF sy-subrc EQ 0.
         env = me.            " found in current environment
       ELSEIF outer IS BOUND.
         env = outer->find( symbol ).
       ELSE.
         unbound_symbol( symbol ).
       ENDIF.
     ENDMETHOD.                    "find

     METHOD lookup.
*      Lookup a value in the environment
       DATA ls_map TYPE ts_map.
       READ TABLE map INTO ls_map             " Try locate the symbol
         WITH KEY symbol = symbol.            " in current environment
       IF sy-subrc = 0.
         cell = ls_map-value.
       ELSEIF outer IS BOUND.                 " or
         cell = outer->lookup( symbol ).      " in the parent (outer) environment
       ENDIF.
       CHECK cell IS NOT BOUND.
       unbound_symbol( symbol ).
     ENDMETHOD.                    "find

     METHOD define_value.
       element = lcl_lisp=>new_elem( type = type
                                     value = value ).
       define( symbol = symbol
               element = element ).
     ENDMETHOD.                    "define_cell

     METHOD define.
*      Add a value to the (local) environment
       DATA ls_map TYPE ts_map.
       ls_map-symbol = symbol.
       ls_map-value = element.
       INSERT ls_map INTO TABLE map.
       IF sy-subrc = 4.                  " To comply with Scheme define,
         MODIFY TABLE map FROM ls_map.   " overwrite existing defined values
       ENDIF.
     ENDMETHOD.                    "define

     METHOD parameters_to_symbols.
*      The lambda receives its own local environment in which to execute,
*      where parameters become symbols that are mapped to the corresponding arguments
*      Assign each argument to its corresponding symbol in the newly created environment
       DATA lo_par TYPE REF TO lcl_lisp. " Parameter
       DATA lo_arg TYPE REF TO lcl_lisp. " Argument
       DATA lv_count TYPE i.

       lo_par = io_pars.                      " Pointer to formal parameters
       lo_arg = io_args.                      " Pointer to arguments
       WHILE lo_par NE lcl_lisp=>nil.         " Nil would mean no parameters to map
         IF lo_arg = lcl_lisp=>nil.           " Premature end of arguments
           lcl_lisp=>throw( |Missing parameter(s) { lo_par->to_string( ) }| ).
         ENDIF.

         ADD 1 TO lv_count.
*        NOTE: Each element of the argument list is evaluated before being defined in the environment
         define( symbol = lo_par->car->value
                 element = lo_arg->car ).

         lo_par = lo_par->cdr.
         lo_arg = lo_arg->rest( ).
       ENDWHILE.

       IF lo_arg NE lcl_lisp=>nil.  " Excessive number of arguments
         lcl_lisp=>throw( |Expected { lv_count } parameter(s), found { io_args->to_string( ) }| ).
       ENDIF.
     ENDMETHOD.                    "parameters_to_symbols

   ENDCLASS.                    "lcl_lisp_environment IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_profiler DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_profiler DEFINITION INHERITING FROM lcl_lisp_interpreter.
     PUBLIC SECTION.
       METHODS eval_repl REDEFINITION.
       DATA runtime TYPE i READ-ONLY.
   ENDCLASS.                    "lcl_lisp_profiler DEFINITION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_profiler IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_profiler IMPLEMENTATION.

     METHOD eval_repl.
       DATA lv_begin TYPE i.
       DATA lv_end   TYPE i.

       GET RUN TIME FIELD lv_begin.               " Start timer
       response = super->eval_repl( code ).       " Evaluate given code
       GET RUN TIME FIELD lv_end.                 " Stop time

       runtime = lv_end - lv_begin.
     ENDMETHOD.                    "eval_repl

   ENDCLASS.                    "lcl_lisp_profiler IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp IMPLEMENTATION.

     METHOD class_constructor.
       nil  = lcl_lisp=>new_symbol( 'nil' ).
       false  = lcl_lisp=>new_symbol( 'false' ).
       true  = lcl_lisp=>new_symbol( 'true' ).
     ENDMETHOD.                    "class_constructor

     METHOD first.
       IF car IS BOUND.
         ro_car = car.
       ELSE.
         ro_car = nil.
       ENDIF.
     ENDMETHOD.                    "first

     METHOD rest.
       IF cdr IS BOUND.
         ro_cdr = cdr.
       ELSE.
         ro_cdr = nil.
       ENDIF.
     ENDMETHOD.                    "rest

     METHOD new.
       CASE type.
         WHEN type_hash.
           CREATE OBJECT ro_elem TYPE lcl_lisp_hash.
         WHEN type_abap_function.
           CREATE OBJECT ro_elem TYPE lcl_lisp_abapfunction.
         WHEN OTHERS.
           CREATE OBJECT ro_elem TYPE lcl_lisp.
       ENDCASE.
       ro_elem->type = type.
       ro_elem->car = io_car.
       ro_elem->cdr = io_cdr.
     ENDMETHOD.                    "new

     METHOD new_elem.
       CASE type.
         WHEN type_number.
           ro_elem = new( type ).
           ro_elem->number = value.
*         WHEN type_abap_data OR type_abap_table.
*           ro_elem = new( type ).
*           ro_elem->data = ref.
         WHEN OTHERS.
           ro_elem = new( type ).
           ro_elem->value = value.
       ENDCASE.
     ENDMETHOD.                    "new_elem

     METHOD new_string.
       ro_elem = new_elem( type = type_string
                           value = value ).
     ENDMETHOD.                    "new_string

     METHOD new_symbol.
       ro_elem = new_elem( type = type_symbol
                           value = value ).
     ENDMETHOD.                    "new_symbol

     METHOD new_atom.
       DATA lv_num TYPE decfloat34.
*      Check whether the token can be converted to a float, to cover all
*      manner of number formats, including scientific, otherwise treat it
*      as a symbol (but we still store it as a string to preserve the original value
*      and let the ABAP kernel do the heavy lifting later on)
       TRY.
           MOVE EXACT value TO lv_num  ##needed. "If this passes, it's a number
           ro_elem = new_number( value ).
         CATCH cx_sy_conversion_no_number.
           ro_elem = new_symbol( value ).
       ENDTRY.
     ENDMETHOD.                    "new_atom

     METHOD new_number.
       ro_elem = new_elem( type = type_number
                           value = value ).
     ENDMETHOD.                    "new_number

     METHOD new_data.
       ro_elem = new( type_abap_data ).
       ro_elem->data = ref.
     ENDMETHOD.                    "new_data

     METHOD new_table.
       ro_elem = new( type_abap_table ).
       ro_elem->data = ref.
     ENDMETHOD.                    "new_table

     METHOD new_cons.
       ro_cons = new( type = type_conscell
                      io_car = io_car
                      io_cdr = io_cdr ).
     ENDMETHOD.                    "new_cons

     METHOD new_lambda.
*      The lambda is a special cell that stores a pointer to a list of parameters
*      and a pointer to a list which is the body to be evaluated later on
       ro_lambda = new( type = type_lambda
                        io_car = io_car                         " List of parameters
                        io_cdr = io_cdr ).                      " Body
*      Store the reference to the environment in which the lambda was created
*      (lexical scope) e.g. if the lambda is created inside another lambda
*      we want that environment to be present when we evaluate the new lambda
       ro_lambda->environment = io_env.
     ENDMETHOD.                    "new_lambda

     METHOD list_to_string.
       DATA lo_elem TYPE REF TO lcl_lisp.

       str = c_open_paren.
       lo_elem = me.
       WHILE ( lo_elem IS BOUND AND lo_elem NE nil ).
         IF lo_elem->type NE type_conscell.               " If item is not a cons cell,
           str = |{ str } . { lo_elem->to_string( ) }|.   " indicate with dot notation:
         ELSE.
           str = |{ str } { lo_elem->car->to_string( ) }|.
         ENDIF.
         lo_elem = lo_elem->cdr.
       ENDWHILE.

       str = |{ str } { c_close_paren }|.
     ENDMETHOD.                    "list_to_string

     METHOD to_string.
       CASE type.
         WHEN type_lambda.
           str = |<lambda> { car->list_to_string( ) }|.
         WHEN type_symbol.
           str = value.
         WHEN type_string.
*        TODO: Other Lisp REPLs give back the string as a quoted string
           str = value.
         WHEN type_number.
           str = number.
         WHEN lcl_lisp=>type_native.
           str = '<native>'.
         WHEN type_conscell.
           str = list_to_string( ).
         WHEN type_hash.
           str = '<hash>'.
*--------------------------------------------------------------------*
*        Additions for ABAP Types:
         WHEN type_abap_function.
           str = |<ABAP function module { value }>|.
         WHEN type_abap_class.
           str = |<ABAP class { value }>|.
         WHEN type_abap_method.
*          TODO
*           str = |<ABAP method { car->value }->{ cdr->value }( ) >|.
         WHEN type_abap_data.
           str = |<ABAP Data>|.
         WHEN type_abap_table.
           str = |<ABAP Table>|.
       ENDCASE.
     ENDMETHOD.                    "to_string

     METHOD throw.
       RAISE EXCEPTION TYPE lcx_lisp_eval_err
         EXPORTING
           message = message.
     ENDMETHOD.                    "eval_err

   ENDCLASS.                    "lcl_lisp IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_iterator IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_iterator IMPLEMENTATION.

     METHOD new.
       IF io_elem IS NOT BOUND.
         lcl_lisp=>throw( |Iterator: Invalid head of list| ).
       ENDIF.
       CREATE OBJECT ro_iter.
       ro_iter->elem = io_elem.
       ro_iter->first = abap_true.
     ENDMETHOD.                    "new

     METHOD has_next.
       rv_flag = boolc( first EQ abap_true
                     OR ( elem->cdr IS BOUND AND elem->cdr NE lcl_lisp=>nil ) ).
     ENDMETHOD.                    "has_next

     METHOD next.
       IF first EQ abap_true.
         first = abap_false.
       ELSE.
         IF elem->cdr->type NE lcl_lisp=>type_conscell.
           lcl_lisp=>throw( |{ elem->to_string( ) } is not a proper list| ).
         ENDIF.
         elem = elem->cdr.
       ENDIF.
       ro_elem = elem->car.
     ENDMETHOD.                    "next

   ENDCLASS.                    "lcl_lisp_iterator IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS lcl_lisp_hash IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_lisp_hash IMPLEMENTATION.

     METHOD new_hash.
       DATA lo_iter TYPE REF TO lcl_lisp_iterator.
       DATA lo_ptr TYPE REF TO lcl_lisp.
       DATA ls_entry TYPE ts_hash.

       validate: list, list->car.
       ro_elem ?= new( type_hash ).
       CHECK list->car->type = type_conscell.

*      Can accept a parameter which should be a list of alternating symbols/strings and elements
       lo_iter = lcl_lisp_iterator=>new( list->car ).
       WHILE lo_iter->has_next( ) EQ abap_true.
         lo_ptr = lo_iter->next( ).
         IF lo_ptr->type NE type_symbol AND lo_ptr->type NE type_string.
           throw( |MAKE-HASH: Use only symbol or string as a key| ).
         ENDIF.
         CHECK lo_iter->has_next( ) EQ abap_true.
         ls_entry-key = lo_ptr->value.
         ls_entry-element = lo_iter->next( ).
         INSERT ls_entry INTO TABLE ro_elem->hash.
       ENDWHILE.
     ENDMETHOD.                    "new_hash

     METHOD get.
       DATA ls_entry TYPE ts_hash.

       validate: list, list->car.
       IF list->car = nil.
         throw( |HASH-GET requires a key to access an element| ).
       ENDIF.

*      TODO: Additional check for key type
       READ TABLE hash INTO ls_entry WITH KEY key = list->car->value.
       IF sy-subrc = 0.
         result = ls_entry-element.
       ELSE.
         result = nil.
       ENDIF.
     ENDMETHOD.                    "get

     METHOD insert.
       DATA ls_entry TYPE ts_hash.
       validate: list, list->car, list->cdr.

* TODO: Check number and type of parameters
       ls_entry-key = list->car->value.
       ls_entry-element = list->cdr->car.
       INSERT ls_entry INTO TABLE hash.
* TODO: Should we overwrite existing keys?
       result = nil.
     ENDMETHOD.                    "insert

     METHOD delete.
       validate: list, list->car.
* TODO: Check number and type of parameters
       DELETE hash WHERE key = list->car->value.
       result = nil.
     ENDMETHOD.                    "delete

     METHOD get_hash_keys.
       DATA ls_entry TYPE ts_hash.
       DATA lo_last TYPE REF TO lcl_lisp.
       DATA lo_ptr TYPE REF TO lcl_lisp.

       result = nil.
       LOOP AT hash INTO ls_entry.
         lo_last = new_cons( io_car = new_symbol( ls_entry-key ) ).

         IF result EQ nil.
           result = lo_ptr = lo_last.
         ELSE.
           lo_ptr = lo_ptr->cdr = lo_last.
         ENDIF.
       ENDLOOP.
     ENDMETHOD.                    "get_hash_keys

     METHOD from_list.
       validate: list, list->car.
       IF list->car->type NE type_hash.
         throw( |{ msg } only works on hashes| ).
       ENDIF.
       ro_hash ?= list->car.
     ENDMETHOD.                    "from_list

   ENDCLASS.                    "lcl_lisp_hash IMPLEMENTATION
Error rendering macro 'code': Invalid value specified for parameter 'lang'
 
*&---------------------------------------------------------------------*
*&  Include           YY_LISP_AUNIT
*&---------------------------------------------------------------------*
*& ported from ZUSR_LISP_TEST by JNN (www.informatik-dv.com)

*&---------------------------------------------------------------------*
*& https://github.com/mydoghasworms/abap-lisp
*& Tests for the Lisp interpreter written in ABAP
*& Copy and paste this code into a type 1 (report) program, making sure
*& the necessary dependencies are met
*&---------------------------------------------------------------------*
*& Martin Ceronio, martin.ceronio@infosize.co.za
*& June 2015
*& MIT License (see below)
*&---------------------------------------------------------------------*
*  The MIT License (MIT)
*
*  Copyright (c) 2015 Martin Ceronio
*
*  Permission is hereby granted, free of charge, to any person obtaining a copy
*  of this software and associated documentation files (the "Software"), to deal
*  in the Software without restriction, including without limitation the rights
*  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
*  copies of the Software, and to permit persons to whom the Software is
*  furnished to do so, subject to the following conditions:
*
*  The above copyright notice and this permission notice shall be included in
*  all copies or substantial portions of the Software.
*
*  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
*  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
*  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
*  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
*  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
*  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
*  THE SOFTWARE.

*----------------------------------------------------------------------*
*       CLASS lcl_output_port DEFINITION
*----------------------------------------------------------------------*
   CLASS lcl_output_port DEFINITION.
     PUBLIC SECTION.
       CLASS-METHODS new
         RETURNING value(ro_port) TYPE REF TO lcl_output_port.
       INTERFACES lif_port.
       ALIASES write FOR lif_port~write.
       METHODS get RETURNING value(rv_text) TYPE string.
     PRIVATE SECTION.
       DATA print_offset TYPE i.
       DATA buffer TYPE string.

       METHODS writeln IMPORTING text TYPE string.
       METHODS add IMPORTING text TYPE string.
   ENDCLASS.

*----------------------------------------------------------------------*
*       CLASS lcl_output_port  IMPLEMENTATION
*----------------------------------------------------------------------*
   CLASS lcl_output_port IMPLEMENTATION.

     METHOD new.
       CREATE OBJECT ro_port.
     ENDMETHOD.                    "new

     METHOD get.
       rv_text = buffer.
     ENDMETHOD.                    "get

     METHOD add.
       buffer = buffer && text.
     ENDMETHOD.                    "add

     METHOD writeln.
       add( |\n{ repeat( val = ` ` occ = print_offset ) }{ text }| ).
     ENDMETHOD.                    "writeln

* Write out a given element
     METHOD write.
       DATA lo_elem TYPE REF TO lcl_lisp.
       CHECK element IS BOUND.

       CASE element->type.
         WHEN lcl_lisp=>type_conscell.
           writeln( `(` ).
           lo_elem = element.
           DO.
             ADD 2 TO print_offset.
             write( lo_elem->car ).
             SUBTRACT 2 FROM print_offset.
             IF lo_elem->cdr IS NOT BOUND OR lo_elem->cdr EQ lcl_lisp=>nil.
               EXIT.
             ENDIF.
             lo_elem = lo_elem->cdr.
           ENDDO.
           add( ` )` ).
         WHEN lcl_lisp=>type_number OR lcl_lisp=>type_symbol.
           add( ` ` && element->value ).
       ENDCASE.
     ENDMETHOD.                    "write

   ENDCLASS.                    "lcl_console IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_interpreter DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_interpreter DEFINITION FOR TESTING
     RISK LEVEL HARMLESS DURATION SHORT.
     PROTECTED SECTION.
       "    DATA code TYPE string.
       DATA mo_int TYPE REF TO lcl_lisp_interpreter.
*   Initialize Lisp interpreter
       METHODS test IMPORTING title TYPE string
                              code TYPE string
                              actual    TYPE any
                              expected  TYPE any
                              level TYPE aunit_level.
       METHODS test_f IMPORTING title TYPE string
                                code TYPE string
                                actual    TYPE numeric
                                expected  TYPE numeric.

       METHODS code_test IMPORTING code     TYPE string
                                   expected TYPE any
                                   level TYPE aunit_level
                                     DEFAULT if_aunit_constants=>critical.
       METHODS code_test_f IMPORTING code     TYPE string
                                     expected TYPE numeric.

       METHODS riff_shuffle_code RETURNING value(code) TYPE string.

     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

*   Stability tests - No Dump should occur
       METHODS stability_1 FOR TESTING.
       METHODS stability_2 FOR TESTING.
*--------------------------------------------------------------------*
*   BASIC TESTS
       METHODS: basic_define_error FOR TESTING,
         basic_define_a_23 FOR TESTING,
*     Test strings
         basic_string_value FOR TESTING,
         basic_string_esc_double_quote FOR TESTING,
         basic_string_quot_esc_dbl_quot FOR TESTING,

*     Evaluating multiple expressions
         basic_multiple_expr FOR TESTING.
   ENDCLASS.                    "ltc_interpreter DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_interpreter IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_interpreter IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

* Conduct a test with given code
     METHOD test.
       cl_abap_unit_assert=>assert_equals(
         act = actual
         exp = expected
         msg = |Error { title } :{ code }\nActual : { actual }\nExpected :{ expected }\n|
         level = level ).

*    write:/ '<- ', code.
*    write:/ '-> ', actual.
     ENDMETHOD.                    "test

     METHOD test_f.
       cl_abap_unit_assert=>assert_equals_float(
         act = actual
         exp = expected
         msg = |Error { title } :{ code }\n| ).
     ENDMETHOD.                    "test_f

* Conduct a test with given code
     METHOD code_test.
       DATA lv_result TYPE string.
       lv_result = mo_int->eval_source( code ).
       test( code = code
             actual = lv_result
             expected = expected
             title = 'CODE'
             level = level ).
     ENDMETHOD.                    "code_test

     METHOD code_test_f.
       DATA lv_result TYPE f.
       lv_result = mo_int->eval_source( code ).
       test_f( code = code
               actual = lv_result
               expected = expected
               title = 'CODE' ).
     ENDMETHOD.                    "code_test_f

     METHOD stability_1.
       code_test( code = 'a'
                  expected = `Eval: Symbol a is unbound` ).
     ENDMETHOD.                    "stability_1

     METHOD stability_2.
       code_test( code = '(define a)'
                  expected = `Eval: Incorrect input` ).
     ENDMETHOD.                    "stability_2

     METHOD basic_define_error.
       code_test( code = '(define 22 23)'
                  expected = `Eval: 22 cannot be a variable identifier` ).
     ENDMETHOD.                    "basic_define_error

     METHOD basic_define_a_23.
       code_test( code = '(define a 23)'
                  expected = `a` ).
       code_test( code = 'a'
                  expected = `23` ).
     ENDMETHOD.                    "basic_define_a_23

     METHOD basic_string_value.
       code_test( code = '"string value"'
                  expected = `string value` ).
     ENDMETHOD.                    "basic_string_value

     METHOD basic_string_esc_double_quote.
       code_test( code = '"string value with \" escaped double quote"'
                  expected = 'string value with \" escaped double quote' ).
     ENDMETHOD.                    "basic_string_esc_double_quote

     METHOD basic_string_quot_esc_dbl_quot.
       code_test( code = '(quote "string value with \" escaped double quote")'
                  expected = 'string value with \" escaped double quote' ).
     ENDMETHOD.                    "basic_string_quot_esc_dbl_quot

     METHOD basic_multiple_expr.
*   Evaluating multiple expressions
       code_test( code = '(define a (list 1 2 3 4)) (define b (cdr a)) a b'
                  expected = 'a b ( 1 2 3 4 ) ( 2 3 4 )' ).
     ENDMETHOD.                    "basic_multiple_expr

     METHOD riff_shuffle_code.
       code =
        |(define riff-shuffle | &
        | ( lambda (deck) (begin | &
        | (define take | &
        | (lambda (n seq) (if (<= n 0) (quote ()) (cons (car seq) (take (- n 1) (cdr seq)))))) | &
        | (define drop | &
        | (lambda (n seq) (if (<= n 0) seq (drop (- n 1) (cdr seq)))))| &
        | (define mid | &
        | (lambda (seq) (/ (length seq) 2)))| &
        | ((combine append) (take (mid deck) deck) (drop (mid deck) deck))| &
        | )))|.
     ENDMETHOD.                    "riff_shuffle_code

   ENDCLASS.                    "ltc_interpreter IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_parse DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_parse DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       DATA output TYPE REF TO lcl_output_port.

       METHODS setup.
       METHODS teardown.
       METHODS parse IMPORTING code TYPE string.
       METHODS parse_test IMPORTING code     TYPE string
                                    expected TYPE string
                                    level TYPE aunit_level DEFAULT if_aunit_constants=>critical.
       METHODS empty FOR TESTING.
       METHODS lambda FOR TESTING.
       METHODS lambda_comments FOR TESTING.
       METHODS riff_shuffle FOR TESTING.
   ENDCLASS.                    "ltc_parse DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_parse IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_parse IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT output.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE output.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD parse.
       DATA elements TYPE lcl_lisp_interpreter=>tt_element.
       DATA element TYPE REF TO lcl_lisp.

       elements = mo_int->parse( code ).
       cl_abap_unit_assert=>assert_not_initial(
         act = lines( elements )
         msg = |No evaluated element from first expression| ).

       READ TABLE elements INDEX 1 INTO element.
       output->write( element ).
     ENDMETHOD.                    "parse

* Test parsing of a given piece of code and write out result
     METHOD parse_test.
       parse( code ).
       test( actual = output->get( )
             code = code
             expected = expected
             title = 'PARSE'
             level = level ).
     ENDMETHOD.                    "parse_test

     METHOD empty.
       parse_test( code = ''
                   expected = | nil| ).
     ENDMETHOD.                    "lambda

     METHOD lambda.
       parse_test( code = '(define a(lambda()20))'
                   expected = |\n( define a\n  ( lambda nil  ) )| ).
     ENDMETHOD.                    "lambda

     METHOD lambda_comments.
       parse_test( code = |;; Comments\n| &
                          |(define a(lambda()20)) ; comments|
                   expected = |\n( define a\n  ( lambda nil  ) )| ).
     ENDMETHOD.                    "lambda

     METHOD riff_shuffle.
       parse_test( code = riff_shuffle_code( )
                   expected =
   |\n( define riff-shuffle\n  ( lambda\n    ( deck )\n    ( begin\n      ( define take\n        ( lambda| &
   |\n          ( n seq )\n          ( if\n            ( <= n  )\n            ( quote nil )\n            ( cons| &
   |\n              ( car seq )\n              ( take\n                ( - n  )\n                ( cdr seq ) ) ) ) ) )| &
   |\n      ( define drop\n        ( lambda\n          ( n seq )\n          ( if\n            ( <= n  ) seq| &
   |\n            ( drop\n              ( - n  )\n              ( cdr seq ) ) ) ) )\n      ( define mid\n| &
   |        ( lambda\n          ( seq )\n          ( /\n            ( length seq )  ) ) )\n      (\n| &
   |        ( combine append )\n        ( take\n          ( mid deck ) deck )\n        ( drop| &
   |\n          ( mid deck ) deck ) ) ) ) )|
             ).
     ENDMETHOD.                    "riff_shuffle

   ENDCLASS.                    "ltc_parse IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_basic DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_basic DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.

       METHODS setup.
       METHODS teardown.

       METHODS quote_19 FOR TESTING.
       METHODS quote_a FOR TESTING.
       METHODS quote_symbol_19 FOR TESTING.
       METHODS quote_symbol_a FOR TESTING.
       METHODS quote_list123 FOR TESTING.

       METHODS set_1 FOR TESTING.
       METHODS set_2 FOR TESTING.
       METHODS set_3 FOR TESTING.

       METHODS let_1 FOR TESTING.
       METHODS let_2 FOR TESTING.
       METHODS let_3 FOR TESTING.

       METHODS letrec_1 FOR TESTING.

       METHODS is_symbol_true FOR TESTING.
       METHODS is_symbol_false FOR TESTING.
       METHODS is_hash_true FOR TESTING.
       METHODS is_hash_false FOR TESTING.
       METHODS is_procedure_true FOR TESTING.
       METHODS is_procedure_true_1 FOR TESTING.
       METHODS is_procedure_true_2 FOR TESTING.
       METHODS is_procedure_false FOR TESTING.
       METHODS is_string_true FOR TESTING.
       METHODS is_string_false FOR TESTING.
       METHODS is_number_true FOR TESTING.
       METHODS is_number_false FOR TESTING.

   ENDCLASS.                    "ltc_basic DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_basic IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_basic IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD quote_19.
       code_test( code = '(quote 19)'
                  expected = '19' ).
     ENDMETHOD.                    "quote_19

     METHOD quote_a.
       code_test( code = '(quote a)'
                  expected = 'a' ).
     ENDMETHOD.                    "quote_a

     METHOD quote_symbol_19.
       code_test( code = '''19'
                  expected = '19' ).
     ENDMETHOD.                    "quote_symbol_19

     METHOD quote_symbol_a.
       code_test( code = '''a'
                  expected = 'a' ).
     ENDMETHOD.                    "quote_symbol_a

     METHOD quote_list123.
       code_test( code = '''(list 1 2 3)'
                  expected = '( list 1 2 3 )' ).
     ENDMETHOD.                    "quote_list123

     METHOD set_1.
       code_test( code = '(define x 3)'
                  expected = 'x' ).
       code_test( code = '(set! x 7)'
                  expected = 'x' ).
       code_test( code = 'x'
                  expected = '7' ).
     ENDMETHOD.                    "set_1

     METHOD set_2.
       code_test( code = '(set! x 5)'
                  expected = 'Eval: Symbol x is unbound' ).
     ENDMETHOD.                    "set_2

     METHOD set_3.
       code_test( code = '(define *seed* 1)'
                  expected = '*seed*' ).
       code_test( code = |(define (srand seed)| &
                         |(set! *seed* seed)| &
                         |*seed*)|
                  expected = 'srand' ).
       code_test( code = '(srand 2)'
                  expected = '2' ).
     ENDMETHOD.

     METHOD let_1.
       code_test( code = '(let ((x 4) (y 5)) (+ x y))'
                  expected = '9' ).
     ENDMETHOD.                    "let_1

     METHOD let_2.
       code_test( code = |(let ((x 2) (y 3))| &
                         |  (let ((foo (lambda (z) (+ x y z)))| &
                         |        (x 7))| &
                         |    (foo 4)))|
                  expected = '9' ).
     ENDMETHOD.

     METHOD let_3.
*      not allowed if we strictly follow the Scheme standard
       code_test( code = |(let ((x 2) (x 0))| &
                         |    (+ x 5))|
                  expected = '5' ).
     ENDMETHOD.

     METHOD letrec_1.
       code_test( code = '(define (not x) (if (eq? x #f) #t #f) )'
                  expected = 'not' ).
       code_test( code = |(letrec ((is-even? (lambda (n)| &
                         |                     (or (zero? n)| &
                         |                         (is-odd? (- n 1)))))| &
                         |         (is-odd? (lambda (n)| &
                         |                     (and (not (zero? n))| &
                         |                          (is-even? (- n 1))))) )| &
                         |(is-odd? 11))|
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_symbol_true.
       code_test( code = |(define x 5)|
                  expected = 'x' ).
       code_test( code = |(symbol? 'x)|
                  expected = 'true' ).
       code_test( code = |(symbol? x)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_symbol_false.
       code_test( code = |(symbol? 4)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_hash_true.
       code_test( code = |(define h (make-hash '(dog 4 car 5))|
                  expected = 'h' ).
       code_test( code = |(hash? h)|
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_hash_false.
       code_test( code = |(hash? 5)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_procedure_true.
       code_test( code = |(define (fn x) (+ x 5))|
                  expected = 'fn' ).
       code_test( code = |(procedure? fn)|
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_procedure_true_1.
       code_test( code = |(procedure? car)|
                  expected = 'true' ).
       code_test( code = |(procedure? 'car)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_procedure_true_2.
       code_test( code = |(procedure? (lambda (x) (* x x)))|
                  expected = 'true' ).
       code_test( code = |(procedure? '(lambda (x) (* x x)))|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_procedure_false.
       code_test( code = |(define x 5)|
                  expected = 'x' ).
       code_test( code = |(procedure? x)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_string_true.
       code_test( code = |(define txt "Badenkop")|
                  expected = 'txt' ).
       code_test( code = |(string? txt)|
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_string_false.
       code_test( code = |(string? 34)|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_number_true.
       code_test( code = |(define n 5)|
                  expected = 'n' ).
       code_test( code = |(number? n)|
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_number_false.
       code_test( code = |(define d "5")|
                  expected = 'd' ).
       code_test( code = |(number? d)|
                  expected = 'false' ).
     ENDMETHOD.

   ENDCLASS.                    "ltc_basic IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_functional_tests DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_functional_tests DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS combine.
*   COMBINE + ZIP
       METHODS functional_combine_zip FOR TESTING.

       METHODS functional_compose FOR TESTING.

       METHODS functional_fact_accum FOR TESTING.

   ENDCLASS.                    "ltc_functional_tests DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_functional_tests IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_functional_tests IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD combine.
       code_test( code = '(define combine (lambda (f) (lambda (x y) (if (nil? x) (quote ()) (f (list (car x) (car y)) ((combine f) (cdr x) (cdr y)))))))'
                  expected = 'combine' ).
     ENDMETHOD.                    "combine

* COMBINE + ZIP
     METHOD functional_combine_zip.
       combine( ).
       code_test( code = '(define zip (combine cons))'
                  expected = 'zip' ).
       code_test( code = 'zip'
                  expected = '<lambda> ( x y )' ).
       code_test( code = '(zip (list 1 2 3 4) (list 5 6 7 8))'
                  expected = '( ( 1 5 ) ( 2 6 ) ( 3 7 ) ( 4 8 ) )' ).
     ENDMETHOD.                    "functional_combine_zip

     METHOD functional_compose.
       combine( ).
       code_test( code = '(define compose (lambda (f g) (lambda (x) (f (g x)))))'
                  expected = 'compose' ).
       code_test( code = '(define repeat (lambda (f) (compose f f)))'
                  expected = 'repeat' ).
       code_test( code = riff_shuffle_code( )
                  expected = 'riff-shuffle' ).
       code_test( code = '(riff-shuffle (list 1 2 3 4 5 6 7 8))'
                  expected = '( 1 5 2 6 3 7 4 8 )' ).
       code_test( code = '((repeat riff-shuffle) (list 1 2 3 4 5 6 7 8))'
                  expected = '( 1 3 5 7 2 4 6 8 )' ).
       code_test( code = '(riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8))))'
                  expected = '( 1 2 3 4 5 6 7 8 )' ).
     ENDMETHOD.                    "functional_compose

     METHOD functional_fact_accum.
       code_test( code = '(define (fact x) (define (fact-tail x accum) (if (= x 0) accum (fact-tail (- x 1) (* x accum)))) (fact-tail x 1))'
                  expected = 'fact' ).
       code_test( code = '(fact 8)' "FIXME: returns fact-tail
                  expected = '40320' ).
     ENDMETHOD.                    "functional_fact_accum

   ENDCLASS.                    "ltc_functional_tests IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_math DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_math DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS math_addition FOR TESTING.

       METHODS math_mult_1 FOR TESTING.
       METHODS math_mult_2 FOR TESTING.
       METHODS math_mult_3 FOR TESTING.

       METHODS math_subtract_1 FOR TESTING.
       METHODS math_subtract_2 FOR TESTING.
       METHODS math_subtract_3 FOR TESTING.

       METHODS math_division_1 FOR TESTING.
       METHODS math_division_2 FOR TESTING.
       METHODS math_division_3 FOR TESTING.
       METHODS math_division_4 FOR TESTING.

       METHODS math_sin FOR TESTING.
       METHODS math_cos FOR TESTING.
       METHODS math_tan FOR TESTING.
       METHODS math_sinh_1 FOR TESTING.
       METHODS math_cosh_1 FOR TESTING.
       METHODS math_tanh_1 FOR TESTING.

       METHODS math_sinh FOR TESTING.
       METHODS math_cosh FOR TESTING.
       METHODS math_tanh FOR TESTING.
       METHODS math_asinh FOR TESTING.
       METHODS math_acosh FOR TESTING.
       METHODS math_atanh FOR TESTING.
       METHODS math_asin FOR TESTING.
       METHODS math_acos FOR TESTING.
       METHODS math_atan FOR TESTING.

       METHODS math_exp FOR TESTING.
       METHODS math_expt FOR TESTING.
       METHODS math_expt_1 FOR TESTING.
       METHODS math_sqrt FOR TESTING.
       METHODS math_log FOR TESTING.

       METHODS math_floor FOR TESTING.
       METHODS math_ceiling FOR TESTING.
       METHODS math_truncate FOR TESTING.
       METHODS math_round FOR TESTING.

       METHODS math_remainder FOR TESTING.
       METHODS math_modulo FOR TESTING.

   ENDCLASS.                    "ltc_math DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_math IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_math IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD math_addition.
       code_test( code = '(+ 22 24 25)'
                  expected = '71' ).
     ENDMETHOD.                    "math_addition

     METHOD math_mult_1.
*   Test multiplication
       code_test( code = '(* 22)'
                  expected = '22' ).
     ENDMETHOD.                    "math_mult_1

     METHOD math_mult_2.
       code_test( code = '(* 11 12)'
                  expected = '132' ).
     ENDMETHOD.                    "math_mult_2

     METHOD math_mult_3.
       code_test( code = '(* 11 12 13)'
                  expected = '1716' ).
     ENDMETHOD.                    "math_mult_3

     METHOD math_subtract_1.
       code_test( code = '(- 22)'
                  expected = '-22' ).
     ENDMETHOD.                    "math_subtract_1

     METHOD math_subtract_2.
       code_test( code = '(- 22 23 24)'
                  expected = '-25' ).
     ENDMETHOD.                    "math_subtract_2

     METHOD math_subtract_3.
       code_test( code = '(- (- (- (- (- 5 1) 1) 1) 1) 1)'
                  expected = '0' ).
     ENDMETHOD.                    "math_subtract_3

     METHOD math_division_1.
*   Test division
       code_test( code = '(/ 2)'
                  expected = '0.5' ).
     ENDMETHOD.                    "math_division_1

     METHOD math_division_2.
       code_test( code =  '(/ 10)'
                  expected = '0.1' ).
     ENDMETHOD.                    "math_division_2

     METHOD math_division_3.
       code_test( code =  '(/ 5 10)'
                  expected = '0.5' ).
     ENDMETHOD.                    "math_division_3

     METHOD math_division_4.
       code_test_f( code =  '(/ 11 12 13)'
                    expected = '0.07051282051282051282051282051282052' ).
     ENDMETHOD.                    "math_division_4

     METHOD math_sin.
       code_test( code =  '(sin 0)'
                  expected = '0' ).
     ENDMETHOD.                    "math_sin

     METHOD math_cos.
       code_test( code =  '(cos 0)'
                  expected = '1' ).
     ENDMETHOD.                    "math_cos

     METHOD math_tan.
       code_test( code =  '(tan 0)'
                  expected = '0' ).
     ENDMETHOD.                    "math_tan

     METHOD math_sinh.
       code_test( code =  '(sinh 0)'
                  expected = '0' ).
     ENDMETHOD.                    "math_sinh

     METHOD math_cosh.
       code_test( code =  '(cosh 0)'
                  expected = '1' ).
     ENDMETHOD.                    "math_cosh

     METHOD math_tanh.
       code_test( code =  '(tanh 0)'
                  expected = '0' ).
     ENDMETHOD.                    "math_tanh

     METHOD math_sinh_1.
       code_test_f( code =  '(sinh 0.5)'
                    expected = '0.52109530549374736162242562641149' ).
     ENDMETHOD.                    "math_sinh_1

     METHOD math_cosh_1.
       code_test_f( code =  '(cosh 1)'
                    expected = '1.5430806348152437784779056207571' ).
     ENDMETHOD.                    "math_cosh_1

     METHOD math_tanh_1.
       code_test_f( code =  '(tanh 1)'
                    expected = '0.76159415595576488811945828260479' ).
     ENDMETHOD.                    "math_tanh_1

     METHOD math_asinh.
       code_test_f( code =  '(asinh 0)'
                    expected = 0 ).
     ENDMETHOD.                    "math_asinh

     METHOD math_acosh.
       code_test_f( code =  '(acosh 1)'
                    expected = 0 ).
     ENDMETHOD.                    "math_acosh

     METHOD math_atanh.
       code_test_f( code =  '(atanh 0)'
                    expected = 0 ).
     ENDMETHOD.                    "math_atanh

     METHOD math_asin.
       code_test_f( code =  '(asin 1)'
                    expected = '1.5707963267948966192313216916398' ).
     ENDMETHOD.                    "math_asin

     METHOD math_acos.
       code_test_f( code =  '(acos 0)'
                    expected = '1.5707963267948966192313216916398' ).
     ENDMETHOD.                    "math_acos

     METHOD math_atan.
       code_test_f( code =  '(atan 1)'
                    expected = '0.78539816339744830961566084581988' ).
     ENDMETHOD.                    "math_atan

     METHOD math_exp.
       code_test_f( code =  '(exp 2)'
                    expected = '7.389056098930650227230427460575' ).
     ENDMETHOD.                    "math_exp

     METHOD math_expt.
       code_test( code =  '(expt 2 10)'
                  expected = '1024' ).
       code_test_f( code =  '(expt 2 0.5)'
                    expected = '1.4142135623730950488016887242097' ).
     ENDMETHOD.                    "math_expt

     METHOD math_expt_1.
       code_test( code =  '(exp 2 10)'
                  expected = 'Eval: ( 2 10 ) Parameter mismatch' ).
     ENDMETHOD.                    "math_expt_1

     METHOD math_sqrt.
       code_test_f( code =  '(sqrt 2)'
                    expected = '1.4142135623730950488016887242097' ).
     ENDMETHOD.                    "math_sqrt

     METHOD math_log.
       code_test_f( code =  '(log 7.389056)'
                    expected = '1.999999986611192' ).
     ENDMETHOD.                    "math_log

     METHOD math_floor.
       "(floor x) - This returns the largest integer that is no larger than x.
       code_test( code =  '(floor 7.3890560989306504)'
                  expected = '7' ).
     ENDMETHOD.                    "math_floor

     METHOD math_ceiling.
       "(ceiling x) - This returns the smallest integer that is no smaller than x.
       code_test( code =  '(ceiling 1.4142135623730951)'
                  expected = '2' ).
     ENDMETHOD.                    "math_ceiling

     METHOD math_truncate.
       "(truncate x) - returns the integer value closest to x that is no larger than the absolute value of x.
       code_test( code =  '(truncate -2.945)'
                  expected = '-2' ).
     ENDMETHOD.                    "math_truncate

     METHOD math_round.
       "(round x) -
*   This rounds value of x to the nearest integer as is usual in mathematics.
*   It even works when halfway between values.
       code_test( code =  '(round 7.389056)'
                  expected = '7' ).
       code_test( code =  '(round 7.789056)'
                  expected = '8' ).
       code_test( code =  '(round -7.789056)'
                  expected = '-8' ).
     ENDMETHOD.                    "math_round

     METHOD math_remainder.
       code_test( code =  '(remainder 5 4)'
                  expected = '1' ).
       code_test( code =  '(remainder -5 4)'
                  expected = '-1' ).
       code_test( code =  '(remainder 5 -4)'
                  expected = '1' ).
       code_test( code =  '(remainder -5 -4)'
                  expected = '-1' ).
     ENDMETHOD.                    "math_remainder

     METHOD math_modulo.
       code_test( code =  '(modulo 5 4)'
                  expected = '1' ).
       code_test( code =  '(modulo -5 4)'
                  expected = '3' ).
       code_test( code =  '(modulo 5 -4)'
                  expected = '-3' ).
       code_test( code =  '(modulo -5 -4)'
                  expected = '-1' ).
     ENDMETHOD.                    "math_modulo

   ENDCLASS.                    "ltc_math IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_list DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_list DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS is_list_1 FOR TESTING.
       METHODS is_list_2 FOR TESTING.
       METHODS is_list_3 FOR TESTING.
       METHODS is_list_4 FOR TESTING.

       METHODS list_nil_1 FOR TESTING.
       METHODS list_nil_2 FOR TESTING.
       METHODS list_test_1 FOR TESTING.
       METHODS list_test_2 FOR TESTING.
       METHODS list_append_1 FOR TESTING.
       METHODS list_append_error FOR TESTING.
       METHODS list_append_3 FOR TESTING.
       METHODS list_append_arg_0 FOR TESTING.
       METHODS list_append_arg_1 FOR TESTING.
       METHODS list_append_arg_2 FOR TESTING.

       METHODS list_length_0 FOR TESTING.
       METHODS list_length_1 FOR TESTING.
       METHODS list_length_2 FOR TESTING.

       METHODS list_memq_0 FOR TESTING.
       METHODS list_memq_1 FOR TESTING.
       METHODS list_memq_2 FOR TESTING.
       METHODS list_memq_3 FOR TESTING.

       METHODS list_member FOR TESTING.
       METHODS list_memv FOR TESTING.

*   CAR & CDR test
       METHODS list_car_1 FOR TESTING.
       METHODS list_cdr_1 FOR TESTING.
       METHODS list_car_car_cdr FOR TESTING.
       METHODS list_car_nil FOR TESTING.
       METHODS list_car_list FOR TESTING.
       METHODS list_cons_two_lists FOR TESTING.
       METHODS list_cons_with_nil FOR TESTING.
       METHODS list_cons_with_list FOR TESTING.
       METHODS list_cons_two_elems FOR TESTING.
   ENDCLASS.                    "ltc_list DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_list IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_list IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD is_list_1.
       code_test( code = '(list? ''())'
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_list_2.
       code_test( code = '(list? ''(1))'
                  expected = 'true' ).
     ENDMETHOD.

     METHOD is_list_3.
       code_test( code = '(list? 1)'
                  expected = 'false' ).
     ENDMETHOD.

     METHOD is_list_4.
       code_test( code = '(define x (append ''(1 2) 3))'
                  expected = 'x' ).
       code_test( code = '(list? x)'
                  expected = 'false' ).
     ENDMETHOD.

     METHOD list_nil_1.
*  Test list
       code_test( code = '(list ())'
                  expected = 'nil' ).
     ENDMETHOD.                    "list_nil_1

     METHOD list_nil_2.
       code_test( code = '(list nil)'
                  expected = '( nil )' ).
     ENDMETHOD.                    "list_nil_2

     METHOD list_test_1.
*   Test list
       code_test( code = '(list 22 23 24)'
                  expected = '( 22 23 24 )' ).
     ENDMETHOD.                    "list_test_1

     METHOD list_test_2.
       code_test( code = '(list 22 (list 23 24))'
                  expected = '( 22 ( 23 24 ) )' ).
     ENDMETHOD.                    "list_test_2

     METHOD list_append_1.
*   Test append
       code_test( code = '(append (list 22 (list 23 24)) 23)'
                  expected = '( 22 ( 23 24 ) . 23 )' ).
     ENDMETHOD.                    "list_append_1

     METHOD list_append_error.
       code_test( code = '(append (append (list 22 (list 23 24)) 23) 28)'  "Should give an error
                  expected = 'Eval: ( ( 23 24 ) . 23 ) is not a proper list' ).
     ENDMETHOD.

     METHOD list_append_3.
       code_test( code = '(append (list 1) (list 2))'
                  expected = '( 1 2 )' ).
     ENDMETHOD.                    "list_append_3

     METHOD list_append_arg_0.
       code_test( code = '(append)'
                  expected = 'Eval: Incorrect input' ).
     ENDMETHOD.

     METHOD list_append_arg_1.
       code_test( code = '(append 3)'
                  expected = '3' ).
     ENDMETHOD.

     METHOD list_append_arg_2.
       code_test( code = |(append '(3))|
                  expected = '( 3 )' ).
     ENDMETHOD.

     METHOD list_length_0.
*   Test length
       code_test( code = '(length nil)'
                  expected = '0' ).
     ENDMETHOD.                    "list_length_0

     METHOD list_length_1.
*   Test length
       code_test( code = '(length (list 21 22 23 24))'
                  expected = '4' ).
     ENDMETHOD.                    "list_length_1

     METHOD list_length_2.
       code_test( code = '(length (list 22 (list 23 24)))'
                  expected = '2' ).
     ENDMETHOD.                    "list_length_2

     METHOD list_memq_0.
       code_test( code = |(memq 'a '(a b c))|
                  expected = '( a b c )' ).
     ENDMETHOD.

     METHOD list_memq_1.
       code_test( code = |(memq 'b '(a b c))|
                  expected = '( b c )' ).
     ENDMETHOD.

     METHOD list_memq_2.
       code_test( code = |(memq 'a '(b c d))|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD list_memq_3.
       code_test( code = |(memq (list 'a) '(b (a) c))|
                  expected = 'false' ).
     ENDMETHOD.

     METHOD list_member.
       code_test( code = |(member (list 'a)| &
                         |        '(b (a) c))|
                  expected = '( ( a ) c )' ).
     ENDMETHOD.

     METHOD list_memv.
       code_test( code = |(memv 101 '(100 101 102))|
                  expected = '( 101 102 )' ).
     ENDMETHOD.

* CAR & CDR test
     METHOD list_car_1.
*   Test append
       code_test( code = '(car (list 22 (list 23 24)))'
                  expected = '22' ).
     ENDMETHOD.                    "list_car_1

     METHOD list_cdr_1.
       code_test( code = '(cdr (list 22 (list 23 24)))'
                  expected = '( ( 23 24 ) )' ).
     ENDMETHOD.                    "list_cdr_1

     METHOD list_car_car_cdr.
       code_test( code = '(car (car (cdr (list 22 (list 23 24)))))'
                  expected = '23' ).
     ENDMETHOD.                    "list_car_car_cdr

     METHOD list_car_nil.
       code_test( code = '(car nil)'
                  expected = 'nil' ).
     ENDMETHOD.                    "list_car_nil

     METHOD list_car_list.
       code_test( code = '(car (list 1))'
                  expected = '1' ).
     ENDMETHOD.                    "list_car_list

     METHOD list_cons_two_lists.
*   Test CONS
       code_test( code = '(cons (list 1 2) (list 3 4))'
                  expected = '( ( 1 2 ) 3 4 )' ).
     ENDMETHOD.                    "list_cons_two_lists

     METHOD list_cons_with_nil.
       code_test( code = '(cons 1 nil)'
                  expected = '( 1 )' ).
     ENDMETHOD.                    "list_cons_with_nil

     METHOD list_cons_with_list.
       code_test( code = '(cons 2 (list 3 4))'
                  expected = '( 2 3 4 )' ).
     ENDMETHOD.                    "list_cons_with_list

     METHOD list_cons_two_elems.
       code_test( code = '(cons 2 3)'
                  expected = '( 2 . 3 )' ).
     ENDMETHOD.                    "list_cons_two_elems

   ENDCLASS.                    "ltc_list IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_library_function DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_library_function DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS abs FOR TESTING.
   ENDCLASS.                    "ltc_library_function DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_library_function IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_library_function IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD abs.
       code_test( code = |(define (abs n)| &
                         |  (if (< n 0)| &
                         |  (- n)| &
                         |  n) )|
                  expected = |abs| ).
       code_test( code = |(abs -2)|
                  expected = |2| ).
       code_test( code = |(abs 12)|
                  expected = |12| ).
       code_test( code = |(abs 0)|
                  expected = |0| ).
     ENDMETHOD.                    "abs

   ENDCLASS.                    "ltc_library_function IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_higher_order DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_higher_order DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS fold_right RETURNING value(code) TYPE string.

       METHODS foldr FOR TESTING.
       METHODS foldl FOR TESTING.
       METHODS map FOR TESTING.
       METHODS filter FOR TESTING.
   ENDCLASS.                    "ltc_higher_order DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_higher_order IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_higher_order IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD fold_right.
       code = |(define (fold-right f init seq)| &
              |  (if (null? seq)| &
              |  init| &
              |  (f (car seq)| &
              |       (fold-right f init (cdr seq)))))|.
     ENDMETHOD.                    "fold_right

     METHOD foldr.
       code_test( code = fold_right( )
                  expected = 'fold-right' ).
       code_test( code = |(fold-right + 1 (list 1 2 3 7))|
                  expected = '14' ).
       code_test( code = |(define (last lst)| &
                         |  (if (null? lst)| &
                         |    nil| &
                         |    (if (null? (cdr lst))| &
                         |      (car lst)| &
                         |      (last (cdr lst)) )| &
                         |  ))|
                  expected = 'last' ).
       code_test( code = |(define (delete-adjacent-duplicates lst)| &
                         |  (fold-right (lambda (elem ret)| &
                         |                (if (equal? elem (car ret))| &
                         |                    ret| &
                         |                    (cons elem ret)))| &
                         |              (list (last lst))| &
                         |              lst))|
                  expected = 'delete-adjacent-duplicates' ).
       code_test( code = |(delete-adjacent-duplicates '(1 2 3 3 4 4 4 5))|
                  expected = |( 1 2 3 4 5 )| ).
     ENDMETHOD.                    "foldr

     METHOD foldl.
       code_test( code = |(define (fold-left f init seq)| &
                         |  (if (null? seq)| &
                         |  init| &
                         |  (fold-left f| &
                         |             (f init (car seq))| &
                         |             (cdr seq))))|
                  expected = |fold-left| ).
       code_test( code = |(fold-left + 0 (list 1 2 3))|
                  expected = '6' ).

       code_test( code = |(define (reverse l)| &
                         |  (fold-left (lambda (i j)| &
                         |               (cons j i))| &
                         |               '()| &
                         |               l))|
                  expected = |reverse| ).
       code_test( code = |(reverse (list 1 2 3))|
                  expected = '( 3 2 1 )' ).

     ENDMETHOD.                    "foldl

     METHOD map.
       code_test( code = |(define (map f lst)| &
                         |  (if (null? lst)| &
                         |    '()| &
                         |    (cons (f (car lst)) (map f (cdr lst)))))|
                  expected = |map| ).
       code_test( code = |(map (lambda (n) (+ n 3))| &
                         |     '(1 2 3 4 5) )|
                  expected = |( 4 5 6 7 8 )| ).
     ENDMETHOD.                    "map

     METHOD filter.
       code_test( code = fold_right( )
                  expected = 'fold-right' ).
       code_test( code = |(define (filter pred? lst)| &
                         |  (fold-right (lambda (x y) (if (pred? x)| &
                         |                                (cons x y)| &
                         |                                y) )| &
                         |              '() lst))|
                  expected = |filter| ).
       code_test( code = |(filter (lambda (n) (> n 4))| &
                         |     '(1 2 3 4 5 7) )|
                  expected = |( 5 7 )| ).
     ENDMETHOD.                    "filter

   ENDCLASS.                    "ltc_higher_order IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_comparison DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_comparison DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS compa_gt_1 FOR TESTING.
       METHODS compa_gt_2 FOR TESTING.
       METHODS compa_gt_3 FOR TESTING.
       METHODS compa_gt_4 FOR TESTING.

       METHODS compa_gte_1 FOR TESTING.
       METHODS compa_gte_2 FOR TESTING.
       METHODS compa_gte_3 FOR TESTING.

       METHODS compa_lte_1 FOR TESTING.
       METHODS compa_lte_2 FOR TESTING.
       METHODS compa_lte_3 FOR TESTING.

       METHODS compa_equal_1 FOR TESTING.
       METHODS compa_equal_2 FOR TESTING.
       METHODS compa_equal_3 FOR TESTING.

       METHODS compa_if_1 FOR TESTING.
       METHODS compa_if_2 FOR TESTING.
       METHODS compa_if_3 FOR TESTING.

       METHODS compa_eq_1 FOR TESTING.
       METHODS compa_eq_2 FOR TESTING.
       METHODS compa_eq_3 FOR TESTING.

       METHODS compa_nil_1 FOR TESTING.
       METHODS compa_nil_2 FOR TESTING.
       METHODS compa_nil_3 FOR TESTING.
       METHODS compa_nil_4 FOR TESTING.

       METHODS compa_string FOR TESTING.
   ENDCLASS.                    "ltc_comparison DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_comparison IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_comparison IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD compa_gt_1.
*   Test GT
       code_test( code = '(> 1 2)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_gt_1

     METHOD compa_gt_2.
       code_test( code = '(> 2 1)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_gt_2

     METHOD compa_gt_3.
       code_test( code = '(> 4 3 2 1)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_gt_3

     METHOD compa_gt_4.
       code_test( code = '(> 4 3 2 2)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_gt_4
*
     METHOD compa_gte_1.
*   Test GTE
       code_test( code = '(>= 2 2)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_gte_1

     METHOD compa_gte_2.
       code_test( code = '(>= 4 3 3 2)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_gte_2

     METHOD compa_gte_3.
       code_test( code = '(>= 1 4)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_gte_3

     METHOD compa_lte_1.
*   Test LT
       code_test( code = '(< 1 2 3)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_lte_1

     METHOD compa_lte_2.
       code_test( code = '(< 1 2 2)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_lte_2

     METHOD compa_lte_3.
       code_test( code = '(< 3 1)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_lte_3

     METHOD compa_equal_1.
*   Test equal?
       code_test( code = '(equal? 22 23)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_equal_1

     METHOD compa_equal_2.
       code_test( code = '(equal? 22 22)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_equal_2

     METHOD compa_equal_3.
       code_test( code = '(equal? (list 21) (list 21))'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_equal_3

     METHOD compa_if_1.
*   Test IF
       code_test( code = '(if 22 23)'
                  expected = '23' ).
     ENDMETHOD.                    "compa_if_1

     METHOD compa_if_2.
       code_test( code = '(if (< 2 1) 23)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_if_2

     METHOD compa_if_3.
       code_test( code = '(if (< 2 1) 23 24)'
                  expected = '24' ).
     ENDMETHOD.                    "compa_if_3

     METHOD compa_eq_1.
*      Test =
       code_test( code = '(= 2 3)'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_eq_1

     METHOD compa_eq_2.
       code_test( code = '(= 3 3)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_eq_2

     METHOD compa_eq_3.
*      equality of many things
       code_test( code = '(= (+ 3 4) 7 (+ 2 5))'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_eq_2

     METHOD compa_nil_1.
*      Test nil?
       code_test( code = '(nil? ())'
                  expected = 'Eval: Incorrect input' ).
     ENDMETHOD.                    "compa_nil_1

     METHOD compa_nil_2.
       code_test( code = '(nil? nil)'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_nil_2

     METHOD compa_nil_3.
       code_test( code = '(nil? (cdr (list 1)))'
                  expected = 'true' ).
     ENDMETHOD.                    "compa_nil_3

     METHOD compa_nil_4.
       code_test( code = '(nil? (cdr (list 1 2)))'
                  expected = 'false' ).
     ENDMETHOD.                    "compa_nil_4

     METHOD compa_string.
       code_test( code = '(define str "A string")'
                  expected = 'str' ).
       code_test( code = '(< str "The string")'
                  expected = 'Eval: A string is not a number [<]' ).
     ENDMETHOD.                    "compa_string

   ENDCLASS.                    "ltc_comparison IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_basic_functions DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_basic_functions DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS funct_lambda_0 FOR TESTING.
       METHODS funct_lambda_1 FOR TESTING.
       METHODS funct_lambda_2 FOR TESTING.

       METHODS funct_fact FOR TESTING.

       METHODS funct_arg_count FOR TESTING.
       METHODS funct_arg_missing FOR TESTING.
   ENDCLASS.                    "ltc_basic_functions DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_basic_functions IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_basic_functions IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD funct_lambda_0.
       code_test( code = '(define (b n) (* 11 n))'
                  expected = 'b' ).
       code_test( code = 'b'
                  expected = '<lambda> ( n )' ).
       code_test( code = '(b 20)'
                  expected = '220' ).
     ENDMETHOD.                    "funct_lambda_0

     METHOD funct_lambda_1.
*   Test LAMBDA
       code_test( code = '(define b (lambda (b) (* 10 b)))'
                  expected = 'b' ).
       code_test( code = 'b'
                  expected = '<lambda> ( b )' ).
       code_test( code = '(b 20)'
                  expected = '200' ).
     ENDMETHOD.                    "funct_lambda_1

     METHOD funct_lambda_2.
       code_test( code = '((lambda (a) (+ a 20)) 10 )'
                  expected = '30' ).
     ENDMETHOD.                    "funct_lambda_2

     METHOD funct_fact.
*   Function shorthand
       code_test( code = '(define (fact x) (if (= x 0) 1 (* x (fact (- x 1)))))'
                  expected = 'fact' ).
       code_test( code = '(fact 8)'
                  expected = '40320' ).
     ENDMETHOD.                    "funct_fact

     METHOD funct_arg_count.
       code_test( code = '(define (f x y) (+ x y))'
                  expected = 'f' ).
       code_test( code = '(f 1 2 3)'
                  expected = 'Eval: Expected 2 parameter(s), found ( 1 2 3 )' ).
     ENDMETHOD.                    "funct_arg_count

     METHOD funct_arg_missing.
       code_test( code = '(define (add x y) (+ x y))'
                  expected = 'add' ).
       code_test( code = '(add 1)'
                  expected = 'Eval: Missing parameter(s) ( y )' ).
     ENDMETHOD.                    "funct_arg_count

   ENDCLASS.                    "ltc_basic_functions IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_hash_element DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_hash_element DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS hash FOR TESTING.
   ENDCLASS.                    "ltc_hash_element DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_hash_element IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_hash_element IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD hash.
*   Hash implementation
       code_test( code = '(define h1 (make-hash ''(dog "bow-wow" cat "meow" kennel (dog cat hedgehog))))'
                  expected = 'h1' ).
       code_test( code = 'h1'
                  expected = '<hash>' ).
       code_test( code = '(hash-keys h1)'
                  expected = '( dog cat kennel )' ).
       code_test( code = '(hash-get h1 ''kennel)'
                  expected = '( dog cat hedgehog )' ).
       code_test( code = '(hash-remove h1 ''kennel)'
                  expected = 'nil' ).
       code_test( code = '(hash-get h1 ''sparrow)'
                  expected = 'nil' ).
       code_test( code = '(hash-insert h1 ''sparrow "whoosh")'
                  expected = 'nil' ).
       code_test( code = '(hash-get h1 ''sparrow)'
                  expected = 'whoosh' ).
       code_test( code = '(hash-keys h1)'
                  expected = '( dog cat sparrow )' ).
     ENDMETHOD.                    "hash

   ENDCLASS.                    "ltc_hash_element IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_abap_integration DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_abap_integration DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.

       METHODS abap_data_mandt FOR TESTING.
       METHODS abap_data_t005g FOR TESTING.
       METHODS empty_structure FOR TESTING.
       METHODS user_name FOR TESTING.
   ENDCLASS.                    "ltc_abap_integration DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_abap_integration IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_abap_integration IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD abap_data_mandt.
       code_test( code = '(define mandt (ab-data "MANDT"))'
                  expected = 'mandt' ).
       code_test( code = '(ab-set-value mandt "000")'
                  expected = 'nil' ).
       code_test( code = 'mandt'
                  expected = '<ABAP Data>' ).
     ENDMETHOD.                    "abap_data

     METHOD abap_data_t005g.
       code_test( code = '(define t005g (ab-data "T005G"))'
                  expected = 't005g' ).
       code_test( code = '(ab-set t005g "LAND1" "ZA")'  " Set field "LAND1" to "ZA"
                  expected = 'nil' ).
       code_test( code = '(ab-get t005g "LAND1")'       " Return the value of field "LAND1"
                  expected = 'ZA' ).
     ENDMETHOD.                    "abap_data

     METHOD empty_structure.
       code_test( code = '(define t005g (ab-data "T005G"))'
                  expected = 't005g' ).
       code_test( code = '(ab-set-value t005g ''("000" "ZA" "ABC" "JHB"))'
                  expected = 'nil' ).
       code_test( code = '(ab-get-value t005g)'
                  expected = '( 000 ZA ABC JHB )' ).
       code_test( code = '(ab-get t005g "LAND1")'
                  expected = 'ZA' ).
     ENDMETHOD.                    "empty_structure

     METHOD user_name.
       DATA lv_uname TYPE string.
       lv_uname = sy-uname.
       code_test( code = '(ab-get ab-sy "UNAME")'
                  expected = lv_uname ).
     ENDMETHOD.                    "user_name

   ENDCLASS.                    "ltc_abap_integration IMPLEMENTATION

*----------------------------------------------------------------------*
*       CLASS ltc_abap_function_module DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_abap_function_module DEFINITION INHERITING FROM ltc_interpreter
     FOR TESTING RISK LEVEL HARMLESS DURATION SHORT.
     PRIVATE SECTION.
       METHODS setup.
       METHODS teardown.
       METHODS get_first_profile RETURNING value(rv_prof) TYPE xuprofile.
       METHODS get_ip_address RETURNING value(rv_addrstr) TYPE ni_nodeaddr.

       METHODS fm_user_info FOR TESTING.
       METHODS fm_test_rfc FOR TESTING.
       METHODS fm_user_details FOR TESTING.


   ENDCLASS.                    "ltc_abap_function_module DEFINITION

*----------------------------------------------------------------------*
*       CLASS ltc_abap_function_module IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
   CLASS ltc_abap_function_module IMPLEMENTATION.

     METHOD setup.
       CREATE OBJECT mo_int.
     ENDMETHOD.                    "setup

     METHOD teardown.
       FREE mo_int.
     ENDMETHOD.                    "teardown

     METHOD get_ip_address.
       CALL FUNCTION 'TH_USER_INFO'
         IMPORTING
           addrstr = rv_addrstr.
     ENDMETHOD.                    "get_ip_address

     METHOD fm_user_info.
*;(let ( ( f1 (ab-function "TH_USER_INFO")  )  )
*;       ( begin (f1) (ab-get f1 "ADDRSTR")  )
       code_test( code = '(ab-function "TH_USER_INFO")'
                  expected = '<ABAP function module TH_USER_INFO>' ).
       code_test( code = '(define f1 (ab-function "TH_USER_INFO"))'
                  expected = 'f1' ).
       code_test( code = '(f1)'
                  expected = '<ABAP function module TH_USER_INFO>' ).
       code_test( code = '(ab-get f1 "ADDRSTR")'
                  expected = get_ip_address( ) ).
     ENDMETHOD.                    "fm_user_info

     METHOD fm_test_rfc.
*; (let ( (f2 (ab-function "TH_TEST_RFC"))  )
*;        ( begin (ab-set f2 "TEXT_IN" "Calling from ABAP Lisp" )
*;                  (f2) (ab-get f2 "TEXT_OUT")  ) )
       code_test( code = '(define f2 (ab-function "TH_TEST_RFC"))'
                  expected = 'f2' ).
       code_test( code = '(ab-set f2 "TEXT_IN" "Calling from ABAP Lisp")'
                  expected = 'nil' ).
       code_test( code = '(f2)'
                  expected = '<ABAP function module TH_TEST_RFC>' ).
       code_test( code = '(ab-get f2 "TEXT_OUT")'
                  expected = 'Calling from ABAP Lisp' ).
     ENDMETHOD.                    "fm_test_rfc

     METHOD get_first_profile.
       DATA lt_profiles TYPE STANDARD TABLE OF bapiprof.
       DATA ls_profiles TYPE bapiprof.
       DATA lt_return TYPE bapiret2_t.

       CALL FUNCTION 'BAPI_USER_GET_DETAIL'
         EXPORTING
           username = sy-uname
         TABLES
           profiles = lt_profiles
           return   = lt_return.

       READ TABLE lt_profiles INDEX 1 INTO ls_profiles.
       rv_prof = ls_profiles-bapiprof.
     ENDMETHOD.                    "get_first_profile


     METHOD fm_user_details.
*(let (( profiles
*        (let ( (f3 (ab-function "BAPI_USER_GET_DETAIL"))  )
*        ( begin (ab-set f3 "USERNAME" (ab-get ab-sy "UNAME") )
*                  (f3) (ab-get f3 "PROFILES")  ) )
*        ) )
*   (let ((profile (ab-get profiles 1)) )
*             (ab-get profile "BAPIPROF" )  )
*)
       code_test( code = '(define f3 (ab-function "BAPI_USER_GET_DETAIL"))'
                  expected = 'f3' ).
       code_test( code = '(ab-set f3 "USERNAME" (ab-get ab-sy "UNAME"))'
                  expected = 'nil' ).
       code_test( code = '(f3)'
                  expected = '<ABAP function module BAPI_USER_GET_DETAIL>' ).
       code_test( code = '(define profiles (ab-get f3 "PROFILES"))'
                  expected = 'profiles' ).
       code_test( code = 'profiles'
                  expected = '<ABAP Table>' ).

       code_test( code = '(define profile (ab-get profiles 1))'
                  expected = 'profile' ).
       code_test( code = '(ab-get profile "BAPIPROF")'
                  expected = get_first_profile( ) ).
     ENDMETHOD.                    "fm_user_details

   ENDCLASS.                    "ltc_abap_function_module IMPLEMENTATION
 

That is all for now

A Simple Game

Guess My Number
;----------------------------------------------------------
;; guess my number between 1 and 100

(define *big* 100)
(define *small* 1)

(define (guess) (round (/ (+ *big* *small*) 2)) )
(define (larger) (set! *small* (+ 1 (guess))) (guess))
(define (smaller) (set! *big* (- (guess) 1)) (guess))

(define (restart) (set! *big* 100) (set! *small* 1) (guess))

; my number is 16 - the logic needs 7 steps
(restart)   ; 51
(smaller) ; 26
(smaller) ; 13
(larger)  ; 20
(smaller) ; 17
(smaller) ; 15
(larger)  ; 16 

;--------- now your number
(restart) ; 51