Functions and procedures

• lcdiv2.mos: Recursive function calls
• primefct.mos: function returning a set
• qsort1.mos: 'forward' definition of subroutines
• qsort2.mos: Overloading of subroutines
• shsortfct.mos: Function returning an array
• subrout.mos: Local and global declarations, fixed and variable number of arguments
• reftosubr.mos: Working with subroutine references, using mmreflect functionality for retrieving and calling subroutines

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

   file lcdiv2.mos 
   ``````````````` 
   Recursive function calls.
 
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, 2001, rev. Jun. 2022
*******************************************************!)

model Lcdiv2

 function lcdiv(a,b:integer):integer
   if a=b then
     returned:=a
   elif a>b then
     returned:=lcdiv(b,a-b)
   else
     returned:=lcdiv(a,b-a)
   end-if   
 end-function

 declarations
   A,B: integer
 end-declarations

 write("Enter two integer numbers:\n  A: ")
 readln(A)
 write("  B: ")
 readln(B)

 writeln("Largest common divisor: ", lcdiv(A,B))

end-model

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

   file primefct.mos 
   `````````````````
   Working with sets. Function returning a set.
 
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, Nov. 2005
*******************************************************!)

model "Prime (fct)"
 parameters
  LIMIT=100                     ! Search for prime numbers in 2..LIMIT
 end-parameters

 forward function calc_prime(l: integer): set of integer

 declarations
  P: set of integer             ! Set of prime numbers
 end-declarations
 
 writeln("Prime numbers between 2 and ", LIMIT, ":")

 P:= calc_prime(LIMIT)          ! Calculate prime numbers

 writeln(P)
 writeln(" (", getsize(P), " prime numbers.)")


!*****************************************************************

 function calc_prime(l: integer): set of integer
  declarations
   SNumbers: set of integer     ! Set of numbers to be checked
   SPrime: set of integer       ! Set of prime numbers
  end-declarations

  SNumbers:={2..LIMIT} 

  n:=2
  repeat
    while (not(n in SNumbers)) n+=1
    SPrime += {n}               ! n is a prime number
    i:=n
    while (i<=LIMIT) do         ! Remove n and all its multiples
      SNumbers-= {i}
      i+=n
    end-do
  until SNumbers={}    
  returned:= SPrime
 end-function
 
end-model

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

   file qsort1.mos 
   ``````````````` 
   'forward' definition of subroutines.
 
   (c) 2008 Fair Isaac Corporation
       author: Y. Colombani, 2001, rev. Sep. 2022
*******************************************************!)

model "Quick sort 1"

 parameters
  LIM=50
 end-parameters

 forward procedure startqsort(L:array(range) of integer)
(! Equivalent form of declaration:
 declarations 
  procedure startqsort(L:array(range) of integer)
 end-declarations
!) 

 declarations
  T:array(1..LIM) of integer
 end-declarations

 forall(i in 1..LIM) T(i):=round(.5+random*LIM)
 writeln(T)
 startqsort(T)
 writeln(T)
 
 
! Swap the positions of two numbers in an array
 procedure swap(L:array(range) of integer,i,j:integer)
  k:=L(i)
  L(i):=L(j)
  L(j):=k
 end-procedure


! Main sorting routine
 procedure qsort(L:array(range) of integer,s,e:integer)
  v:=L((s+e) div 2)              ! Determine a partitioning value
  i:=s; j:=e
  repeat                         ! Partition the array into two subarrays
   while(L(i)<v) i+=1
   while(L(j)>v) j-=1
   if i<j  then
    swap(L,i,j)
    i+=1; j-=1
   end-if
  until i>=j
                                 ! Recursively sort the two subarrays
  if j<e and s<j: qsort(L,s,j)
  if i>s and i<e: qsort(L,i,e)
 end-procedure


! Start of the sorting process 
 procedure startqsort(L:array(r:range) of integer)
  qsort(L,getfirst(r),getlast(r))
 end-procedure

end-model

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

   file qsort2.mos 
   ``````````````` 
   Overloading of subroutines.
 
   (c) 2008 Fair Isaac Corporation
       author: Y. Colombani, 2001
*******************************************************!)

model "Quick sort 2"

 parameters
  LIM=50
 end-parameters

 forward procedure qsort(L:array(range) of integer)
(! Equivalent form of declaration:
 declarations 
  procedure qsort(L:array(range) of integer)
 end-declarations
!)

 declarations
  T:array(1..LIM) of integer
 end-declarations

 forall(i in 1..LIM) T(i):=round(.5+random*LIM)
 writeln(T)
 qsort(T)
 writeln(T)
 
 
