add let() statements to the parser, and test suite.

Graphics/Implicit/ExtOpenScad/Parser/Expr.hs

@@ -5,12 +5,12 @@
 -- a parser for a numeric expression.
 module Graphics.Implicit.ExtOpenScad.Parser.Expr(expr0) where
 
-import Prelude (Char, Maybe(Nothing, Just), fmap, ($), (.), (>>), return, Bool(True, False), read, (++), (*), (**), (/), id, foldl, map, foldl1, unzip, tail, zipWith3)
+import Prelude (Char, Maybe(Nothing, Just), fmap, ($), (.), (>>), return, Bool(True, False), read, (++), (*), (**), (/), id, foldl, map, foldl1, unzip, tail, zipWith3, foldr)
 
 -- The parsec parsing library.
 import Text.ParserCombinators.Parsec (GenParser, string, many1, digit, char, many, noneOf, sepBy, sepBy1, optionMaybe, try)
 
-import Graphics.Implicit.ExtOpenScad.Definitions (Expr(Var, LitE, ListE, (:$)), OVal(ONum, OString, OBool, OUndefined), collector)
+import Graphics.Implicit.ExtOpenScad.Definitions (Expr(Var, LamE, LitE, ListE, (:$)), OVal(ONum, OString, OBool, OUndefined), collector, Pattern(Name))
 
 import Graphics.Implicit.ExtOpenScad.Parser.Util (variableSymb, (?:), (*<|>), genSpace, padString)
 
@@ -80,6 +80,27 @@ literal = ("literal" ?:) $
         _ <- string "\""
         return . LitE $ OString strlit
 
+letExpr :: GenParser Char st Expr
+letExpr = "let expression" ?: do
+  _ <- string "let"
+  _ <- genSpace
+  _ <- string "("
+  _ <- genSpace
+  bindingPairs <- sepBy ( do
+    _ <- genSpace
+    boundName <- variableSymb
+    _ <- genSpace
+    _ <- string "="
+    _ <- genSpace
+    boundExpr <- expr0
+    return $ ListE [Var boundName, boundExpr])
+    (char ',')
+  _ <- string ")"
+  expr <- expr0
+  let bindLets (ListE [Var boundName, boundExpr]) nestedExpr = (LamE [Name boundName] nestedExpr) :$ [boundExpr]
+      bindLets _ e = e
+  return $ foldr bindLets expr bindingPairs
+
 -- We represent the priority or 'fixity' of different types of expressions
 -- by the ExprIdx argument, with A0 as the highest.
 
@@ -93,6 +114,7 @@ exprN :: ExprIdx -> GenParser Char st Expr
 
 exprN A12 =
          literal
+    *<|> letExpr
     *<|> variable
     *<|> "bracketed expression" ?: do
         -- eg. ( 1 + 5 )

tests/ParserSpec/Expr.hs

@@ -11,13 +11,13 @@ import Prelude (Bool(True, False), ($))
 import Test.Hspec (describe, Expectation, Spec, it, pendingWith, specify)
 
 -- Parsed expression components.
-import Graphics.Implicit.ExtOpenScad.Definitions (Expr(Var, ListE, (:$)))
+import Graphics.Implicit.ExtOpenScad.Definitions (Expr(Var, ListE, (:$)), Pattern(Name))
 
 -- The type used for variables, in ImplicitCAD.
 import Graphics.Implicit.Definitions (ℝ)
 
 -- Our utility library, for making these tests easier to read.
-import ParserSpec.Util ((-->), fapp, num, bool, stringLiteral, plus, minus, mult, modulo, power, divide, negate, and, or, not, gt, lt, ternary, append, index, parseWithLeftOver)
+import ParserSpec.Util ((-->), fapp, num, bool, stringLiteral, plus, minus, mult, modulo, power, divide, negate, and, or, not, gt, lt, ternary, append, index, lambda, parseWithLeftOver)
 
 -- Default all numbers in this file to being of the type ImplicitCAD uses for values.
 default (ℝ)
@@ -64,6 +64,17 @@ literalSpec = do
     it "accepts true" $ "true" --> bool True
     it "accepts false" $ "false" --> bool False
 
+letBindingSpec :: Spec
+letBindingSpec = do
+  it "handles let with integer binding and spaces" $ do
+    "let ( a = 1 ) a" --> lambda [Name "a"] (Var "a") [num 1]
+  it "handles multiple variable let" $ do
+    "let (a = x, b = y) a + b" --> lambda [Name "a"] ((lambda [Name "b"] (plus [Var "a", Var "b"])) [Var "y"]) [Var "x"]
+  it "handles empty let" $ do
+    "let () a" --> (Var "a")
+  it "handles nested let" $ do
+    "let(a=x) let(b = y) a + b" --> lambda [Name "a"] ((lambda [Name "b"] (plus [Var "a", Var "b"])) [Var "y"]) [Var "x"]
+
 exprSpec :: Spec
 exprSpec = do
   describe "literals" literalSpec
