From 8b2589957be45426914c26abd46cf5721438437a Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 22 Jun 2017 21:19:08 +0200
Subject: [PATCH] optimalisation

---
 Makefile |  2 +-
 peg.icl  | 49 ++++++++++++++++++++++++++++---------------------
 2 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/Makefile b/Makefile
index 1ca48ae..ee49bc5 100644
--- a/Makefile
+++ b/Makefile
@@ -6,7 +6,7 @@ CLMLIBS:=$(addprefix -I $(CLEAN_HOME)/lib/,Platform Generics Dynamics StdEnv)
 CLM:=clm
 
 override CLMFLAGS+=-nt
-ifeq "$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)" "1";
+ifeq "$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)" "1"
 	override CLMFLAGS+=-l -no-pie
 endif
 
diff --git a/peg.icl b/peg.icl
index 0e784c2..2519f69 100644
--- a/peg.icl
+++ b/peg.icl
@@ -7,7 +7,6 @@ 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
@@ -15,11 +14,21 @@ import Control.Applicative
 import Data.Maybe
 import Data.Functor
 
-:: Coord :== (Int, Int)
-:: Position = Inv | Emp | Peg
-:: PegBoard :== {{Position}}
-:: Move :== (Coord, Direction)
-:: Direction = N | E | S | W
+:: Position :== Char
+Inv :== ' '
+Emp :== '.'
+Peg :== 'o'
+
+:: Direction :== Int
+N :== 0
+E :== 1
+S :== 2
+W :== 3
+
+:: Coord = {x::Int, y::Int}
+:: Move = {c::Coord, d::Direction}
+:: PegBoard :== {{#Position}}
+
 :: Solver a :== RWST () [PegBoard] PegBoard Maybe a
 
 european :: PegBoard
@@ -36,38 +45,36 @@ european =
 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'
-
 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)
+transform c=:{x,y} d = case d of
+	N = {c&y=y+1}; S = {c&y=y-1}; W = {c&x=x+1}; E = {c&x=x-1}
 
 getPos :: Coord -> Solver Position
-getPos (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
 
 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
+move {c=c=:{x=tx,y=ty}, d}
+# sc=:{x=sx,y=sy} = transform c d
+# fc=:{x=fx,y=fy} = transform sc d
+= get >>= \b->liftM3 tuple3 (getPos fc) (getPos sc) (getPos c) >>= \f->case f of
 	(Peg, Peg, Emp)
 		# b = {{{c\\c<-:r}\\r<-:b} & [fy,fx]=Emp, [sy,sx]=Emp, [ty,tx]=Peg}
 		= tell [b] >>| put b
 	_ = empty
 
-getCoords :: (Position -> Bool) PegBoard -> [Coord]
-getCoords f b = [(x, y)\\r<-:b & y<-[0..] , c<-:r & x<-[0..] | f c]
+getCoords :: (Char -> Bool) PegBoard -> [Coord]
+getCoords f b = [{x=x,y=y}\\r<-:b & y<-[0..] , c<-:r & x<-[0..] | f c]
 
 win :: (PegBoard -> Bool)
-win = (==) 1 o length o getCoords (\c->c=:Peg)
+win = (==) 1 o length o getCoords ((==)Peg)
 
 printPegBoard :: PegBoard -> String
-printPegBoard b = 'Text'.join "\n" [{#toChar x\\x<-:r}\\r <-: b]
+printPegBoard b = 'Text'.join "\n" [r\\r <-: b]
 
 moves :: Solver [Move]
-moves = gets $ \b->[(c,d)\\c<-getCoords (\c->c=:Emp) b, d<-[N,E,S,W]]
+moves = gets $ \b->[{c=c,d=d}\\c<-getCoords ((==)Emp) b, d<-[N,E,S,W]]
 
 solve :: PegBoard -> Maybe [PegBoard]
 solve b = snd <$> evalRWST (tell [b] >>| solver) () b
-- 
2.20.1