From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 22 Jun 2017 18:50:15 +0000 (+0200)
Subject: Cleanup
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=971712b4acb469f777d1f507d9d8b7e04d01bfe0;p=cleanpeg.git

Cleanup
---

diff --git a/Makefile b/Makefile
index 9966f02..1ca48ae 100644
--- a/Makefile
+++ b/Makefile
@@ -1,37 +1,22 @@
+BINARIES:=peg
+
 CLEAN_HOME?=/opt/clean
+
+CLMLIBS:=$(addprefix -I $(CLEAN_HOME)/lib/,Platform Generics Dynamics StdEnv)
 CLM:=clm
 
-override CLMFLAGS+=-dynamics -h 200M -nt
-GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)
-ifeq "$(GCCVERSIONGTEQ6)" "1"
+override CLMFLAGS+=-nt
+ifeq "$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)" "1";
 	override CLMFLAGS+=-l -no-pie
 endif
 
-ITASKS:=~/projects/iTasks-SDK/Libraries
-
-#	-I ~/projects/iTasks-SDK/Libraries
-CLMLIBS:=\
-	-I $(CLEAN_HOME)/lib/Platform\
-	-I $(CLEAN_HOME)/lib/Platform/Deprecated/StdLib\
-	-I $(ITASKS)\
-	-I $(CLEAN_HOME)/lib/GraphCopy\
-	-I $(CLEAN_HOME)/lib/Sapl\
-	-I $(CLEAN_HOME)/lib/StdEnv\
-	-I $(CLEAN_HOME)/lib/Generics\
-	-I $(CLEAN_HOME)/lib/Dynamics\
-	-I $(CLEAN_HOME)/lib/TCPIP\
-	-I ./CleanSerial
-
-BINARIES:=peg
-
 all: $(BINARIES)
 
-%: %.icl $(wildcard */*.[id]cl *.[id]cl)
+%: %.icl $(wildcard *.[id]cl)
 	$(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
 
-clean-%:
-	$(RM) -r $(addprefix $(@:clean-%=%),-data -www) $(@:clean-%=%)
-
 clean: $(addprefix clean-,$(BINARIES))
 	find . -type d -name 'Clean System Files' -print0 | xargs -r0 $(RM) -r
-	make -C CleanSerial clean
+
+clean-%:
+	$(RM) -r $(addprefix $(@:clean-%=%),-data -www) $(@:clean-%=%)
diff --git a/README.md b/README.md
index dae1155..0c2847b 100644
--- a/README.md
+++ b/README.md
@@ -1,3 +1,9 @@
 # Peg solitaire solver
 
-Time to solve: 1m2.852s
+Solves it in a minute.
+
+## Todo
+- iTasks interface
+
+## Author
+Mart Lubbers
diff --git a/peg.icl b/peg.icl
index ed1a964..0e784c2 100644
--- a/peg.icl
+++ b/peg.icl
@@ -6,6 +6,8 @@ from Text import class Text, instance Text String
 import qualified Text
 from Data.Func import $
 import Data.Tuple
+import Data.List
+import Data.Functor
 import Data.Monoid
 import Control.Monad
 import Control.Monad.RWST
@@ -31,30 +33,22 @@ european =
 	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
 	}
 
-empty = RWST $ \_ _->Nothing
-(<|>) (RWST fa) (RWST fb) = RWST $ \r s->case fa r s of
-	Nothing = fb r s
-	x = x
+empty = RWST \_ _->Nothing
+(<|>) (RWST fa) (RWST fb) = RWST \r s->maybe (fb r s) Just (fa r s)
 
 instance toChar Position where
 	toChar p = case p of Inv = ' '; Emp = '.'; Peg = 'o'
 
-instance == Position where
-	(==) Inv Inv = True
-	(==) Emp Emp = True
-	(==) Peg Peg = True
-	(==) _ _ = False
-
 transform :: Coord Direction -> Coord
 transform (x, y) d = case d of N = (x, y+1); S = (x, y-1); W = (x+1, y); E = (x-1, y)
 
 getPos :: Coord -> Solver Position
-getPos c=:(x, y) = get >>= \b->if (valid b) empty (pure b.[y].[x])
+getPos (x, y) = get >>= \b->if (valid b) empty (pure b.[y].[x])
 where 
-	valid b = y<0 || x<0 || y >= size b || x >= size b.[0] || b.[y].[x] == Inv
+	valid b = y<0 || x<0 || y >= size b || x >= size b.[0] || b.[y].[x] =: Inv
 
-applyMove :: Move -> Solver ()
-applyMove (tc=:(tx, ty), d)
+move :: Move -> Solver ()
+move (tc=:(tx, ty), d)
 # sc=:(sx, sy) = transform tc d
 # fc=:(fx, fy) = transform sc d
 = get >>= \b->liftM3 tuple3 (getPos fc) (getPos sc) (getPos tc) >>= \f->case f of
@@ -67,20 +61,19 @@ getCoords :: (Position -> Bool) PegBoard -> [Coord]
 getCoords f b = [(x, y)\\r<-:b & y<-[0..] , c<-:r & x<-[0..] | f c]
 
 win :: (PegBoard -> Bool)
-win = (==) 1 o length o getCoords ((==)Peg)
+win = (==) 1 o length o getCoords (\c->c=:Peg)
 
 printPegBoard :: PegBoard -> String
-printPegBoard b = 'Text'.join "\n" ["\n":[{#toChar x\\x<-:r}\\r <-: b]]
+printPegBoard b = 'Text'.join "\n" [{#toChar x\\x<-:r}\\r <-: b]
 
-getMoves :: Solver [Move]
-getMoves = gets (\b->[(c,d)\\c<-getCoords ((==)Emp) b, d<-[N,E,S,W]])
+moves :: Solver [Move]
+moves = gets $ \b->[(c,d)\\c<-getCoords (\c->c=:Emp) b, d<-[N,E,S,W]]
 
 solve :: PegBoard -> Maybe [PegBoard]
 solve b = snd <$> evalRWST (tell [b] >>| solver) () b
 where
-	solver = get >>= \board->case win board of
-		True = get >>= \b->tell [b]
-		False = getMoves
-			>>= foldr (<|>) empty o map (\m->applyMove m >>| solver)
+	solver = get >>= \board->if (win board)
+		(get >>= tell o pure)
+		(moves >>= foldr (<|>) empty o map (\m->move m >>| solver))
 
 Start = 'Text'.join "\n" o map printPegBoard <$> solve european