@@ -152,6 +163,7 @@ exprSpec = do
     it "handles append" $
       "foo ++ bar ++ baz" --> append [Var "foo", Var "bar", Var "baz"]
   describe "logical operators" logicalSpec
+  describe "let expressions" letBindingSpec
   describe "application" $ do
     specify "base case" $ "foo(x)" --> Var "foo" :$ [Var "x"]
     specify "multiple arguments" $

tests/ParserSpec/Statement.hs

@@ -9,9 +9,9 @@ import Prelude (String, Maybe(Just), Bool(True), ($))
 
 import Test.Hspec (Spec, Expectation, shouldBe, shouldSatisfy, it, pendingWith, describe)
 
-import ParserSpec.Util (bool, num, minus, mult, index)
+import ParserSpec.Util (bool, num, minus, plus, mult, index)
 
-import Graphics.Implicit.ExtOpenScad.Definitions (StatementI(StatementI), Symbol, Expr(ListE, LamE, Var), Statement(NewModule, ModuleCall, If, (:=)), Pattern(Name, ListP))
+import Graphics.Implicit.ExtOpenScad.Definitions (StatementI(StatementI), Symbol, Expr(ListE, LamE, Var, (:$)), Statement(NewModule, ModuleCall, If, (:=)), Pattern(Name, ListP))
 
 -- Parse an ExtOpenScad program.
 import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram)
@@ -53,6 +53,9 @@ assignmentSpec = do
     "[x, y] = [1, 2];" --> single (ListP [Name "x", Name "y"] := ListE [num 1, num 2])
   it "handles the function keyword and definitions" $
     "function foo(x, y) = x * y;" --> single fooFunction
+  it "handles function with let expression" $
+    "function withlet(b) = let (c = 5) b + c;" -->
+    (single $ (Name "withlet" := LamE [Name "b"] (LamE [Name "c"] (plus [Var "b", Var "c"]) :$ [num 5])))
   it "handles nested indexing" $
     "x = [y[0] - z * 2];" -->
     single ( Name "x" := ListE [minus [index [Var "y", num 0],
@@ -92,5 +95,3 @@ statementSpec = do
   describe "empty module definition" $
     it "parses correctly" $
       "module foo_bar() {}" --> single (NewModule "foo_bar" [] [])
-
-

tests/ParserSpec/Util.hs

@@ -29,6 +29,7 @@ module ParserSpec.Util
        , ternary
        , append
        , index
+       , lambda
        , parseWithLeftOver
        ) where
 
@@ -39,7 +40,7 @@ import Prelude (Bool, String, Either, (<), ($), (.), (<*), otherwise)
 import Graphics.Implicit.Definitions (ℝ)
 
 -- The datatype of expressions, symbols, and values in the OpenScad language.
-import Graphics.Implicit.ExtOpenScad.Definitions (Expr(LitE, (:$), Var, ListE), OVal(ONum, OBool, OString))
+import Graphics.Implicit.ExtOpenScad.Definitions (Expr(LitE, (:$), Var, ListE, LamE), OVal(ONum, OBool, OString), Pattern)
 
 import Text.ParserCombinators.Parsec (Parser, ParseError, parse, manyTill, anyChar, eof)
 
@@ -64,6 +65,8 @@ infixr 1 -->+
 (-->+) source (result, leftover) =
   parseWithLeftOver expr0 source `shouldBe` Right (result, leftover)
 
+-- | Types
+
 num :: ℝ -> Expr
 num x
   -- FIXME: the parser should handle negative number literals
@@ -77,6 +80,8 @@ bool = LitE . OBool
 stringLiteral :: String -> Expr
 stringLiteral = LitE . OString
 
+-- | Operators
+
 plus,minus,mult,modulo,power,divide,negate,and,or,not,gt,lt,ternary,append,index :: [Expr] -> Expr
 minus = oapp "-"
 modulo = oapp "%"
@@ -94,11 +99,14 @@ plus = fapp "+"
 mult = fapp "*"
 append = fapp "++"
 
--- we need two different kinds of application functions
+-- | we need two different kinds of application functions
 oapp,fapp :: String -> [Expr] -> Expr
 oapp name args = Var name :$ args
 fapp name args = Var name :$ [ListE args]
 
+lambda :: [Pattern] -> Expr -> [Expr] -> Expr
+lambda params expr args = LamE params expr :$ args
+
 parseWithLeftOver :: Parser a -> String -> Either ParseError (a, String)
 parseWithLeftOver p = parse ((,) <$> p <*> leftOver) ""
   where