real: remove PolyGP
authorMichal Terepeta <michal.terepeta@gmail.com>
Mon, 13 Mar 2017 22:36:32 +0000 (18:36 -0400)
committerBen Gamari <ben@smart-cactus.org>
Mon, 13 Mar 2017 23:44:06 +0000 (19:44 -0400)
The benchmark doesn't compile and was not enabled. I tried fixing it,
but it seems to take excessive amount of time & memory (didn't finish
in 60s, which required over 10GiB of RAM). Sounds like another
candidate for removal.

Signed-off-by: Michal Terepeta <michal.terepeta@gmail.com>
Test Plan: build & run

Reviewers: bgamari

Differential Revision: https://phabricator.haskell.org/D3329

13 files changed:
real/Makefile
real/PolyGP/Auxil.hs [deleted file]
real/PolyGP/Create.hs [deleted file]
real/PolyGP/Eval.hs [deleted file]
real/PolyGP/Evolve.hs [deleted file]
real/PolyGP/Header.hs [deleted file]
real/PolyGP/Local.hs [deleted file]
real/PolyGP/Main.hs [deleted file]
real/PolyGP/Makefile [deleted file]
real/PolyGP/Para [deleted file]
real/PolyGP/PolyGP.stderr [deleted file]
real/PolyGP/PolyGP.stdout [deleted file]
real/PolyGP/Unify.hs [deleted file]

index 891c41d..c9c4f5c 100644 (file)
@@ -5,7 +5,6 @@ SUBDIRS = anna bspt cacheprof compress compress2 fem fluid fulsom gamteb gg \
           grep hidden hpg infer lift linear maillist mkhprog parser pic prolog \
           reptile rsa scs symalg veritas
 
-OTHER_SUBDIRS = PolyGP
 
 include $(TOP)/mk/target.mk
 