! Swap the positions of two numbers in an array
 procedure swap(L:array(range) of integer,i,j:integer)
  k:=L(i)
  L(i):=L(j)
  L(j):=k
 end-procedure


! Main sorting routine
 procedure qsort(L:array(range) of integer,s,e:integer)
  v:=L((s+e) div 2)              ! Determine a partitioning value
  i:=s; j:=e
  repeat                         ! Partition the array into two subarrays
   while(L(i)<v) i+=1
   while(L(j)>v) j-=1
   if i<j  then
    swap(L,i,j)
    i+=1; j-=1
   end-if
  until i>=j
                                 ! Recursively sort the two subarrays
  if j<e and s<j then qsort(L,s,j); end-if
  if i>s and i<e then qsort(L,i,e); end-if
 end-procedure


! Start of the sorting process 
 procedure qsort(L:array(r:range) of integer)
  qsort(L,getfirst(r),getlast(r))
 end-procedure

end-model

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

   file shsortfct.mos 
   `````````````````` 
   Combining the 'repeat-until', 'while-do', and 
   'forall-do' loops. Function returning an array.
 
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, Nov. 2005, rev. Sep. 2022
*******************************************************!)

model "Shell sort (fct)"

 declarations
  N: integer                     ! Size of array ANum
  R: range                       ! Index range of the arrays
  ANum: array(R) of real         ! Unsorted array of numbers
  ASorted: array(R) of real      ! Sorted array of numbers
 end-declarations

 forward function shsort(ANum: array(R) of real): array(R) of real

 N:=50
 forall(i in 1..N)
  ANum(i):=round(random*100)

 writeln("Given list of numbers (size: ", N, "): ")
 forall(i in 1..N) write(ANum(i), " ")
 writeln
 
 ASorted:= shsort(ANum)
 
 writeln("Ordered array: ")
 forall(i in 1..N) write(ASorted(i), " ")
 writeln

!***************************************************************

 function shsort(ANum: array(R) of real): array(R) of real
  returned:=ANum                 ! Copy the array to be sorted 
                                 ! (Return the sorted array) 
  inc:=1                         ! Determine the starting increment
  repeat                         
    inc:=3*inc+1
  until (inc>N)  
 
  repeat                         ! Loop over the partial sorts
    inc:=inc div 3
    forall(i in inc+1..N) do     ! Outer loop of straight insertion
      v:=returned(i)
      j:=i
      while (returned(j-inc)>v) do   ! Inner loop of straight insertion
        returned(j):=returned(j-inc)
        j -= inc
        if j<=inc: break
      end-do
      returned(j):= v     
    end-do  
  until (inc<=1)
 end-function
 
end-model

(!*******************************************************
   Mosel User Guide Examples
   =========================

   file subrout.mos
   ````````````````
   Simple subroutines.
   
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, 2001, rev. Jun. 2022
  *******************************************************!)

model "Simple subroutines"

 declarations
   a:integer
 end-declarations

 function three:integer
   returned := 3
 end-function

 function timestwo(b:integer):integer
   returned := 2*b
 end-function

 procedure printstart
   writeln("The program starts here.")
 end-procedure

 procedure hide_a_1
   declarations
     a: integer
   end-declarations
 
   a:=7
   writeln("Procedure hide_a_1: a = ", a) 
 end-procedure

 procedure hide_a_2(a:integer)
   a:=2
   writeln("Procedure hide_a_2: a = ", a) 
 end-procedure

(! This version generates an error because 'a' is declared twice
 procedure hide_a_3(a:integer)
   declarations
     a: integer
   end-declarations

   a := 15
   writeln("Procedure hide_a_3: a = ", a) 
 end-procedure
!)

! Corrected version of hide_a_3
 procedure hide_a_3(aa:integer)
   declarations
     a: integer
   end-declarations

   a := 15
   writeln("Procedure hide_a_3: a = ", a, ", aa = ", aa) 
 end-procedure

 printstart 
 a:=three
 writeln("a = ", a)
 a:=timestwo(a)   
 writeln("a = ", a)
 hide_a_1
 writeln("a = ", a)
 hide_a_2(-10)
 writeln("a = ", a)
 hide_a_3(a)
 writeln("a = ", a)


! Subroutines with variable number of arguments
 function sumall(Values:...): integer
   returned:= sum(i in Values) i.integer
 end-function

 procedure showint(Optargs:...)
   forall(i as counter, v in Optargs)
     if v is integer then writeln("arg ", i, ": ", v.integer); end-if
 end-procedure

 writeln("sum = ", sumall(a, 1, 2, 3, 4, 5))

 showint(1.5,0,"abc",true,5)

end-model 

(!******************************************************
   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