Added pattern matching to langauge!

Graphics/Implicit/Export/MarchingSquares.hs

@@ -4,14 +4,15 @@
 module Graphics.Implicit.Export.MarchingSquares (getContour) where
 
 import Graphics.Implicit.Definitions
-import Control.Parallel (par, pseq)
+import Control.Parallel.Strategies (using, parList, rdeepseq)
+import Debug.Trace
 
 -- | getContour gets a polyline describe the edge of your 2D
 --  object. It's really the only function in this file you need
 --  to care about from an external perspective.
 
-getContour :: ℝ2 -> ℝ2 -> ℝ2 -> Obj2 -> [Polyline]
-getContour (x1, y1) (x2, y2) (dx, dy) obj = 
+getContour2 :: ℝ2 -> ℝ2 -> ℝ2 -> Obj2 -> [Polyline]
+getContour2 (x1, y1) (x2, y2) (dx, dy) obj = 
 	let
 		-- How many steps will we take on each axis?
 		nx = fromIntegral $ ceiling $ (x2 - x1) / dx
@@ -25,7 +26,32 @@ getContour (x1, y1) (x2, y2) (dx, dy) obj =
 		     | mx <- [0.. nx-1] ] | my <- [0..ny-1] ]
 		-- Cleanup, cleanup, everybody cleanup!
 		-- (We connect multilines, delete redundant vertices on them, etc)
-		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLinesP $ linesOnGrid
+		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLinesDC $ linesOnGrid
+	in
+		multilines
+
+getContour :: ℝ2 -> ℝ2 -> ℝ2 -> Obj2 -> [Polyline]
+getContour (x1, y1) (x2, y2) (dx, dy) obj = 
+	let
+		-- How many steps will we take on each axis?
+		nx = fromIntegral $ ceiling $ (x2 - x1) / dx
+		ny = fromIntegral $ ceiling $ (y2 - y1) / dy
+		-- Grid mapping funcs
+		fromGrid (mx, my) = (x1 + (x2 - x1)*mx/nx, y1 + (y2 - y1)*my/ny)
+		toGrid (x,y) =(\a-> traceShow a a) (floor $ nx*(x-x1)/(x2-x1), floor $ ny*(y-y1)/(y2-y1) ) :: (ℕ, ℕ)
+		-- Evalueate obj on a grid, in parallel.
+		valsOnGrid :: [[ℝ]]
+		valsOnGrid = [[ obj (fromGrid (mx, my)) | mx <- [0.. nx-1] ] | my <- [0..ny-1] ]
+		              `using` parList rdeepseq
+		-- A faster version of the obj. Sort of like memoization, but done in advance, in parallel.
+		preEvaledObj p = valsOnGrid !! my !! mx where (mx,my) = toGrid p
+		-- Divide it up and compute the polylines
+		linesOnGrid :: [[[Polyline]]]
+		linesOnGrid = [[getSquareLineSegs (fromGrid (mx, my)) (fromGrid (mx+1, my+1)) preEvaledObj
+		     | mx <- [0.. nx-1] ] | my <- [0..ny-1] ]
+		-- Cleanup, cleanup, everybody cleanup!
+		-- (We connect multilines, delete redundant vertices on them, etc)
+		multilines = (filter polylineNotNull) $ (map reducePolyline) $ orderLinesDC $ linesOnGrid
 	in
 		multilines
 
@@ -139,6 +165,7 @@ reducePolyline ((x1,y1):(x2,y2):others) =
 	if (x1,y1) == (x2,y2) then reducePolyline ((x2,y2):others) else (x1,y1):(x2,y2):others
 reducePolyline l = l
 
+
 orderLinesDC :: [[[Polyline]]] -> [Polyline]
 orderLinesDC segs =
 	let
@@ -151,6 +178,7 @@ orderLinesDC segs =
 			((a,b),(c,d)) ->orderLines $ 
 				orderLinesDC a ++ orderLinesDC b ++ orderLinesDC c ++ orderLinesDC d
 
+{-
 orderLinesP :: [[[Polyline]]] -> [Polyline]
 orderLinesP segs =
 	let
@@ -172,6 +200,7 @@ orderLinesP segs =
 					d' = orderLinesP d
 				in (force a' `par` force b' `par` force c' `par` force d') `pseq` 
 					(a' ++ b' ++ c' ++ d')
+-}
 
 
 polylineNotNull (a:l) = not (null l)

Graphics/Implicit/ExtOpenScad/Definitions.hs