diff --git a/real/PolyGP/Auxil.hs b/real/PolyGP/Auxil.hs
deleted file mode 100644 (file)
index 15aa316..0000000
+++ /dev/null
@@ -1,238 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Auxil.hs : contains supporting function defination for the system.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Auxil where
-import Local(args,retType,testData,myName,expectResults,maxScore,evalFitness,printFitness)
-import Header(TypeExp(..),ParseTree(..),Expression(..),Population(..))
-import Create(createTree,extract)
-import Evolve(mutateExp,xOverExp)
-import Eval(evalExp,atoi,atof)
-import Unify(applySubToExp,unify)
-import Trace
-
--- getParas function -----------------------------------------------------------------------------
---
-
-getParas :: String -> Int -> Int -> Int -> Int -> Double -> Int -> (Int, Int, Int, Int, Double, Int)
-
-getParas inputs treeDepth popSize randomInt maxEval parScale xOverRate = 
-  case inputs of
-     {
-       [] -> (treeDepth, popSize, randomInt, maxEval, parScale, xOverRate);
-
-       _ ->
-       let (current, rest)= nextWord inputs []
-           (value,rest') = nextWord rest []
-       in if current == "treeDepth=" then 
-               getParas rest' (atoi value) popSize randomInt maxEval parScale xOverRate
-          else if current == "popSize=" then 
-               getParas rest' treeDepth (atoi value) randomInt maxEval parScale xOverRate
-          else if current == "randomInt=" then 
-               getParas rest' treeDepth popSize (atoi value) maxEval parScale xOverRate
-          else if current == "maxEval=" then
-               getParas rest' treeDepth popSize randomInt (atoi value) parScale xOverRate
-          else if current == "parScale=" then
-               getParas rest' treeDepth popSize randomInt maxEval (atof value) xOverRate
-          else
-               getParas rest' treeDepth popSize randomInt maxEval parScale (atoi value)
-     }
-
--- nextWord --------------------------------------------------------------------------
---
-
-nextWord :: String -> String -> (String,String)
-
-nextWord [] word = error "Parameter inputs empty."
-nextWord (x:xs) word = if x `elem` ['\n', '\r', ' '] then (word, xs) else nextWord xs (word ++ [x])
-
---create function-----------------------------------------------------------------------------------------------
--- 
-
---This function creates population with specified popSize. It checks to make sure that
--- every tree created is unique. Each individual is a lambada Expression.
---
-
-create :: Int -> Population -> [Int] -> Int -> (Population,[Int])
-
-create num pop rList treeDepth = 
---trace ("num is : " ++ show num) $
-  case num of
-    {
-       0 -> trace ("create: top fitness is: "++show (snd (head pop))) $
-            (pop,rList);
-       _ -> case (createTree treeDepth retType rList [] 1) of
-              { (aTree, rList', theta, typeNum') ->
-                let exp = applySubToExp (extract aTree) theta
-                    createProgram exp args = 
-                       case args of
-                       { [] -> exp;
-                         (hdArg:tlArgs) -> createProgram (Lambda hdArg exp) tlArgs
-                       }
-                    program = createProgram exp args
-                in
-                    if ( aMem program pop) || (notExist args program) || (not (exist (Function myName) program )) 
-                    then
-                       create num pop rList' treeDepth
-                    else               
-                       if (num `mod` printFitness) == 0 && not (null pop) then
-                          trace ("create: top fitness is: "++show (snd (head pop))) $
-                          create (num-1) (inSort(getFitness (program, 0.0) [(myName,program)] args testData 
-                               expectResults) pop) rList' treeDepth 
-                       else
-                          create (num-1) (inSort(getFitness (program, 0.0) [(myName,program)] args testData 
-                               expectResults) pop) rList' treeDepth
-               }
-     }
-
---exist function-----------------------------------------------------------------------
---     
-exist :: Expression -> Expression -> Bool
-
-exist e exp = case exp  of
-             {
-               (Application exp1 exp2 t) ->
-                       if exist e exp1 then True
-                       else exist e exp2;
-               (Lambda s exp) ->
-                       exist e exp;
-               _ -> if e == exp then True else False
-             }
-
-notExist [] program = False
-notExist (first:rest) program = if not (exist (Variable first) program) then True
-                               else
-                                notExist rest program
-
--- aMem function--------------------------------------------------------------------
---
-                               
-aMem :: Expression -> Population -> Bool
-
-aMem exp1 exp2 = case exp2 of
-                {
-                 [] -> False;
-                 ((aExp,fitness):rest) ->
-                       if exp1 == aExp then True
-                       else aMem exp1 rest
-                }
-
--- getFitness function---------------------------------------------------------------------
---
--- This function takes 5 arguments: the name of an expression, the expression and it's original
--- fitness value, argument name list and testData. It appends test data into expression before 
--- evaluation.
-
-getFitness :: (Expression,Double) -> [(String,Expression)] -> [String] -> [Expression] -> [Expression] -> (Expression,Double)
-
-getFitness (tree, fitness) adfs args [] expectResults = (tree, fitness)
-
-getFitness (tree, fitness) adfs args testData expectResults =
-  if fitness == 10000.00 then (tree, 20000.00) else  -- 10000 means bug in the evolved program
-       let createProgram exp (last:[]) ((List aList):tlData) expectResults =  
-               (Application exp (List aList) IntNum, tlData, length aList , 
-               (head expectResults), (tail expectResults))
-           createProgram exp (hdArg:tlArgs) (hdData:tlData) expectResults = 
-               createProgram (Application exp hdData IntNum) tlArgs tlData expectResults -- IntNum type is wrong
-           createProgram exp [] testData expectResults = error "No Argument variable is provided."
-           createProgram exp args [] expectResults = error "No test data is provided."
-           (program, testData', recursionLimit, theResult, expectResults') = 
-               createProgram tree args testData expectResults
-           (aResult,rtError,halt,debug) = evalExp program adfs recursionLimit False True False
-       in
-           --(tree,(aResult,rtError),0.0)
-           --trace ("getFitness : "++ show program ++ show testData'++show recursionLimit) $
-           if debug then
-               (tree,10000.00)
-           else
-               getFitness (tree,(evalFitness theResult aResult rtError halt + fitness )) adfs args testData' expectResults'
-
-
--- inSort function ---------------------------------------------------------------
---
-
-inSort :: (Expression,Double) -> Population -> Population
-
-inSort exp [] = exp:[] 
-inSort (exp1,fitness1)((exp2,fitness2):rest) =
-       if fitness1 < fitness2  then
-               (exp2,fitness2):inSort (exp1,fitness1) rest
-       else
-               (exp1,fitness1):((exp2,fitness2):rest)                  
-
---evolve function --
--- steady-stead with 
-
-evolve :: Population -> Int -> Double -> Int -> Int -> Int -> [Double] -> [Int] -> (Population,[Double],[Int]) 
-evolve [] maxEval parScale popSize treeDepth xOverRate dList rList = error "Empty population."
-evolve pop@((exp,fitness):rest) maxEval parScale popSize treeDepth xOverRate dList rList = 
-   if fitness >= maxScore then 
-       trace ("The perfect score in pop: "++show fitness++show exp)$
-       (pop,dList,rList)
-   else
-   case maxEval of
-       { 0 -> (pop,dList,rList);
-         _ ->
-         let popSizeInReal = fromInteger (toInteger popSize) 
-              selValue dList = ((head dList) * popSizeInReal * (parScale ^ popSize) * ( 1.0 - parScale ^ popSize) / 
-                           (parScale ^ popSize * (1.0 - parScale)), tail dList)
-              selIndex currVal randomVal | randomVal <= currVal = 0 -- 0-origin
-                                        | otherwise =  1 + selIndex (currVal*parScale) (randomVal - currVal)
-             getIndex aSeed = let i = selIndex popSizeInReal aSeed in if i < popSize then i else (popSize -1)
-             (seed1,dList') = selValue dList
-             parent1 = pop !! (getIndex seed1)
-             (seed2,dList'') = selValue dList'
-             (firstBorn,theta, rList') 
-                       = if (maxEval `mod` 1000 ) < xOverRate then
-                               xOverExp (fst parent1) (fst ( pop !! (getIndex seed2))) treeDepth treeDepth rList
-                         else
-                               mutateExp (fst parent1) treeDepth treeDepth rList
-          in
-               if (aMem firstBorn pop) || (notExist args firstBorn) || (not (exist (Function myName) firstBorn )) 
-               then
-                       evolve pop maxEval parScale popSize treeDepth xOverRate dList'' rList'
-               else
-                       let (child,fitness) = getFitness (firstBorn,0.00)
-                                  [(myName,firstBorn)] args testData expectResults
-                           pop' = inSort (child,fitness) pop
-                           pop'' = init pop'
-                       in
-                          if fitness >= maxScore then
-                               trace ("The number of evaluation done is the parameter maxEval - "++show maxEval++show "\n"++show parent1++show "\n"++show (pop !! (getIndex seed2))) $
-                               (pop'',dList'',rList')                          
-                           else if ((maxEval-1) `mod` printFitness) == 0 then
-                               trace ("evolve: top fitness is: "++show (snd (head pop))) $
-                               evolve pop'' (maxEval-1) parScale popSize treeDepth xOverRate dList'' rList'
-                           else
-                               evolve pop'' (maxEval-1) parScale popSize treeDepth xOverRate dList'' rList'
-       }
-
-displayPop :: Int -> Population -> IO ()
-
-displayPop num pop =
-  case (num,pop) of
-    {
-       (_,[]) -> print "Population empty";
-
-       (0,_) -> print "Done";
-
-       (_,_ ) ->
-               print (head pop) >>
-               putChar '\n' >>
-               displayPop (num - 1 ) (tail pop)
-     }
-
-
---indexL function--
-
-indexL item aList =
-  case aList of
-    {
-       [] -> 0 ;
-       (hd:tl) -> if item == hd then 1
-                       else ( 1 + indexL item tl)
-    }
diff --git a/real/PolyGP/Create.hs b/real/PolyGP/Create.hs
deleted file mode 100644 (file)
index b59b7f5..0000000
+++ /dev/null
@@ -1,287 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Create.hs : contains function defination to generate program
- --            parse trees.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Create (createTree,extract)where
-import Header (TypeExp(..), Expression(..),ParseTree(..))
-import Local (termEnv,funEnv,constant,adfs,args) 
-import Unify (applySub, unify, Theta(..))
-import Data.Array
-
--- selectTerm function -----------------------------------------------------------------
---
--- This function takes a type expression, a theta, a randomList and typeNum. It return a tuple
--- of the following elements: flag indicates whether a terminal is selected, the name
--- of the terminal, theta created, new random list and new typeNum.
--- If the expected retrun type contains temporary tyep variables, 
--- we first instaniate dummy type variables in the selected terminal type
--- with new temporary type variables before "unifying" it with the return 
--- type.
-
-selectTerm :: TypeExp -> Theta -> [Int] -> Int -> (Bool, String,Theta, [Int], Int)
-
-selectTerm retType theta rList typeNum = 
-  let (start, end) = bounds termEnv
-      index = (head rList `mod` end) + start
-      match currIndex init = 
-       if not init && (currIndex == index) then
-               (False, "", theta, tail rList, typeNum)
-       else if currIndex > end then
-               match start init
-       else 
-               case ( termEnv ! currIndex ) of
-               {
-               (name,typeSig) ->
-                  if hasTypeVar retType then
-                       case (instDummy typeSig typeNum []) of
-                       {
-                       (typeSig', typeNum', dummyTheta) ->
-                          case unify True [(retType, typeSig')] theta of
-                          {
-                          (unifiable, theta') ->
-                             if unifiable then
-                               (True, name, theta', tail rList, typeNum')
-                             else
-                               match (currIndex +1) False
-                           }
-                       }
-                  else
-                     case ( unify True [(retType,typeSig)][] ) of
-                     {
-                       (unifiable, theta') -> 
-                         if unifiable then
-                               (True, name, theta, tail rList, typeNum)
-                         else
-                               match (currIndex +1) False
-                       }
-               }
-  in
-           match index True
-
--- selectFun function -----------------------------------------------------------------
---
--- This function takes a type expression, a theta, first and last index and typeNum. 
--- It return a tuple of the following elements: flag indicates whether a function is selected, 
--- the name of the function, its argument type signatuer, theta created, index of the function
--- and new typeNum.
--- If the expected retrun type contains temporary tyep variables, 
--- we first instaniate dummy type variables in the selected function type
--- with new temporary type variables before "unifying" it with the return 
--- type.
-
-selectFun :: TypeExp -> Theta -> Int -> Int -> Int -> (Bool, String, TypeExp, Theta, Int, Int)
-
-selectFun retType theta first last typeNum =
-  --trace("selectFun : " ++ show first ++ show last ) $
-  let (start, end) = bounds funEnv
-      match currIndex init = 
-       if not init && (currIndex == last) then
-               (False, "", retType, theta, first, typeNum) -- retType means nothing
-       else if currIndex > end then
-               match start init
-       else
-               let (name,typeSig) = funEnv ! currIndex
-               in if hasTypeVar retType then
-                       let (typeSig', typeNum', dummyTheta) = instDummy typeSig typeNum []
-                           (unifiable, argsType,theta') = getArgsType retType typeSig' theta
-                       in
-                         if unifiable then
-                               (True, name, argsType, theta', currIndex, typeNum')
-                         else
-                               match (currIndex +1) False
-                  else
-                       let (unifiable, argsType,theta') = getArgsType retType typeSig []
-                       in if unifiable then
-                               let (argsType', typeNum', dummyTheta) = instDummy argsType typeNum []
-                               in (True, name, argsType', theta, currIndex, typeNum')
-                          else
-                               match (currIndex + 1) False
-  in
-    match first True
-
-
--- instDummy function -----------------------------------------------------------------------
---
--- This fucntion takes a type expression and instantiates all dummy type variables with
--- temporary type variables. It returns the new type expression and new TypeNum
-
-instDummy :: TypeExp -> Int -> Theta -> (TypeExp,Int,Theta)
-
-instDummy typeExp typeNum theta =
-       case typeExp of
-       {
-       (DummyType x) -> let typeExp' = TypeVar ("T"++show typeNum)
-                        in (typeExp',(typeNum + 1),(x,typeExp'):theta);
-       (Arrow t1 t2) -> let (t1', typeNum', theta') = instDummy t1 typeNum theta
-                            (t2', typeNum'', theta'') = instDummy (applySub theta' t2) typeNum' theta'
-                        in (Arrow t1' t2', typeNum'', theta'');
-       (Brackets t) -> let (t', typeNum', theta') = instDummy t typeNum theta
-                       in (Brackets t',typeNum', theta');
-       (ListType t) -> let (t', typeNum', theta') = instDummy t typeNum theta
-                       in (ListType t',typeNum', theta');
-       _ -> (typeExp, typeNum, theta)
-       }
-
--- hasTypeVar function ---------------------------------------------------------
---
---
-
-hasTypeVar :: TypeExp -> Bool
-
-hasTypeVar typeExp = 
-       case typeExp of
-       {
-       (TypeVar _) -> True;
-       (Arrow t1 t2) -> (hasTypeVar t1) || (hasTypeVar t2);
-       (Brackets t) -> hasTypeVar t;
-       (ListType t) -> hasTypeVar t;
-       _ -> False
-       }
-
--- createTree function ----------------------------------------------------------
---
--- This function takes 6 arguments: a depth level, return type, randomList, theta typeNum and genTypes.
--- It returns a ParseTree with the specifed depth and return type.
--- We basically use "full" method unless no non-terminal to match the required type.
--- In that case, we pick a terminal and stop growing. 
-
-createTree ::  Int -> TypeExp -> [Int] -> Theta -> Int -> ( ParseTree, [Int], Theta, Int)
-
-createTree 1 retType rList theta typeNum =
- --trace ("create1 "++show retType++show theta) $
-  let retType' = applySub theta retType
-      (findOne, name, theta', rList', typeNum') = selectTerm retType' theta rList typeNum
-  in 
-   --trace ("selectTerm: "++show name++show theta') $  
-   if not findOne then    -- fail, no variable that matches the return type
-       (Empty, rList, theta, typeNum)
-   else        
-       if (elem name constant) then
-          (ExpCons (Constant name), rList', theta', typeNum')
-   else
-       if name == "nil" then
-          (ExpCons (List []), rList', theta', typeNum')
-       else
-          (ExpCons (Variable name), rList', theta', typeNum')
-
-createTree level retType rList theta typeNum =
- --trace ("create "++show level++show retType++show theta) $
-    let retType' = applySub theta retType
-       (start, end) = bounds funEnv
-       orgIndex = (head rList `mod` end) + start       
-    in
-       --trace ("info: "++show retType'++show start++show end++show orgIndex) $        
-       let f1 first last init rList = 
-               if not init && (first == last) then
-                       createTree 1 retType' rList theta typeNum -- create leaf ( grow method )
-               else
-               let (findOne, name, argsType, theta', index, typeNum')=
-                       selectFun retType' theta first last typeNum
-               in 
-                 --trace ("selectFun: "++show findOne++show name++show argsType++show theta'++show index) $    
-                 if not findOne then     -- fail, no function matches the return type,
-                       createTree 1 retType' rList theta typeNum -- create leaf ( grow method )
-                 else
-                       let f2 argType retType rList theta typeNum =
-                               case argType of
-                               {
-                               (Arrow t1 t2) -> 
-                               let getRetType t = 
-                                       case t of
-                                       {
-                                       (Arrow t1 s@(Arrow t2 t3)) -> 
-                                               let (aType, rType)= getRetType s
-                                               in  (Arrow t1 aType, rType);
-                                       (Arrow t1 t2) -> (t1,t2)
-                                       }
-                                   (argType', newRetType) = getRetType argType
-                                   (exp2, rList', theta', typeNum') =
-                                               createTree (level-1) newRetType rList theta typeNum
-                               in if exp2 == Empty then 
-                                       (Empty,Empty,rList',[],typeNum')
-                                  else 
-                                       let argType'' = applySub theta' argType'
-                                           newRetType' = applySub theta' newRetType
-                                           (exp1', exp2',rList'',theta'',typeNum'') = 
-                                               f2 argType'' (Arrow newRetType' retType) rList' theta' typeNum'
-                                       in if (exp1'==Empty) || (exp2'==Empty) then
-                                               (Empty,Empty,rList'',[],typeNum'')
-                                            else
-                                               (ExpCons (Application (extract exp1') (extract exp2') 
-                                                       (Arrow (applySub theta'' newRetType')
-                                               (applySub theta'' retType))), exp2, rList'', theta'', typeNum'');
-                               _ -> case (createTree (level-1) argType rList theta typeNum) of
-                                       { 
-                                       (exp2,rList',theta',typeNum') ->
-                                               if exp2 == Empty then 
-                                               (Empty, Empty, rList, [], typeNum)
-                                               else
-                                               if (elem name adfs) then
-                                                       ( ExpCons(Function name), exp2, rList', theta', typeNum')
-                                               else
-                                                       if (elem name args ) then
-                                                       ( ExpCons (Variable name), exp2, rList', theta', typeNum')
-                                                       else
-                                                       ( ExpCons(Primitive name), exp2, rList', theta', typeNum')
-                                       }
-                               }
-                       in
-                       --trace ("f1 in "++show name++show argTypes++show retType'++show newTheta) $
-                       case (f2 argsType retType' rList theta' typeNum') of
-                       { 
-                       (exp1, exp2, rList', theta'', typeNum'') ->
-                       if (exp1==Empty) || (exp2==Empty) then
-                               f1 (index +1) last False rList' 
-                       else
-                               (ExpCons (Application (extract exp1)(extract exp2) retType'), rList', theta'', typeNum'')
-                       }
-       in      
-         f1 orgIndex orgIndex True (tail rList)
-
-
-
-
--- getArgsType function ----------------------------------------------------------------
---
--- This function takes an expected type and a function type. It unify the expected type
--- with the function return type. It then instaniate the argument type using the theta.
--- It returns the instantiated argument type.
-
-getArgsType :: TypeExp -> TypeExp -> Theta -> (Bool, TypeExp, Theta)
-
-getArgsType retType typeExp theta =
-       let unifyRetType aType theta = case aType of
-                       {
-                        (Arrow argType rType) -> unifyRetType rType theta; 
-                        _ -> unify True [(retType,aType)] theta
-                       }
-           (unifiable,theta') = unifyRetType typeExp theta
-       in if unifiable then
-          let  typeExp' = applySub theta' typeExp
-               retType' = applySub theta' retType          
-               f exp = case exp of
-                  {
-                   (Arrow t1 t2) -> if t2 == retType' then t1
-                                       else (Arrow t1 (f t2));
-                   _ -> error ("error in getArgsType ")
-                   }
-          in
-               (True, (f typeExp'), theta')
-          else
-               (False, typeExp, theta)     
-
---no need to deal with arrow situation since functions are curried
-
---extract -----------------------------------------------------------------------------
-extract :: ParseTree -> Expression
-
-extract exp = case exp of
-       {
-       Empty -> error "Empty expression";
-       (ExpCons x) -> x
-       }
-
diff --git a/real/PolyGP/Eval.hs b/real/PolyGP/Eval.hs
deleted file mode 100644 (file)
index 7402845..0000000
+++ /dev/null
@@ -1,436 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Eval.hs : contains function definition which evaluate/interpret
- --          the genetic programs evolved by the system.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Eval (evalExp,atoi,atof) where
-import Header(TypeExp(..), Expression(..))
-import Local(runTimeErrorHandler)
-import Data.Char(ord)
-import Trace
-
-
-
---evalExp function---------------------------------------------------------------
---
--- This function takes 3 arguments : an expression, an adf list and counter.
--- It evaluates the expression and return its result, an expression. The counter
--- is used to check for recursive calls.
-
-evalExp:: Expression -> [(String,Expression)] -> Int -> Bool -> Bool -> Bool -> (Expression,Bool,Bool,Bool)
-
-evalExp exp adfs counter rtError halt debug = 
-  case exp of
-    {
-       (Constant x) -> (exp, rtError, halt,debug);
-       (List x) -> (exp, rtError, halt,debug);
-       (Variable x) -> (exp, rtError, halt,debug);
-       (Primitive x) -> (exp, rtError, halt,debug);
-       (Function x) -> (exp, rtError, halt ,debug);
-       (Lambda x e) -> (exp, rtError, halt,debug);
-
-       -- head,tail,null (strict)
-
-       (Application (Primitive f) arg t) ->
-        --trace ("Primitive1 : "++ show f ++ show arg ) $ 
-               if (not halt) || debug then
-                       (errorHandler t, rtError, halt, debug)
-               else
-                       doPrim1 f arg t adfs counter rtError True False;
-
-       --+,-,==,cons(non-strict)
-
-       (Application (Application (Primitive f) arg1 t1) arg2 t2) ->
-       --trace ("Primitive2 : "++ show f ++ show arg1 ++ show arg2) $ 
-               if (not halt) || debug then
-                       (errorHandler t2, rtError, halt, debug)
-               else
-                       doPrim2 f arg1 arg2 t2 adfs counter rtError True False;
-
-       --if-then-else (1st arg strict)
-
-       (Application (Application (Application (Primitive f) arg1 t1 ) arg2 t2 ) arg3 t3) ->
-       --trace ("Primitive3 : "++ show f ++ show arg1 ++ show arg2 ++ show arg3) $ 
-               if (not halt) || debug then
-                       (errorHandler t3, rtError, halt, debug)
-               else
-                       doPrim3 f arg1 arg2 arg3 t3 adfs counter rtError True False;
-
-       --applicative-order reduction
-
-       (Application (Lambda x e) y t) ->
-       --trace ("Lambda "++ show x ++ show e ++ show y) $ 
-       if (not halt) || debug then
-               (errorHandler t, rtError, halt, debug)
-       else
-               case (evalExp y adfs counter rtError True False) of 
-                { (y', rtError', halt',debug') -> 
-                       if (not halt') || debug' then
-                         (errorHandler t,rtError',True, False)
-                       else
-                         evalExp (betaReduction y' x e) adfs counter rtError' True False
-               };
-
-       --normal-order reduction (app (app (lambda f.lambda l e) aF) aL)
-
-       (Application (Application (Lambda f e) aF t1) aL t2) ->
-       --trace ("Lambda "++ show f ++ show e ++ show aF ++ show aL) $ 
-       if (not halt) || debug then
-               (errorHandler t2 ,rtError, halt, debug)
-       else    
-               case (evalExp aF adfs counter rtError True False) of
-               { (aF',rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (errorHandler t2, rtError', halt',debug')
-                 else
-                       evalExp (Application (betaReduction aF' f e) aL t2) adfs counter rtError' True False
-               };
-
-       --make a copy of the adf expression
-
-       (Application (Function x) e t) ->
-       --trace ("Function "++ show x ++ show e ) $ 
-       if (counter <= 0) || (not halt)  then 
-               (errorHandler t,rtError, False, debug) -- map return type is ListType TypeVar T2
-       else if debug then
-               (errorHandler t,rtError, True, True) -- map return type is ListType TypeVar T2
-       else
-               evalExp (Application (lookUp x adfs) e t) adfs (counter-1) rtError True False;
-
-       --make a copy of the adf expression
-
-       (Application (Application (Function x) e1 t1) e2 t2) ->
-       --trace ("Function "++ show x ++ show e1 ++ show e2) $ 
-       if (counter <= 0) || not halt then 
-               (errorHandler t2, rtError, False, debug) -- map return type is ListType TypeVar T2
-       else if debug then
-               (errorHandler t2, rtError, True, True)
-       else
-               evalExp (Application (Application (lookUp x adfs) e1 t1) e2 t2) adfs (counter-1) rtError True False;
-
-       (Application f e t) ->  --** a DEBUGGING statement--
-               trace ("evalExp:  "++ show exp ) $
-               (errorHandler t, rtError, halt, True)
-       }
-
---doPrim1 function--------------------------------------------------------------------------------------------
---
--- This function takes 6 arguments : name of the primitive function, expression to be evaluated ,
--- return type of the expression, adf list, counter and rtError flag.
--- It evaluates the expression and returns the result.
--- Note: only when the rtError is False that is function can be envoked. evalExp checks this.
-
-doPrim1 :: String -> Expression -> TypeExp -> [(String, Expression)] -> Int -> Bool -> Bool -> Bool -> (Expression,Bool,Bool,Bool)
-
-doPrim1 funName exp aType adfs counter rtError halt debug = 
-       case funName of
-       {
-         "head" ->
-               --trace ("doPrim1 head :"++show exp) $
-               case (evalExp exp adfs counter rtError halt debug) of
-               { (List aList, rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (errorHandler aType, rtError', halt', debug')
-                 else
-                       if null aList then -- head of [] is a run-time error
-                       (errorHandler aType, True, True, False)
-                       else 
-                       evalExp (head aList) adfs counter rtError' True False;
-                 (exp', rtError', halt', debug') -> --** a DEBUGGING statement--
-                       trace ("head:  "++ show exp ) $
-                       (errorHandler aType, rtError', halt', True)
-               };
-
-         "tail" ->
-               --trace ("doPrim1 tail :"++show exp) $
-               case (evalExp exp adfs counter rtError halt debug) of
-               { (List aList,rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (errorHandler aType, rtError', halt', debug')
-                 else
-                       if null aList then 
-                               (List [],True,True, False)  -- tail of [] is []. ?? wrong ??
-                       else 
-                               evalExp (List (tail aList)) adfs counter rtError' True False;
-                 (exp', rtError', halt', debug') -> --** a DEBUGGING statement--
-                       trace ("tail:  "++ show exp ) $
-                       (errorHandler aType, rtError', halt', True)     
-               };
-
-       "null" ->
-               --trace ("doPrim1 null :"++show exp) $
-               case (evalExp exp adfs counter rtError halt debug) of
-               { (List aList,rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (Constant "false",rtError', halt', debug')
-                 else
-                       if (null aList) then 
-                               (Constant "true",rtError',True, False)
-                       else (Constant "false",rtError', True,False);
-                 (exp', rtError', halt', debug') -> --** a DEBUGGING statement--
-                       trace ("null:  "++ show exp ) $
-                       (errorHandler aType, rtError', halt', True)
-               };
-
-       "length" ->
-               --trace ("doPrim1 length :"++show exp) $
-               case (evalExp exp adfs counter rtError halt debug) of
-               { (List aList,rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (Constant "0",rtError', halt', debug')
-                 else
-                       (Constant (show (length aList)),rtError', True,False);
-
-                 (exp', rtError', halt', debug') -> --** a DEBUGGING statement--
-                       trace ("length:  "++ show exp ) $
-                       (errorHandler aType, rtError', halt', True)
-               };
-
-       "aton" ->
-               --trace ("doPrim1 aton :"++show exp) $
-               case (evalExp exp adfs counter rtError halt debug) of
-               { (Constant alphabet,rtError', halt',debug') ->
-                 if (not halt') || debug' then
-                       (Constant "0",rtError', halt', debug')
-                 else
-                       (Constant (show ((ord (head alphabet))-64)) ,rtError', True,False);
-
-                 (exp', rtError', halt', debug') -> --** a DEBUGGING statement--
-                       trace ("aton:  "++ show exp ) $
-                       (errorHandler aType, rtError', halt', True)
-               };
-
-       _ ->  --** a DEBUGGING statement--
-       trace ("doPrim1:  "++ show funName ++ show exp) $
-       (errorHandler aType, rtError, halt, True)
-       }
-
--- doPrim2 function ---------------------------------------------------------------------------
--- This is the doPrim2 function
-
-doPrim2 :: String -> Expression -> Expression -> TypeExp -> [(String,Expression)] -> Int -> Bool -> Bool -> Bool -> (Expression, Bool,Bool,Bool)
-
-doPrim2 funName e1 e2 t adfs counter rtError halt debug = 
-  case funName of
-  {
-       "+" ->
-       --trace ("doPrim2 + :"++show e1 ++ show e2) $
-       let (Constant a,rtError',halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (Constant b,rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "0", rtError'', halt'', debug'')
-           else
-               (Constant (show ( (atoi a)+ (atoi b))), rtError'', True, False);
-
-       "-" ->
-       --trace ("doPrim2 - :"++show e1 ++ show e2) $
-       let (Constant a, rtError', halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (Constant b, rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "0", rtError'', halt'', debug'')
-           else
-               (Constant (show ((atoi a)- (atoi b))),rtError'', True, False);
-       "*" ->
-       --trace ("doPrim2 + :"++show e1 ++ show e2) $
-       let (Constant a,rtError',halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (Constant b,rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "0", rtError'', halt'', debug'')
-           else
-               (Constant (show ( (atoi a) * (atoi b))), rtError'', True, False);
-
-       "==" ->
-       --trace ("doPrim2 == :"++show e1 ++ show e2) $
-       let (e1', rtError',halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (e2', rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "false", rtError'', halt'', debug'')
-           else
-           case (e1',e2') of
-           {
-           (Constant a, Constant b) ->
-               if ((atoi a) == (atoi b)) == True then
-                       (Constant "true", rtError'', True, False)
-               else
-                       (Constant "false", rtError'', True, False);
-            _ -> trace ("== : " ++ show e1 ++ show e1' ++ show e2 ++show e2') $
-                 error ("==  error \n")
-           };
-
-       "<=" ->
-       --trace ("doPrim2 <= :"++show e1 ++ show e2) $
-       let (e1', rtError',halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (e2', rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "false", rtError'', halt'', debug'')
-           else
-           case (e1',e2') of
-           {
-           (Constant a, Constant b) ->
-               if ((atoi a) <= (atoi b)) == True then
-                       (Constant "true", rtError'', True, False)
-               else
-                       (Constant "false", rtError'', True, False);
-            _ -> trace ("<= : " ++ show e1 ++ show e1' ++ show e2 ++show e2') $
-                 error ("<=  error \n")
-           };
-
-       ">" ->
-       --trace ("doPrim2 > :"++show e1 ++ show e2) $
-       let (e1', rtError',halt',debug') = evalExp e1 adfs counter rtError halt debug
-           (e2', rtError'', halt'',debug'') = evalExp e2 adfs counter rtError' halt' debug'
-       in
-           if (not halt'') || debug'' then
-               (Constant "false", rtError'', halt'', debug'')
-           else
-           case (e1',e2') of
-           {
-           (Constant a, Constant b) ->
-               if ((atoi a) > (atoi b)) == True then
-                       (Constant "true", rtError'', True, False)
-               else
-                       (Constant "false", rtError'', True, False);
-            _ -> trace ("> : " ++ show e1 ++ show e1' ++ show e2 ++show e2') $
-                 error (">  error \n")
-           };
-
-       --both x and exp are strict
-       "cons" ->
-       --trace ("doPrim2 cons:"++ show e1 ++ show e2) $
-       case (evalExp e1 adfs counter rtError halt debug) of
-       { (e1',rtError', halt',debug') ->
-          if (not halt') || debug' then
-               (List [],rtError', halt', debug')
-          else
-               case (evalExp e2 adfs counter rtError' True False) of
-               { (List e2',rtError'',halt'',debug'') ->
-                  if (not halt'') || debug'' then
-                       (List [], rtError'', halt'', debug'')
-                  else
-                       (List (e1':e2'), rtError'', True, False);
-                 (e2', rtError'', halt'', debug'') -> --** a DEBUGGING statement--
-                       trace ("cons:  "++ show e1++show e2) $
-                       (errorHandler t , rtError'', halt'', True)
-               }
-       };
-
-       _ -> --** a DEBUGGING statement--
-       trace ("doPrim2: "++ show funName ++ show e1 ++ show e2) $
-       (errorHandler t , rtError, halt, True)
-       }
-       
--- atoi function --------------------------------------------------------------------------------
---
-atoi :: String -> Int
-atoi ('-':s) = value - value*2
-               where value = atoi s
-atoi s = foldl g 0 s
-        where 
-        g x y = (10 * x) + ((ord y) - 48)
-
--- atof function ------------------------------------------------------------------
---
-
-atof :: String -> Double
-atof s = let (intPart,decimalPart) = break (=='.') s
-        in fromInteger (toInteger (atoi intPart)) + 
-               fromInteger (toInteger (atoi (tail decimalPart))) / 
-               10.00 ^ fromInteger (toInteger (length decimalPart - 1))
-
--- doPrim3 function ---------------------------------------------------------------------------
---
-
-doPrim3 :: String -> Expression -> Expression -> Expression -> TypeExp -> [(String,Expression)] -> Int -> Bool -> Bool -> Bool -> (Expression,Bool,Bool,Bool)
-
-doPrim3 funName test e1 e2 t adfs counter rtError halt debug = 
-   case funName of
-     {
-       "if-then-else" ->
-       --trace ("doPrim3 if-then-else :"++ show test ++show e1 ++ show e2) $
-       case (evalExp test adfs counter rtError halt debug) of
-       { (result,rtError',halt', debug') ->
-         if (not halt') || debug' then
-               (errorHandler t, rtError', halt', debug')
-          else
-               if result == (Constant "true") then
-                       evalExp e1 adfs counter rtError' True False
-               else if result == (Constant "false") then
-                       evalExp e2 adfs counter rtError' True False
-               else --** a DEBUGGING statement--
-                       trace ("if-then-else:  "++ show test ++show result) $
-                       (errorHandler t, rtError', halt', True)                 
-       };
-
-       _ ->  --** a DEBUGGING statement--
-       trace ("doPrim3:  "++ show funName ++ show test++show e1++show e2) $
-       (errorHandler t, rtError, halt, True)
-     }
-
--- betaReduction funcation ----------------------------------------------------------------------------
--- replace y with x in e
---
-betaReduction :: Expression -> String ->  Expression -> Expression
-
-betaReduction y x exp = 
-  case exp of
-    {
-       (Constant v) -> exp;
-       (Primitive v) -> exp;
-       (Function v) -> exp;
-       (List v) -> exp;
-       (Variable v) -> if v == x then --trace ("betaReduction: "++show v++show y++show x) $ 
-                               y 
-                       else Variable v;
-       (Application e1 e2 t) -> (Application (betaReduction y x e1)(betaReduction y x e2) t);
-       (Lambda a e) -> (Lambda a (betaReduction y x e))
-     }
-
--- need to deal with free variable, so far we use
--- different lambda-bound variable name to 
--- avoid the problem
-
--- lookUp function ---------------------------------------------------------------------------
---
--- This function takes 2 arguments: the name of the adf and the list of adfs.
--- It returns the adf (an expression) in the list whose name matches the given
--- name.
-
-lookUp :: String -> [(String, Expression)] -> Expression
-
-lookUp x table = case table of
-               {
-                [] -> error "bad reference to ADF";
-                ((y,pt):rest) -> if  (x == y) then pt
-                                 else lookUp x rest 
-               }
-
---errorHandler function -------------------------------------------------------------------
---
---
-errorHandler :: TypeExp -> Expression
-
-errorHandler t = errorHandlerAux t runTimeErrorHandler
-
-errorHandlerAux :: TypeExp -> [(TypeExp, Expression)] -> Expression 
-
-errorHandlerAux aType handlers = 
-       case (aType, handlers ) of
-       {
-       (ListType x, (ListType _, exp):rest) -> exp ;
-       (Brackets x, (Brackets _, exp):rest) -> exp ;
-       (TypeVar x, (TypeVar _, exp):rest) -> exp ;
-       (GenType x, (TypeVar _, exp):rest) -> exp ;
-       (aType, (typeExp, exp):rest) -> if aType == typeExp then exp 
-               else errorHandlerAux aType rest ;
-       (aType, []) -> trace ("errorHandler : " ++ show aType) $
-                       --   error "errorHandler"
-                       (List [])
-       }
diff --git a/real/PolyGP/Evolve.hs b/real/PolyGP/Evolve.hs
deleted file mode 100644 (file)
index 0df0724..0000000
+++ /dev/null
@@ -1,152 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Evolve.hs : contains genetic operations (crossover and mutation)
- --            defination for the system.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Evolve (mutateExp,xOverExp) where
-import Header(TypeExp(..), ParseTree(..),Expression(..))
-import Create(createTree,extract)
-import Unify(Theta(..),unify,xoverUnify,applySubToExp)
-import Eval(atoi)
-
-
----mutateExp-------------------------------------------------------------------------------
---
--- This function takes a parse tree, a level and a randomList as arguments.
--- If the parse tree is successfully mutated, it returns the new parse tree.
--- Otherwise, it returns the orginal parse tree.
--- Mutation can't be performed at partial application node.
-
-mutateExp::  Expression -> Int -> Int -> [Int] -> (Expression, Theta, [Int])
-
-mutateExp anExp level treeDepth rList =
---  trace ("mutateExp "++show level) $
-  case anExp of
-    {
-       (Lambda s exp) ->
-               case (mutateExp exp level treeDepth rList) of
-                       {(exp', theta, rList') -> (Lambda s (applySubToExp exp' theta), theta, rList')};
-
-       (Application exp1 exp2 aType@(Arrow t1 t2)) -> 
-               case (mutateExp exp2 level treeDepth rList) of
-               { (exp2', theta, rList') ->
-                       if  exp2 == exp2' then
-                               case (mutateExp exp1 level treeDepth rList') of
-                               { (exp1',theta',rList'') ->
-                               (Application exp1' exp2 aType, theta', rList'')
-                               }
-                       else
-                               (Application exp1 exp2' aType, theta, rList')
-               };
-
-
-       (Application exp1 exp2 aType) ->
-               if (level /= treeDepth) && odd (head rList) then  -- we do not mutate at root level
-                       case (createTree level aType (tail rList) [] 20) of -- typeNum starts at 20
-                       { (newTree, rList', theta, typeNum') ->
-                               if newTree == Empty then
-                                       (anExp,[], rList')
-                               else 
-                                       (extract newTree, theta, rList')
-                       }
-               else -- no muation on this node, try subtrees
-                       case (mutateExp exp2 (level-1) treeDepth (tail rList)) of
-                       { (exp2',theta,rList') -> 
-                               if exp2 == exp2' then -- no mutation happening
-                               case (mutateExp exp1 (level-1) treeDepth rList') of
-                               { (exp1',theta',rList'') -> 
-                                       (Application exp1' exp2 aType,theta',rList'')
-                               }
-                               else
-                               (Application exp1 exp2' aType,theta,rList')
-               };
-
-       _ -> (anExp, [], rList)
-    }
-
-
--- xOverExp function----------------------------------------------------------------------------
---
--- This function takes two parse trees and performs crossover with them.
--- It returns one new prase tree if success or the first tree if not.
-
-xOverExp :: Expression -> Expression -> Int -> Int -> [Int] -> (Expression,Theta,[Int])
-
-xOverExp anExp tree2 level treeDepth rList = 
---  trace ("xOverExp "++show level) $
-  case anExp of
-    {
-       (Lambda s exp) -> 
-               --trace ("xOver lambda "++show exp++show level) $
-               case (xOverExp exp tree2 level treeDepth rList) of
-                       { (exp', theta, rList') -> (Lambda s (applySubToExp exp' theta), theta, rList')};
-
-       (Application exp1 exp2 aType) ->
-               --trace ("xOver App"++show aType++show tree2++show level) $
-               if ( even (head rList) ) then -- we do xover at root level
-                       case (selectTree aType tree2 level treeDepth (tail rList)) of
-                       { (newTree, theta, rList') -> 
-                               if newTree == Empty then
-                                       (anExp,[], rList')
-                               else
-                                       (extract newTree, theta, rList')
-                       }
-               else -- no xOver on this node, try subtrees, left to right
-                       case (xOverExp exp2 tree2 (level-1) treeDepth (tail rList)) of
-
-                       { (exp2',theta,rList') ->
-                               if exp2 == exp2' then -- no xover happening
-                               case (xOverExp exp1 tree2 (level-1) treeDepth rList') of
-                               { (exp1',theta',rList'') -> (Application exp1' exp2 aType,theta',rList'')}
-                               else
-                               (Application exp1 exp2' aType,theta,rList')
-                       };
-
-       _ -> --trace ("xOver others"++show anExp++show level) $
-            (anExp, [], rList) -- don't do xover at leaf (constant, variable)
-     }
-
-
---selectTree function-------------------------------------------------------------
---
---This function takes a Type and a Parse Tree. It select a branch in the Parse Tree
---which returns the same type as the given type. It either returns a new Tree or
---an Empty tree.
---Note: both aType and typeExp can contain type variable.      
-
-selectTree :: TypeExp -> Expression -> Int -> Int -> [Int] -> (ParseTree, Theta, [Int])
-
-selectTree aType anExp level treeDepth rList = 
-  --trace ("selectTree "++show level) $
-  case anExp of
-     {
-       (Lambda x exp) ->
-               selectTree aType exp level treeDepth rList;
-
-       (Application exp1 exp2 typeExp) ->
-       -- trace ("selectTree"++show aType++show (Application exp1 exp2 typeExp)++show level) $
-       if (level >= treeDepth && odd (head rList)) then
-               let (unifiable,theta) = xoverUnify True [(aType, typeExp )][]
-               in if unifiable then
-                       (ExpCons anExp, theta, tail rList)
-                  else
-                       (Empty,[], tail rList)
-       else -- did not select this node, try subtrees, from left to right
-               case (selectTree aType exp2 (level+1) treeDepth (tail rList)) of
-               { (newBranch,theta,rList') ->
-                       if newBranch == Empty then 
-                          selectTree aType exp1 (level+1) treeDepth rList'
-                       else
-                          (newBranch,theta,rList')
-               };
-
-       _ -> (Empty, [], rList)
-     }
-
-
-
-
-
diff --git a/real/PolyGP/Header.hs b/real/PolyGP/Header.hs
deleted file mode 100644 (file)
index 7c7cb98..0000000
+++ /dev/null
@@ -1,60 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Header.hs : contains type definition for the system.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Header where
-
--- TypeExp data type --------------------------------------------------------------------------
---
--- This is the type subexpression language used in the system.
-
-data TypeExp =  IntNum |
-               Boolean |
-               Str    |
-               ListType TypeExp  | 
-               Arrow TypeExp TypeExp |
---             TypeExp :--> TypeExp
-               Brackets TypeExp |
-               TypeVar String |
-               DummyType String |
-               GenType String 
-               deriving (Eq,Show)
-
-
-                     
--- ParseTree data type -----------------------------------------------------------------
--- 
--- Pares Tree is either an Empty tree or an Expression
-
-data ParseTree = Empty 
-               | ExpCons Expression
-                 deriving (Eq,Show)    
-
--- Expression data type ------------------------------------------------------------
---
---
-
-type ExpressionList = [Expression]
-type Population = [(Expression, Double)] 
---type Population = [(Expression, Temp ,Double)] --for testing eval function
---type Temp = (Expression,Bool,Bool)
-
--- data Program = Main Expression [(ADF,String)]       -- ADFs and their names
-
--- data Program = Start Expression
--- data ADF     = Lambda1 String Expression TypeExp
---              | LambdaN String ADF TypeExp
-
-data Expression = Constant String 
-                | List ExpressionList -- (List []) is the empty list
-                | Variable String
-                | Primitive String
-                 | Function String     -- name of ADF - see list above
-                 | Application Expression Expression TypeExp 
-                | Lambda String Expression
-                  deriving (Eq,Show)   
-
-
diff --git a/real/PolyGP/Local.hs b/real/PolyGP/Local.hs
deleted file mode 100644 (file)
index 5a96e55..0000000
+++ /dev/null
@@ -1,125 +0,0 @@
-{----------------------------------------------------------
- --
- -- Local.hs : the information related to the evolved Map function
- -- T.Yu@cs.ucl.ac.uk   September 25, 1997
- --
- ----------------------------------------------------------}
-
-module Local where
-import Header (Expression(..),TypeExp(..),ExpressionList(..))
-import Data.Array(Array, array)                
-import Data.Char(ord)
---import Eval(atoi)
---import Auxil(indexL)
-
--- termEnv -----------------------------------------------------------------------------------
--- This is the terminal set for Map program
-
-type Entry = (String, TypeExp)
-
-termEnv :: Array Int Entry
-termEnv = array(1,3) [ (1, ("nil", ListType (DummyType "a"))),
-                      (2, ("l", ListType (GenType "G1"))),
-                      (3, ("f", Brackets (Arrow (GenType "G1")(GenType "G2"))))]
-
--- funEnv -------------------------------------------------------------------------------
--- This is the function set for Map program
-
-funEnv :: Array Int Entry
-funEnv = array (1,7) [ (1, ("if-then-else", Arrow Boolean (Arrow (DummyType "a") 
-                               (Arrow (DummyType "a")(DummyType "a"))))), 
-                      (2, ("map", Arrow  (Brackets (Arrow (GenType "G1")(GenType "G2"))) 
-                               (Arrow (ListType (GenType "G1"))(ListType (GenType "G2"))))),
-                      (3, ("head", Arrow (ListType (DummyType "a")) (DummyType "a"))),
-                      (4, ("tail", Arrow (ListType (DummyType "a")) (ListType (DummyType "a")))),
-                      (5, ("f", Arrow (GenType "G1")(GenType "G2"))),
-                      (6, ("cons", Arrow (DummyType "a") (Arrow (ListType (DummyType "a")) (ListType (DummyType "a"))))),
-                      (7, ("null", Arrow (ListType (DummyType "a")) Boolean))]
-
--- runTimeErrorHandler---------------------------------------------------------------------------
--- This is the runTimeErrorHander set
-
-runTimeErrorHandler :: [(TypeExp, Expression)]
-
-runTimeErrorHandler= [(IntNum, (Constant "0")),
-                     (Boolean, (Constant "false")),
-                     (Str, (Constant " ")),
-                     (TypeVar "x", Constant "0"), -- this is a problem
-                     (GenType "x", Constant "0"),
-                     (ListType (TypeVar "x"), (List [])),
-                     (Brackets (Arrow (TypeVar "x")(TypeVar "y")),(Lambda "x" (Variable "x")))]
-
--- Mis parameters -----------------------------------------------------------------------------
---
-
-constant = []
-adfs = ["map"]
-args = ["l","f"] -- lambda f. lambda l --
-retType = (ListType (GenType "G2")) 
-myName = "map"
-maxScore = 100.00
-printFitness = 500
-
--- test data---------------------------------------------------------------------
--- This is the test data for map program
-
-testData :: ExpressionList
-
-testData = [(Lambda "x" (Application (Primitive "aton") (Variable "x") IntNum)),(List [(Constant "A"),(Constant "B"),(Constant "C"),(Constant "D"),(Constant "E"),(Constant "F"),(Constant "G"),(Constant "H"),(Constant "I"),(Constant "J")]),(Lambda "x" (Application (Primitive "aton") (Variable "x") IntNum)), (List [])]
-
--- Expect Results ---------------------------------------------------------------------
--- This is the Expect Results
-
-expectResults = [(List [(Constant "1"),(Constant "2"),(Constant "3"),(Constant "4"),(Constant "5"),(Constant "6"),(Constant "7"),(Constant "8"),(Constant "9"),(Constant "10")]),(List [])]
-
--- this is the fitness function for map only ---
---
--- S = -10 - 2 * length(L) -- rtError 
---     -10 - 2 * length(L) -- not halt
---     -2 * |length(L)-length(lr)| + sum ( 10 * 2 ** -dist(e,lr) )
---
-
-evalFitness :: Expression -> Expression -> Bool -> Bool -> Double
-
-evalFitness (List theExp) (List aExp) rtError halt = 
-       let aLength = length aExp
-           theLength = length theExp
-           sum [] aExp = 0.0
-           sum (s@(Constant v):tl) aExp = 
-               if s `notElem` aExp then
-                       sum tl aExp
-               else
-                        fromRational (10 / (2 ^ (abs ((indexL s aExp) - (atoi v))))) + sum tl aExp
-           sum any aExp = error "bad fitness value."
-           rtEval = if rtError then
-                       -10 - 2 * theLength
-                    else
-                       0
-           haltEval = if halt then 
-                       0 
-                      else
-                       -10 -2 * theLength
-       in  --trace ("evalFitness : "++show aExp++show theExp ++show rtEval) $
-           fromInteger (toInteger (- (2 * abs (aLength - theLength)))) + sum theExp aExp + fromInteger (toInteger rtEval )+ fromInteger (toInteger haltEval)
-
--- otherwise there is bug in the program
-evalFitness exp1 exp2 retError halt = -10000.00                
-
---the same code is in eval.hs. The extra copy avoids import eval.hs and solve
---compilation mutual dependency problem.
-atoi :: String -> Int
-atoi ('-':s) = value - value*2
-               where value = atoi s
-atoi s = foldl g 0 s
-        where 
-        g x y = (10 * x) + ((ord y) - 48)
-
---indexL function--
-
-indexL item aList =
-  case aList of
-    {
-       [] -> 0 ;
-       (hd:tl) -> if item == hd then 1
-                       else ( 1 + indexL item tl)
-    }
diff --git a/real/PolyGP/Main.hs b/real/PolyGP/Main.hs
deleted file mode 100644 (file)
index 6702d40..0000000
+++ /dev/null
@@ -1,27 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Main.hs : the main program for the PolyGP system.
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Main where
-import Header(Expression(..),TypeExp(..))
-import Auxil (getParas, create, evolve, displayPop)
-import System.Environment (getArgs)
-import System.Random (randomInts,randomDoubles)
-
-main = getArgs         >>=     \ [f1]          ->
-       readFile f1     >>=     \ inputs        ->
-       let (treeDepth, popSize, randomInt, maxEval, parScale, xOverRate) = getParas inputs 0 0 0 0 0.0 0
-       in if (treeDepth==0 || popSize==0 || randomInt==0 || maxEval==0 || parScale==0.0 || xOverRate==0) then
-               print "Parameter reading fails."
-          else
-              let (population, rList) = create popSize [] (randomInts randomInt (randomInt + 10)) treeDepth
-                  (population', dList, rList') = evolve population maxEval parScale popSize treeDepth xOverRate
-                                  (randomDoubles randomInt (randomInt+10)) rList
-               in 
-                  displayPop 1 population'
-
-
-
diff --git a/real/PolyGP/Makefile b/real/PolyGP/Makefile
deleted file mode 100644 (file)
index 95ded59..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-SRC_HC_OPTS += -syslib hbc
-SRC_RUNTEST_OPTS += Para +RTS -H16m
-include $(TOP)/mk/target.mk
-
diff --git a/real/PolyGP/Para b/real/PolyGP/Para
deleted file mode 100644 (file)
index d61f69a..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-treeDepth= 5
-popSize= 5000
-randomInt= 20
-maxEval= 30000
-parScale= 0.999
-xOverRate= 1000
diff --git a/real/PolyGP/PolyGP.stderr b/real/PolyGP/PolyGP.stderr
deleted file mode 100644 (file)
index 8454702..0000000
+++ /dev/null
@@ -1,87 +0,0 @@
-Trace On:
-create: top fitness is: -30.0
-Trace Off.
-Trace On:
-create: top fitness is: -30.0
-Trace Off.
-Trace On:
-create: top fitness is: -30.0
-Trace Off.
-Trace On:
-create: top fitness is: -30.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-create: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -20.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -8.0
-Trace Off.
-Trace On:
-evolve: top fitness is: -6.0
-Trace Off.
-Trace On:
-The number of evaluation done is the parameter maxEval - 20901"\n"(Lambda "f" (Lambda "l" (Application (Application (Application (Primitive "if-then-else") (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow Boolean (Arrow Boolean Boolean))) (Application (Primitive "null") (Variable "l") Boolean) (Arrow Boolean Boolean)) (Application (Primitive "head") (List []) Boolean) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Primitive "head") (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow (ListType (ListType (GenType "G2"))) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2")))))) (Application (Application (Primitive "cons") (List []) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2"))))) (List []) (ListType (ListType (GenType "G2")))) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2"))))) (Application (Primitive "tail") (List []) (ListType (ListType (GenType "G2")))) (ListType (ListType (GenType "G2")))) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Primitive "cons") (Application (Primitive "head") (List []) (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Function "map") (Variable "f") (Arrow (ListType (GenType "G1")) (ListType (GenType "G2")))) (Application (Primitive "tail") (Variable "l") (ListType (GenType "G1"))) (ListType (GenType "G2"))) (ListType (GenType "G2"))) (ListType (GenType "G2")))), -30.0)"\n"(Lambda "f" (Lambda "l" (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Primitive "tail") (List []) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Function "map") (Variable "f") (Arrow (ListType (GenType "G1")) (ListType (GenType "G2")))) (List []) (ListType (GenType "G2"))) (ListType (GenType "G2"))) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Application (Primitive "cons") (Application (Variable "f") (Application (Primitive "head") (Variable "l") (GenType "G1")) (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Primitive "tail") (List []) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Function "map") (Variable "f") (Arrow (ListType (GenType "G1")) (ListType (GenType "G2")))) (Variable "l") (ListType (GenType "G2"))) (ListType (GenType "G2"))) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Primitive "head") (Application (Application (Primitive "cons") (List []) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2"))))) (List []) (ListType (ListType (GenType "G2")))) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Function "map") (Variable "f") (Arrow (ListType (GenType "G1")) (ListType (GenType "G2")))) (List []) (ListType (GenType "G2"))) (ListType (GenType "G2"))) (ListType (GenType "G2")))), -50.0)
-Trace Off.
diff --git a/real/PolyGP/PolyGP.stdout b/real/PolyGP/PolyGP.stdout
deleted file mode 100644 (file)
index 9731bf9..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-(Lambda "f" (Lambda "l" (Application (Application (Application (Primitive "if-then-else") (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow Boolean (Arrow Boolean Boolean))) (Application (Primitive "null") (Variable "l") Boolean) (Arrow Boolean Boolean)) (Application (Primitive "head") (List []) Boolean) Boolean) (Arrow (ListType (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2"))))) (Application (Primitive "head") (Application (Application (Application (Primitive "if-then-else") (Application (Primitive "null") (List []) Boolean) (Arrow (ListType (ListType (GenType "G2"))) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2")))))) (Application (Application (Primitive "cons") (List []) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2"))))) (List []) (ListType (ListType (GenType "G2")))) (Arrow (ListType (ListType (GenType "G2"))) (ListType (ListType (GenType "G2"))))) (Application (Primitive "tail") (List []) (ListType (ListType (GenType "G2")))) (ListType (ListType (GenType "G2")))) (ListType (GenType "G2"))) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Primitive "cons") (Application (Variable "f") (Application (Primitive "head") (Variable "l") (GenType "G1")) (GenType "G2")) (Arrow (ListType (GenType "G2")) (ListType (GenType "G2")))) (Application (Application (Function "map") (Variable "f") (Arrow (ListType (GenType "G1")) (ListType (GenType "G2")))) (Application (Primitive "tail") (Variable "l") (ListType (GenType "G1"))) (ListType (GenType "G2"))) (ListType (GenType "G2"))) (ListType (GenType "G2")))), 100.0)
-
-"Done"
diff --git a/real/PolyGP/Unify.hs b/real/PolyGP/Unify.hs
deleted file mode 100644 (file)
index 3fbe4a3..0000000
+++ /dev/null
@@ -1,253 +0,0 @@
-{---------------------------------------------------------------
- --
- -- Unify.hs : contains function definition of an unification
- --            algorithm
- -- T.Yu@cs.ucl.ac.uk  September 25, 1997
- --
- --------------------------------------------------------------}
-
-module Unify(applySub,applySubToExp,unify,xoverUnify, Theta) where
-import Header(TypeExp(..),Expression(..),ParseTree(..))
-import Trace
-
--- type synonyms ------------------------------------------------------------------
---
--- Theta: a substituation set which binds type variables to type expression.
-
-type Theta = [(String, TypeExp)]
-
--- replaceVar function ----------------------------------------------------------------
---
--- This function takes 2 arguments : a type variable string and theta.
--- It returns the TypeExp which the type variable is bound in
--- the theta. If the variable string is not bounded in the theta,
--- it return itself. (i.e. no replacement)
--- This function is called from applySub function.
-
-replaceVar :: String -> Theta -> TypeExp
-
-replaceVar var theta = case theta of
-                      {
-                       [] -> TypeVar var;   -- no replacement
-                       ((x,value):rest) -> if var == x then 
-                                               value
-                                           else replaceVar var rest
-                       }
-
---replaceDummy function ----------------------------------------------------------------
---
--- This function takes two arguments :a dummy type variable string and theta.
--- It returns the TypeExp which the type variable is bound in
--- the theta.If the variable string is not bounded in the theta,
--- it return itself. (i.e. no replacement)
--- This function is called from applySub function.
-
-
-replaceDummy :: String -> Theta -> TypeExp
-
-replaceDummy var theta = case theta of
-                       {
-                         [] -> DummyType var;   -- no replacement
-                         ((x,value):rest) -> if var == x then 
-                                               value
-                                             else replaceDummy var rest
-                       }
-
--- applySubToTree -------------------------------------------------------------------------
---
-applySubToTree :: ParseTree -> Theta -> ParseTree
-
-applySubToTree tree theta = case tree of 
-                           {
-                               Empty -> tree ;
-                               (ExpCons exp) -> (ExpCons (applySubToExp exp theta))
-                           }
-
-
-
--- applySubToExp -------------------------------------------------------------------------
---
-
-applySubToExp :: Expression -> Theta -> Expression
-
-applySubToExp exp theta = case exp of
-                       {
-                         (Application exp1 exp2 typeExp) ->
-                               Application (applySubToExp exp1 theta)
-                               (applySubToExp exp2 theta)(applySub theta typeExp);
-                         _ -> exp
-                       }
-
--- applySub function ---------------------------------------------------------------------
---
--- This function takes 2 arguments : theta and a type Expression.
--- It applies substituation by replacing all type variables appeared
--- in the Type Expression with new Term which is bound in theta.
-
-applySub :: Theta -> TypeExp -> TypeExp
-
-applySub theta typeExp = case typeExp of
-                       {
-                        (TypeVar v) -> replaceVar v theta;
-                        (DummyType v) -> replaceDummy v theta;
-                        (ListType t) -> ListType (applySub theta t);
-                        (Arrow t1 t2) -> Arrow (applySub theta t1) (applySub theta t2);
-                        (Brackets e) -> Brackets (applySub theta e);
-                        _ -> typeExp -- no substituation takes place
-                       }
-
--- substitute function --------------------------------------------------------------------
---
--- This function takes 3 arguments : a type variable, a new typeExp to substitute
--- the type variable and a type expression where substituation is
--- taking place. It returns the new type expression which substituation
--- has been done.
--- For every typeVar in TypeExp, replace it with newTerm
-
-substitute :: String -> TypeExp -> TypeExp -> TypeExp
-
-substitute typeVar newTerm typeExp = 
-
-       case typeExp of
-        {
-       (TypeVar q)               -> if typeVar == q 
-                                     then newTerm
-                                    else 
-                                    typeExp; -- no substituation take place
-       (ListType typeExp1)       -> ListType (substitute typeVar newTerm typeExp1);
-       (Arrow typeExp1 typeExp2) -> Arrow (substitute typeVar newTerm typeExp1) 
-                                          (substitute typeVar newTerm typeExp2);
-       (Brackets typeExp1)       -> Brackets (substitute typeVar newTerm typeExp1);
-       _                         -> typeExp -- no substituation take place
-        }
-
--- member function ----------------------------------------------------------------------------
---
--- This function takes two arguments: a variable and a Type Expression.
--- If the variable appears in the Type Expression, if returns Trues.
--- Otherwise, it returns False. This function is only used to check 
--- whether a temporary type variable exists in the type expression.
--- A dummy type variable can't never be unify with another dummy type.
-
-member :: String -> TypeExp -> Bool
-
-member var typeExp = case typeExp of
-                   {
-                       (TypeVar tVar) -> if var == tVar then 
-                                               True 
-                                         else False;
-                       (Arrow pType qType) -> member var pType || member var qType;
-                       (ListType lType) -> member var lType;
-                       (Brackets exp) -> member var exp;
-                       _ -> False  -- this takes care of DummyType
-                    }
-
--- unify function ----------------------------------------------------------------------------------
---
--- This function takes a list of Type Expression Pairs, a Theta (binding of temporary type variables
--- or binding of dummy type variables). It unifies each pair in the list and returns a new Theta.
--- This function is used in two separate occasions: to bind dummy type variables in a polymorphic
--- function and to bind temporary type variables in the parse tree. The two occassions are handled
--- separately. Hence 2. & 4. can't never be used at the same time.
-
-unify :: Bool -> [(TypeExp , TypeExp)] -> Theta -> (Bool, Theta)
-
-unify unifiable typeExps theta =
-  if not unifiable then
-       (False, theta)
-  else
-       case typeExps of
-       {
-        [] -> (True, theta);
-
-        --2. binding temporary type variables. can handle exp is temporary type variables.
-        ((s@(TypeVar v),exp):rest) ->
-               if exp == s then 
-                       unify True rest theta 
-               else if member v exp then
-                       (False,[])
-               else 
-                               let newRest = map (\(l, r) -> (substitute v exp l, substitute v exp r)) rest
-                           newTheta = map (\(name, def) -> (name,substitute v exp def)) theta
-                           {- substitute type variable V with Exp in the stack (rest) and in theta -}
-                       in
-                           unify True newRest ((v,exp):newTheta); -- add v=exp to theta;
-        --3. in case s is instantiated through a dummy type variable and length(exp) > 1
-        ((exp, s@(TypeVar v)):rest) ->
-               unify True ((s, exp):rest) theta;
-
-        --4. binding dummy type variables. exp can never be temporary/dummy type variables.
-        ((exp, s@(DummyType v)):rest) ->
-               let newRest = map (\(l, r) -> (substitute v exp l, substitute v exp r)) rest
-                   newTheta = map (\(name, def) -> (name,substitute v exp def)) theta
-                               {- substitute type variable V with Exp in the stack (rest) and in theta -}
-               in
-                   unify True newRest ((v,exp):newTheta); -- add v=exp to theta;
-
-        ((Arrow t1 t2, Arrow t3 t4):rest) ->
-               unify True ((t1,t3):(t2,t4):rest) theta; -- this handle higher-order function as terminal
-
-        ((Brackets t1, Brackets t2):rest) ->
-               unify True ((t1, t2):rest) theta;
-
-        ((ListType t1, ListType t2):rest) ->
-               unify True ((t1,t2):rest) theta;
-
-        ((t1,t2):rest) -> 
-               if t1 == t2 then 
-                       unify True rest theta
-               else (False, [])
-       }       
-
--- xoverUnify function -------------------------------------------------------------------
--- For xover nodes unification, Type variable can't unify with Function type.
--- Both application nodes and lambda nodes have to have the same number of 
--- args to be able to perform crossover.
-
-xoverUnify :: Bool -> [(TypeExp, TypeExp)] -> Theta -> (Bool,Theta)
-
-xoverUnify unifiable typeExps theta =
-  if not unifiable then
-       (False, theta)
-  else
-       case typeExps of
-       {
-        [] -> (True, theta);
-
-        ((TypeVar v,Arrow t1 t2):rest) -> (False, theta);
-
-       --2. binding temporary type variables. can handle exp is temporary type variables.
-        ((s@(TypeVar v),exp):rest) ->
-               if exp == s then 
-                       xoverUnify True rest theta 
-               else if member v exp then
-                       (False,[])
-               else 
-                               let newRest = map (\(l, r) -> (substitute v exp l, substitute v exp r)) rest
-                           newTheta = map (\(name, def) -> (name,substitute v exp def)) theta
-                           {- substitute type variable V with Exp in the stack (rest) and in theta -}
-                       in
-                           xoverUnify True newRest ((v,exp):newTheta); -- add v=exp to theta;
-       --3. in case s is instantiated through a dummy type variable and length(exp) > 1
-        ((exp, s@(TypeVar v)):rest) ->
-               xoverUnify True ((s, exp):rest) theta;
-
-        ((Arrow t1 t2, Arrow t3 t4):rest) ->
-               xoverUnify True ((t1,t3):(t2,t4):rest) theta; -- this handle higher-order function as terminal & crossover operation
-
-        ((Brackets t1, Brackets t2):rest) ->
-               xoverUnify True ((t1, t2):rest) theta;
-
-        ((ListType t1, ListType t2):rest) ->
-               xoverUnify True ((t1,t2):rest) theta;
-
-        ((t1,t2):rest) -> 
-               if t1 == t2 then 
-                       xoverUnify True rest theta
-               else 
-                       (False, [])
-       }       
-
-
-
-