(!******************************************************
   Mosel User Guide Example Problems
   ================================= 

   file reftosubr.mos 
   ``````````````````
   Subroutine references:
   * declaration, type definition
   * assignment ('reference to' operator) and invocation
   * subroutine returning a subroutine
   * error handling
   * using mmreflect functionality for retrieving and calling subroutines
 
   (c) 2022 Fair Isaac Corporation
       author: S. Heipcke, Mar. 2022
*******************************************************!)
model "subroutine references"
 uses "mmsystem", "mmreflect"

 declarations
   myfct: function(real):real    ! Subroutine reference
   u: any
   realfct=function(real):real   ! Subroutine type definition
 end-declarations

 function div2(r:real):real
   returned:=r/2
 end-function

 myfct:=->div2
 writeln("div2(10)=", myfct(10))

 u:=->div2
 writeln(u)        ! Display the internal name of the subroutine
! In order to call 'u' as a subroutine we need to know its type
! (or alternatively, use 'callproc' or 'callfunc' of mmreflect)
 writeln("div2(10)=", u.realfct(10))

!**** Typed(=declared) list of subroutines
 declarations
   L: list of function(real):real
! or equivalently:
!  L: list of realfct
 end-declarations

 L:=[->cos,->sin,->arctan,->abs,->exp,->div2]
 forall(i in [-1.0,0.5]) do
   write(formattext("i=%3g:", i))
   forall(f in L) write(formattext(" %10g", f(i)))
   writeln
 end-do

!**** Untyped list of functions
 L2:=[->cos,->sin,->arctan,realfct(->abs),->exp,->div2]
 forall(i in [-1.0,0.5]) do
   write(formattext("i=%3g:", i))
   forall(f in L2) write(formattext(" %10g", f.realfct(i)))
   writeln
 end-do

!**** Subroutine as return type in subroutine definition
 function choose(name:string):function(real):real
   case name of
     "cos": returned:= ->cos
     "abs": returned:= ->abs
     "div": returned:= ->div2
     else writeln("Unknown selection '", name, "'")
   end-case
 end-function
 fsel:=choose("cos")
 if isdefined(->fsel) then
   writeln("cos(1)=", fsel(1))
 end-if
! Reset cancels the association
 reset(->fsel)
 if not isdefined(->fsel) then
   writeln("no function selected")
 end-if

 fsel:=choose("error")
 if not isdefined(->fsel) then
   writeln("no function selected")
 end-if

!****Syntax for calling an element of an array of subroutines with arguments
 declarations
   arfct:array(string) of function(real):real
! or equivalently:
!  arfct:array(string) of realfct
 end-declarations

 arfct("cos"):= ->cos
 arfct("sin"):= ->sin
 writeln("cos(1)=", arfct("cos")(1))

!*********************Using mmreflect functionality*********************

!**** Retrieving and calling a function with arguments
 declarations
   res:any
 end-declarations

 if findident("div2", u, realfct.id)<>0 then
   callfunc(u,res,real(-10))
! Same behaviour as:
!  res:= u.realfct(-10)
   writeln("Result:", res)      ! or:   res.real
 end-if

!**** Calling a subroutine with a list of arguments
 declarations
   procrs=procedure(real,real,real)
 end-declarations

 public procedure mysum(a,b,c:real)
   writeln(a+b+c)
 end-procedure

 asproc(findident("mysum", u, procrs.id))
! Simpler form that results in the same:
!  u:= procrs(->mysum)
 write("mysum+lsa:" ); callproclsa(u, [1.2,3.4,5.6])
! Same as:
 write("mysum:" ); callproc(u, 1.2, 3.4, 5.6)

!**** Retrieving and calling a procedure with arguments
 declarations
   procstr=procedure(string)
 end-declarations

 public procedure hello(msg:string)
   writeln("hello ", msg)
 end-procedure
 
 if findident("hello", u, procstr.id)<>0 then
   u.procstr("world")                  ! Output:  'hello world'
! Same behaviour as:
!  callproc(u,"world")
 end-if

 stat:=findident("hello", u)
 if stat.struct=STRUCT_ROUTINE and stat.eltype=0 then
   callproc(u, "world")                ! Output:  'hello world'
 end-if

!**** Retrieving all procedures that match a given name
! Overloaded version with a different signature
 public procedure hello
   writeln("hello")
 end-procedure

 declarations
   flist: list of any
 end-declarations 

 asproc(findident("hello", flist))
 forall(ff in flist,ct as counter) 
   writeln("Entry ", ct, " is a procedure: ", ff is procedure,
     " returns nothing: ", ff.rettype=0, " signature: '", ff.signature, "'")

end-model