Source code in the action! programming language

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

TYPE Frac=[INT num,den]

REAL half

PROC PrintFrac(Frac POINTER x)
  PrintI(x.num) Put('/) PrintI(x.den)
RETURN

INT FUNC Gcd(INT a,b)
  INT tmp

  IF a
    tmp=a a=b b=tmp
  FI

  WHILE b#0
  DO
    tmp=a MOD b
    a=b 
    b=tmp
  OD
RETURN (a)

PROC Init(INT n,d Frac POINTER res)
  IF d>0 THEN
    res.num=n res.den=d
  ELSEIF d<0 THEN
    res.num=-n res.den=-d
  ELSE
    Print("Denominator cannot be zero!")
    Break()
  FI
RETURN

PROC Assign(Frac POINTER x,res)
  Init(x.num,x.den,res)
RETURN

PROC Neg(Frac POINTER x,res)
  Init(-x.num,x.den,res)
RETURN

PROC Inverse(Frac POINTER x,res)
  Init(x.den,x.num)
RETURN

PROC Abs(Frac POINTER x,res)
  IF x.num<0 THEN
    Neg(x,res)
  ELSE
    Assign(x,res)
  FI
RETURN

PROC Add(Frac POINTER x,y,res)
  INT common,xDen,yDen
  
  common=Gcd(x.den,y.den)
  xDen=x.den/common
  yDen=y.den/common
  Init(x.num*yDen+y.num*xDen,xDen*y.den,res)
RETURN

PROC Sub(Frac POINTER x,y,res)
  Frac n

  Neg(y,n) Add(x,n,res)
RETURN

PROC Mult(Frac POINTER x,y,res)
  Init(x.num*y.num,x.den*y.den,res)
RETURN

PROC Div(Frac POINTER x,y,res)
  Frac i

  Inverse(y,i) Mult(x,i,res)
RETURN

BYTE FUNC Greater(Frac POINTER x,y)
  Frac diff

  Sub(x,y,diff)
  IF diff.num>0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC Less(Frac POINTER x,y)
RETURN (Greater(y,x))

BYTE FUNC GreaterEqual(Frac POINTER x,y)
  Frac diff

  Sub(x,y,diff)
  IF diff.num>=0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC LessEqual(Frac POINTER x,y)
RETURN (GreaterEqual(y,x))

BYTE FUNC Equal(Frac POINTER x,y)
  Frac diff

  Sub(x,y,diff)
  IF diff.num=0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC NotEqual(Frac POINTER x,y)
  IF Equal(x,y) THEN
    RETURN (0)
  FI
RETURN (1)

INT FUNC Sqrt(INT x)
  REAL r1,r2

  IF x=0 THEN
    RETURN (0)
  FI
  IntToReal(x,r1)
  Power(r1,half,r2)
RETURN (RealToInt(r2))

PROC Main()
  DEFINE MAXINT="32767"
  INT i,f,max2
  Frac sum,tmp1,tmp2,tmp3,one

  Put(125) PutE() ;clear screen
  ValR("0.5",half)
  Init(1,1,one)
  FOR i=2 TO MAXINT
  DO
    Init(1,i,sum) ;sum=1/i
    max2=Sqrt(i)
    FOR f=2 TO max2
    DO
      IF i MOD f=0 THEN
        Init(1,f,tmp1)     ;tmp1=1/f
        Add(sum,tmp1,tmp2) ;tmp2=sum+1/f
        Init(f,i,tmp3)     ;tmp3=f/i
        Add(tmp2,tmp3,sum) ;sum=sum+1/f+f/i
      FI
    OD

    IF Equal(sum,one) THEN
      PrintF("%I is perfect%E",i)
    FI
  OD
RETURN