@@ -32,6 +32,13 @@ data OpenscadObj = OUndefined
 		 | OModule (ArgParser ([ComputationStateModifier]  -> ComputationStateModifier))
 		 | OError [String]
 
+instance Eq OpenscadObj where
+	(ONum a) == (ONum b) = a == b
+	(OBool a) == (OBool b) = a == b
+	(OList a) == (OList b) = a == b
+	(OString a) == (OString b) = a == b
+	_ == _ = False
+
 -- | We'd like to be able to turn OpenscadObjs into a given Haskell type
 class OTypeMirror a where
 	fromOObj :: OpenscadObj -> Maybe a

Graphics/Implicit/ExtOpenScad/Statements.hs

@@ -191,16 +191,21 @@ useStatement = (do
 assigmentStatement :: GenParser Char st ComputationStateModifier
 assigmentStatement = 
 	(try $ do
-		varSymb <- variableSymb
+		pattern <- patternMatcher
 		many space
 		char '='
 		many space
 		valExpr <- expression 0
 		return $ \ ioWrappedState -> do
-			(varlookup, obj2s, obj3s) <- ioWrappedState
+			state@(varlookup, obj2s, obj3s) <- ioWrappedState
 			let
 				val = valExpr varlookup
-			return (insert varSymb val varlookup, obj2s, obj3s) 
+				match = pattern val
+			case match of
+				Just dictWithNew -> return (union dictWithNew varlookup, obj2s, obj3s) 
+				Nothing -> do
+					putStrLn "Pattern match fail in assignment statement"
+					return state
 	) <|> (try $ do 
 		varSymb <- (try $ string "function" >> many1 space >> variableSymb) 
 		            <|> variableSymb
@@ -286,12 +291,13 @@ ifStatement = (do
 forStatement = (do
 	-- a for loop is of the form:
 	--      for ( vsymb = vexpr   ) loopStatements
-	-- eg.  for ( a     = [1,2,3] ) {echo(a); echo "lol";}
+	-- eg.  for ( a     = [1,2,3] ) {echo(a);   echo "lol";}
+	-- eg.  for ( [a,b] = [[1,2]] ) {echo(a+b); echo "lol";}
 	string "for"
 	many space
 	char '('
 	many space
-	vsymb <- variableSymb
+	pattern <- patternMatcher
 	many space
 	char '='
 	vexpr <- expression 0
@@ -308,9 +314,14 @@ forStatement = (do
 				-> OpenscadObj      -- ^ The value of vsymb for this iteration
 				-> ComputationState -- ^ The resulting state
 			loopOnce ioWrappedState val =  do
-				(varlookup, a, b) <- ioWrappedState;
+				state@(varlookup, a, b) <- ioWrappedState;
 				let
-					vsymbSetState = return (insert vsymb val varlookup, a, b)
+					match = pattern val
+					vsymbSetState = case match of
+						Just dictWithNew -> return (union dictWithNew varlookup, a, b) 
+						Nothing -> do
+							putStrLn "Pattern match fail in for loop step"
+							return state
 				runComputations vsymbSetState loopStatements
 		-- Then loops once for every entry in vexpr
 		case vexpr varlookup of 

Graphics/Implicit/ExtOpenScad/Util.hs

@@ -14,6 +14,7 @@ import Graphics.Implicit.ExtOpenScad.Definitions
 import Graphics.Implicit.ExtOpenScad.Expressions
 import Data.Map (Map, lookup, insert)
 import qualified Data.Map as Map
+import qualified Data.Maybe as Maybe
 import qualified Data.List
 import Text.ParserCombinators.Parsec 
 import Text.ParserCombinators.Parsec.Expr
@@ -262,3 +263,32 @@ pad parser = do
 	return a
 
 
+
+patternMatcher :: GenParser Char st (OpenscadObj -> Maybe VariableLookup)
+patternMatcher =
+	(do 
+		char '_'
+		return (\obj -> Just Map.empty)
+	) <|> ( do
+		a <- literal
+		return $ \obj ->
+			if obj == (a undefined)
+			then Just (Map.empty)
+			else Nothing
+	) <|> ( do
+		symb <- variableSymb
+		return $ \obj -> Just $ Map.singleton symb obj
+	) <|> ( do
+		char '['
+		many space
+		components <- patternMatcher `sepBy` (many space >> char ',' >> many space)
+		many space
+		char ']'
+		return $ \obj -> case obj of
+			OList l -> 
+				if length l == length components
+				then fmap Map.unions $ sequence $ zipWith ($) components l
+				else Nothing
+			_ -> Nothing
+	)
+