From 4c335ae967d8af029531cf469813fb39e6296151 Mon Sep 17 00:00:00 2001 From: Julia Longtin Date: Wed, 26 Jun 2019 20:11:25 +0100 Subject: [PATCH] change from passing around separate line and column, into passing around a type containing line, column, and source file. --- Graphics/Implicit/Definitions.hs | 1 - Graphics/Implicit/ExtOpenScad.hs | 5 +- Graphics/Implicit/ExtOpenScad/Default.hs | 5 +- Graphics/Implicit/ExtOpenScad/Definitions.hs | 24 +++- .../Implicit/ExtOpenScad/Eval/Statement.hs | 36 ++--- .../Implicit/ExtOpenScad/Parser/Statement.hs | 130 ++++++++---------- Graphics/Implicit/ExtOpenScad/Parser/Util.hs | 13 +- Graphics/Implicit/ExtOpenScad/Util/StateC.hs | 7 +- programs/parser-bench.hs | 2 +- tests/ParserSpec/Expr.hs | 4 +- tests/ParserSpec/Statement.hs | 14 +- 11 files changed, 122 insertions(+), 119 deletions(-) diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs index 016aca6..854ad46 100644 --- a/Graphics/Implicit/Definitions.hs +++ b/Graphics/Implicit/Definitions.hs @@ -294,4 +294,3 @@ data SymbolicObj3 = | ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2 deriving Show - diff --git a/Graphics/Implicit/ExtOpenScad.hs b/Graphics/Implicit/ExtOpenScad.hs index fafee68..be14750 100644 --- a/Graphics/Implicit/ExtOpenScad.hs +++ b/Graphics/Implicit/ExtOpenScad.hs @@ -13,6 +13,7 @@ import Prelude(String, Either(Left, Right), IO, ($), fmap) import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3) import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup) import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram) +import Graphics.Implicit.ExtOpenScad.Parser.Util (sourcePosition) import Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI) import Graphics.Implicit.ExtOpenScad.Default (defaultObjects) import Graphics.Implicit.ExtOpenScad.Util.StateC (CompState(CompState)) @@ -29,10 +30,10 @@ runOpenscad :: String -> Either ParseError (IO (VarLookup, [SymbolicObj2], [Symb runOpenscad source = let initial = defaultObjects - rearrange :: forall t. (t, CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3]) + rearrange :: (t, CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3]) rearrange (_, (CompState (varlookup, ovals, _))) = (varlookup, obj2s, obj3s) where (obj2s, obj3s, _ ) = divideObjs ovals - in case parseProgram source of + in case parseProgram "" source of Left e -> Left e Right sts -> Right $ fmap rearrange diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs index 396352a..b6d29c1 100644 --- a/Graphics/Implicit/ExtOpenScad/Default.hs +++ b/Graphics/Implicit/ExtOpenScad/Default.hs @@ -13,7 +13,7 @@ module Graphics.Implicit.ExtOpenScad.Default (defaultObjects) where import Prelude (String, Bool(True, False), Maybe(Just, Nothing), ($), (++), map, pi, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, abs, signum, fromInteger, (.), floor, ceiling, round, exp, log, sqrt, max, min, atan2, (**), flip, (<), (>), (<=), (>=), (==), (/=), (&&), (||), not, show, foldl, (*), (/), mod, (+), zipWith, (-), otherwise) import Graphics.Implicit.Definitions (ℝ, ℕ) -import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal(OList, ONum, OString, OUndefined, OError, OModule, OFunc), Symbol(Symbol)) +import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal(OList, ONum, OString, OUndefined, OError, OModule, OFunc), Symbol(Symbol), SourcePosition) import Graphics.Implicit.ExtOpenScad.Util.OVal (toOObj, oTypeStr) import Graphics.Implicit.ExtOpenScad.Primitives (primitives) import Data.Map (fromList) @@ -34,7 +34,8 @@ defaultObjects = VarLookup $ fromList $ defaultConstants :: [(Symbol, OVal)] defaultConstants = map (\(a,b) -> (a, toOObj (b::ℝ) )) - [((Symbol "pi"), pi)] + [((Symbol "pi"), pi), + ((Symbol "PI"), pi)] defaultFunctions :: [(Symbol, OVal)] defaultFunctions = map (\(a,b) -> (a, toOObj ( b :: ℝ -> ℝ))) diff --git a/Graphics/Implicit/ExtOpenScad/Definitions.hs b/Graphics/Implicit/ExtOpenScad/Definitions.hs index c43b22f..a5996cf 100644 --- a/Graphics/Implicit/ExtOpenScad/Definitions.hs +++ b/Graphics/Implicit/ExtOpenScad/Definitions.hs @@ -11,13 +11,14 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OModule,OError, OObj2, OObj3), VarLookup(VarLookup), TestInvariant(EulerCharacteristic), + SourcePosition(SourcePosition), lookupVarIn, collector) where -import Prelude(Eq, Show, Ord, String, Maybe, Bool(True, False), IO, (==), show, map, ($), (++), undefined, and, zipWith, foldl1) +import Prelude(Eq, Show, Ord, String, Maybe, Bool(True, False), IO, FilePath, (==), show, map, ($), (++), undefined, and, zipWith, foldl1) -- Resolution of the world, Integer type, and symbolic languages for 2D and 3D objects. -import Graphics.Implicit.Definitions (ℝ, ℕ, SymbolicObj2, SymbolicObj3) +import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, SymbolicObj2, SymbolicObj3) import Control.Applicative (Applicative, Alternative((<|>), empty), pure, (<*>)) import Control.Monad (Functor, Monad, fmap, (>>=), mzero, mplus, MonadPlus, liftM, ap, return, (>=>)) @@ -95,8 +96,8 @@ data Expr = Var Symbol | Expr :$ [Expr] deriving (Show, Eq) --- a statement, along with the line and column number it is found on. -data StatementI = StatementI Line Column (Statement StatementI) +-- | A statement, along with the line and column number it is found on. +data StatementI = StatementI SourcePosition (Statement StatementI) deriving (Show, Eq) data Statement st = Include String Bool @@ -109,8 +110,6 @@ data Statement st = Include String Bool | DoNothing deriving (Show, Eq) - - -- | Objects for our OpenSCAD-like language data OVal = OUndefined | OError [String] @@ -142,6 +141,18 @@ instance Show OVal where show (OObj2 obj) = "" show (OObj3 obj) = "" +-- In order to not propagate Parsec or other modules around, create our own source position type for the AST. +data SourcePosition = SourcePosition + { sourceLine :: Fastℕ + , sourceColumn :: Fastℕ + , sourceName :: FilePath + } + deriving (Eq) + +instance Show SourcePosition where + show (SourcePosition line col []) = "line " ++ show line ++ ", column " ++ show col + show (SourcePosition line col filePath) = "line " ++ show line ++ ", column " ++ show col ++ ", file " ++ filePath + -- | Apply a symbolic operator to a list of expressions, returning one big expression. -- Accepts a string for the operator, to simplify callers. collector :: String -> [Expr] -> Expr @@ -155,4 +166,3 @@ lookupVarIn target (VarLookup vars) = lookup (Symbol target) vars newtype TestInvariant = EulerCharacteristic ℕ deriving (Show) - diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs index e425fd7..a9c0212 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Statement.hs @@ -42,27 +42,27 @@ varUnion (VarLookup a) (VarLookup b) = VarLookup $ union a b -- Run statements out of the OpenScad file. runStatementI :: StatementI -> StateC () -runStatementI (StatementI lineN columnN (pat := expr)) = do +runStatementI (StatementI sourcePos (pat := expr)) = do val <- evalExpr expr let posMatch = matchPat pat val case (getErrors val, posMatch) of - (Just err, _ ) -> errorC lineN columnN err + (Just err, _ ) -> errorC sourcePos err (_, Just match) -> modifyVarLookup $ varUnion match - (_, Nothing ) -> errorC lineN columnN "pattern match failed in assignment" + (_, Nothing ) -> errorC sourcePos "pattern match failed in assignment" -runStatementI (StatementI lineN columnN (Echo exprs)) = do +runStatementI (StatementI sourcePos (Echo exprs)) = do let show2 (OString s) = s show2 x = show x vals <- mapM evalExpr exprs case getErrors (OList vals) of Nothing -> liftIO . putStrLn $ concatMap show2 vals - Just err -> errorC lineN columnN err + Just err -> errorC sourcePos err -runStatementI (StatementI lineN columnN (For pat expr loopContent)) = do +runStatementI (StatementI sourcePos (For pat expr loopContent)) = do val <- evalExpr expr case (getErrors val, val) of - (Just err, _) -> errorC lineN columnN err + (Just err, _) -> errorC sourcePos err (_, OList vals) -> forM_ vals $ \v -> case matchPat pat v of Just match -> do @@ -71,21 +71,21 @@ runStatementI (StatementI lineN columnN (For pat expr loopContent)) = do Nothing -> return () _ -> return () -runStatementI (StatementI lineN columnN (If expr a b)) = do +runStatementI (StatementI sourcePos (If expr a b)) = do val <- evalExpr expr case (getErrors val, val) of - (Just err, _ ) -> errorC lineN columnN ("In conditional expression of if statement: " ++ err) + (Just err, _ ) -> errorC sourcePos ("In conditional expression of if statement: " ++ err) (_, OBool True ) -> runSuite a (_, OBool False) -> runSuite b _ -> return () -runStatementI (StatementI lineN columnN (NewModule name argTemplate suite)) = do +runStatementI (StatementI sourcePos (NewModule name argTemplate suite)) = do argTemplate' <- forM argTemplate $ \(name', defexpr) -> do defval <- mapMaybeM evalExpr defexpr return (name', defval) (CompState (VarLookup varlookup, _, path)) <- get -- FIXME: \_? really? - runStatementI . StatementI lineN columnN $ (Name name :=) $ LitE $ OModule $ \_ -> do + runStatementI . StatementI sourcePos $ (Name name :=) $ LitE $ OModule $ \_ -> do newNameVals <- forM argTemplate' $ \(name', maybeDef) -> do val <- case maybeDef of Just def -> argument name' `defaultTo` def @@ -112,7 +112,7 @@ runStatementI (StatementI lineN columnN (NewModule name argTemplate suite)) = do suiteVals = runSuiteCapture (VarLookup varlookup') path suite return suiteVals -runStatementI (StatementI lineN columnN (ModuleCall (Symbol name) argsExpr suite)) = do +runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) = do maybeMod <- lookupVar (Symbol name) (CompState (varlookup, _, path)) <- get childVals <- fmap reverse . liftIO $ runSuiteCapture varlookup path suite @@ -125,18 +125,18 @@ runStatementI (StatementI lineN columnN (ModuleCall (Symbol name) argsExpr suite ioNewVals = fromMaybe (return []) (fst $ argMap argsVal argparser) Just foo -> do case getErrors foo of - Just err -> errorC lineN columnN err - Nothing -> errorC lineN columnN "Object called not module!" + Just err -> errorC sourcePos err + Nothing -> errorC sourcePos "Object called not module!" return [] Nothing -> do - errorC lineN columnN $ "Module " ++ name ++ " not in scope." + errorC sourcePos $ "Module " ++ name ++ " not in scope." return [] pushVals newVals -runStatementI (StatementI _ _ (Include name injectVals)) = do +runStatementI (StatementI _ (Include name injectVals)) = do name' <- getRelPath name content <- liftIO $ readFile name' - case parseProgram content of + case parseProgram name' content of Left e -> liftIO $ putStrLn $ "Error parsing " ++ name ++ ":" ++ show e Right sts -> withPathShiftedBy (takeDirectory name) $ do vals <- getVals @@ -145,7 +145,7 @@ runStatementI (StatementI _ _ (Include name injectVals)) = do vals' <- getVals if injectVals then putVals (vals' ++ vals) else putVals vals -runStatementI (StatementI _ _ DoNothing) = liftIO $ putStrLn "Do Nothing?" +runStatementI (StatementI _ DoNothing) = liftIO $ putStrLn "Do Nothing?" runSuite :: [StatementI] -> StateC () runSuite = mapM_ runStatementI diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs index fc1da12..3330922 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Statement.hs @@ -23,14 +23,14 @@ import Data.Functor.Identity(Identity) import Data.Kind (Type) -- We use parsec to parse. -import Text.ParserCombinators.Parsec (try, sepBy, sourceLine, sourceColumn, GenParser, oneOf, space, char, getPosition, parse, many1, eof, string, ParseError, many, noneOf, Line, Column, (<|>), ()) +import Text.ParserCombinators.Parsec (SourceName, try, sepBy, GenParser, oneOf, space, char, getPosition, parse, many1, eof, string, ParseError, many, noneOf, Line, Column, (<|>), ()) import Text.Parsec.Prim (ParsecT) -import Graphics.Implicit.ExtOpenScad.Definitions (Statement(DoNothing, NewModule, Include, Echo, If, For, ModuleCall, (:=)), Expr(LamE), StatementI(StatementI), Symbol(Symbol)) +import Graphics.Implicit.ExtOpenScad.Definitions (Statement(DoNothing, NewModule, Include, Echo, If, For, ModuleCall, (:=)), Expr(LamE), StatementI(StatementI), Symbol(Symbol), SourcePosition) import qualified Graphics.Implicit.ExtOpenScad.Definitions as GIED (Pattern(Name)) -import Graphics.Implicit.ExtOpenScad.Parser.Util (genSpace, tryMany, stringGS, (*<|>), (?:), patternMatcher, variableSymb) +import Graphics.Implicit.ExtOpenScad.Parser.Util (genSpace, tryMany, stringGS, (*<|>), (?:), patternMatcher, variableSymb, sourcePosition) -- the top level of the expression parser. import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0) @@ -38,8 +38,8 @@ import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0) -- Let us use the old syntax when defining Names. pattern Name n = GIED.Name (Symbol n) -parseProgram :: String -> Either ParseError [StatementI] -parseProgram = parse program "" where -- "" is our program name. +parseProgram :: SourceName -> String -> Either ParseError [StatementI] +parseProgram name s = parse program name s where program :: ParsecT String u Identity [StatementI] program = do sts <- many1 computation @@ -104,115 +104,102 @@ suite = (fmap return computation <|> do -- | commenting out a comuptation: use % or * before the statement, and it will not be run. throwAway :: GenParser Char st StatementI throwAway = do - line <- lineNumber - column <- columnNumber + pos <- sourcePos _ <- genSpace _ <- oneOf "%*" _ <- genSpace _ <- computation - return $ StatementI line column DoNothing + return $ StatementI pos DoNothing -- | An include! Basically, inject another extopenscad file here... include :: GenParser Char st StatementI include = (do - line <- lineNumber - column <- columnNumber + pos <- sourcePos injectVals <- (string "include" >> return True ) <|> (string "use" >> return False) _ <- stringGS " < " filename <- many (noneOf "<> ") _ <- stringGS " > " - return $ StatementI line column $ Include filename injectVals + return $ StatementI pos $ Include filename injectVals ) "include " -- | An assignment (parser) assignment :: GenParser Char st StatementI -assignment = ("assignment " ?:) $ - do - line <- lineNumber - column <- columnNumber - lvalue <- patternMatcher - _ <- stringGS " = " - valExpr <- expr0 - return $ StatementI line column $ lvalue := valExpr +assignment = ("assignment " ?:) $ do + pos <- sourcePos + lvalue <- patternMatcher + _ <- stringGS " = " + valExpr <- expr0 + return $ StatementI pos $ lvalue := valExpr -- | A function declaration (parser) function :: GenParser Char st StatementI -function = ("function " ?:) $ - do - line <- lineNumber - column <- columnNumber - varSymb <- string "function" >> space >> genSpace >> variableSymb - _ <- stringGS " ( " - argVars <- sepBy patternMatcher (stringGS " , ") - _ <- stringGS " ) = " - valExpr <- expr0 - return $ StatementI line column $ Name varSymb := LamE argVars valExpr +function = ("function " ?:) $ do + pos <- sourcePos + varSymb <- string "function" >> space >> genSpace >> variableSymb + _ <- stringGS " ( " + argVars <- sepBy patternMatcher (stringGS " , ") + _ <- stringGS " ) = " + valExpr <- expr0 + return $ StatementI pos $ Name varSymb := LamE argVars valExpr -- | An echo (parser) echo :: GenParser Char st StatementI echo = do - line <- lineNumber - column <- columnNumber + pos <- sourcePos _ <- stringGS "echo ( " exprs <- expr0 `sepBy` stringGS " , " _ <- stringGS " ) " - return $ StatementI line column $ Echo exprs + return $ StatementI pos $ Echo exprs ifStatementI :: GenParser Char st StatementI -ifStatementI = - "if " ?: do - line <- lineNumber - column <- columnNumber - _ <- stringGS "if ( " - bexpr <- expr0 - _ <- stringGS " ) " - sTrueCase <- suite - _ <- genSpace - sFalseCase <- (stringGS "else " >> suite ) *<|> return [] - return $ StatementI line column $ If bexpr sTrueCase sFalseCase +ifStatementI = "if " ?: do + pos <- sourcePos + _ <- stringGS "if ( " + bexpr <- expr0 + _ <- stringGS " ) " + sTrueCase <- suite + _ <- genSpace + sFalseCase <- (stringGS "else " >> suite ) *<|> return [] + return $ StatementI pos $ If bexpr sTrueCase sFalseCase forStatementI :: GenParser Char st StatementI -forStatementI = - "for " ?: do - line <- lineNumber - column <- columnNumber - -- a for loop is of the form: - -- for ( vsymb = vexpr ) loops - -- eg. for ( a = [1,2,3] ) {echo(a); echo "lol";} - -- eg. for ( [a,b] = [[1,2]] ) {echo(a+b); echo "lol";} - _ <- stringGS "for ( " - lvalue <- patternMatcher - _ <- stringGS " = " - vexpr <- expr0 - _ <- stringGS " ) " - loopContent <- suite - return $ StatementI line column $ For lvalue vexpr loopContent +forStatementI = "for " ?: do + pos <- sourcePos + -- a for loop is of the form: + -- for ( vsymb = vexpr ) loops + -- eg. for ( a = [1,2,3] ) {echo(a); echo "lol";} + -- eg. for ( [a,b] = [[1,2]] ) {echo(a+b); echo "lol";} + _ <- stringGS "for ( " + lvalue <- patternMatcher + _ <- stringGS " = " + vexpr <- expr0 + _ <- stringGS " ) " + loopContent <- suite + return $ StatementI pos $ For lvalue vexpr loopContent -- | parse a call to a module. userModule :: GenParser Char st StatementI userModule = do - line <- lineNumber - column <- columnNumber + pos <- sourcePos name <- variableSymb _ <- genSpace args <- moduleArgsUnit _ <- genSpace s <- suite *<|> (stringGS " ; " >> return []) - return $ StatementI line column $ ModuleCall (Symbol name) args s + return $ StatementI pos $ ModuleCall (Symbol name) args s -- | declare a module. userModuleDeclaration :: GenParser Char st StatementI userModuleDeclaration = do - line <- lineNumber - column <- columnNumber + pos <- sourcePos _ <- stringGS "module " newModuleName <- variableSymb _ <- genSpace args <- moduleArgsUnitDecl _ <- genSpace s <- suite - return $ StatementI line column $ NewModule (Symbol newModuleName) args s + return $ StatementI pos $ NewModule (Symbol newModuleName) args s -- | parse the arguments passed to a module. moduleArgsUnit :: GenParser Char st [(Maybe Symbol, Expr)] @@ -266,13 +253,8 @@ moduleArgsUnitDecl = do _ <- stringGS " ) " return argTemplate --- | Find the line number. Used when generating errors. -lineNumber :: forall s u (m :: Type -> Type). - Monad m => ParsecT s u m Line -lineNumber = fmap sourceLine getPosition - --- | Find the column number. Used when generating errors. -columnNumber :: forall s u (m :: Type -> Type). - Monad m => ParsecT s u m Column -columnNumber = fmap sourceColumn getPosition - +-- | Find the source position. Used when generating errors. +sourcePos :: ParsecT s u Identity SourcePosition +sourcePos = do + pos <- getPosition + return $ sourcePosition pos diff --git a/Graphics/Implicit/ExtOpenScad/Parser/Util.hs b/Graphics/Implicit/ExtOpenScad/Parser/Util.hs index 03fec1d..61d5e9e 100644 --- a/Graphics/Implicit/ExtOpenScad/Parser/Util.hs +++ b/Graphics/Implicit/ExtOpenScad/Parser/Util.hs @@ -8,17 +8,21 @@ -- FIXME: required. why? {-# LANGUAGE KindSignatures, FlexibleContexts #-} -module Graphics.Implicit.ExtOpenScad.Parser.Util (genSpace, pad, (*<|>), (?:), stringGS, padString, padChar, tryMany, variableSymb, patternMatcher) where +module Graphics.Implicit.ExtOpenScad.Parser.Util (genSpace, pad, (*<|>), (?:), stringGS, padString, padChar, tryMany, variableSymb, patternMatcher, sourcePosition) where import Prelude (String, Char, ($), (++), foldl1, map, (>>), (.), return) -import Text.ParserCombinators.Parsec (GenParser, many, oneOf, noneOf, (<|>), try, string, manyTill, anyChar, (), char, many1, sepBy) +import Text.ParserCombinators.Parsec (GenParser, SourcePos, many, oneOf, noneOf, (<|>), try, string, manyTill, anyChar, (), char, many1, sepBy) + +import qualified Text.ParserCombinators.Parsec as P (sourceLine, sourceColumn, sourceName) import Text.Parsec.Prim (ParsecT, Stream) import Data.Functor.Identity (Identity) -import Graphics.Implicit.ExtOpenScad.Definitions (Pattern(Wild, Name, ListP), Symbol(Symbol)) +import Graphics.Implicit.ExtOpenScad.Definitions (Pattern(Wild, Name, ListP), SourcePosition(SourcePosition), Symbol(Symbol)) + +import Graphics.Implicit.Definitions (toFastℕ) import Data.Kind (Type) @@ -108,3 +112,6 @@ patternMatcher = _ <- char ']' return $ ListP components ) + +sourcePosition :: SourcePos -> SourcePosition +sourcePosition pos = SourcePosition (toFastℕ $ P.sourceLine pos) (toFastℕ $ P.sourceColumn pos) (P.sourceName pos) diff --git a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs index a38ac64..2496510 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/StateC.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/StateC.hs @@ -13,7 +13,7 @@ module Graphics.Implicit.ExtOpenScad.Util.StateC (getVarLookup, modifyVarLookup, import Prelude(FilePath, IO, String, Maybe(Just, Nothing), Show, Monad, fmap, (.), ($), (++), return, putStrLn, show) -import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol) +import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition) import Data.Map (lookup) import Control.Monad.State (StateT, get, put, modify, liftIO) @@ -71,8 +71,9 @@ getRelPath relPath = do path <- getPath return $ path relPath -errorC :: forall (m :: Type -> Type) a. (Show a, MonadIO m) => a -> a -> String -> m () -errorC lineN columnN err = liftIO $ putStrLn $ "On line " ++ show lineN ++ ", column " ++ show columnN ++ ": " ++ err +errorC :: SourcePosition -> String -> StateC() +errorC sourcePos err = + liftIO $ putStrLn $ "At " ++ show sourcePos ++ ": " ++ err {-# INLINABLE errorC #-} mapMaybeM :: forall t (m :: Type -> Type) a. Monad m => (t -> m a) -> Maybe t -> m (Maybe a) diff --git a/programs/parser-bench.hs b/programs/parser-bench.hs index 43ba53c..3ae34c7 100644 --- a/programs/parser-bench.hs +++ b/programs/parser-bench.hs @@ -33,7 +33,7 @@ parseExpr s = case parse expr0 "src" s of Right e -> e parseStatements :: String -> [StatementI] -parseStatements s = case parseProgram s of +parseStatements s = case parseProgram "noname" s of Left err -> error (show err) Right e -> e diff --git a/tests/ParserSpec/Expr.hs b/tests/ParserSpec/Expr.hs index 65ee52a..8df297c 100644 --- a/tests/ParserSpec/Expr.hs +++ b/tests/ParserSpec/Expr.hs @@ -132,9 +132,9 @@ exprSpec = do it "handles multiple function calls" $ "foo(1)(2)(3)" --> ((Var "foo" :$ [num 1]) :$ [num 2]) :$ [num 3] describe "arithmetic" $ do - it "handles unary -" $ do + it "handles unary -" $ "-42" --> num (-42) - it "handles unary +" $ do + it "handles unary +" $ "+42" --> num 42 it "handles unary - with extra spaces" $ "- 42" --> num (-42) diff --git a/tests/ParserSpec/Statement.hs b/tests/ParserSpec/Statement.hs index c942ae9..eeb0730 100644 --- a/tests/ParserSpec/Statement.hs +++ b/tests/ParserSpec/Statement.hs @@ -14,13 +14,15 @@ import Test.Hspec (Spec, Expectation, shouldBe, shouldSatisfy, it, pendingWith, import ParserSpec.Util (bool, num, minus, plus, mult, index) -import Graphics.Implicit.ExtOpenScad.Definitions (StatementI(StatementI), Symbol(Symbol), Expr(ListE, LamE, (:$)), Statement(NewModule, ModuleCall, If, (:=)), Pattern(ListP)) +import Graphics.Implicit.ExtOpenScad.Definitions (StatementI(StatementI), Symbol(Symbol), Expr(ListE, LamE, (:$)), Statement(NewModule, ModuleCall, If, (:=)), Pattern(ListP), SourcePosition(SourcePosition)) import qualified Graphics.Implicit.ExtOpenScad.Definitions as GIED (Expr(Var), Pattern(Name)) -- Parse an ExtOpenScad program. import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram) +import Graphics.Implicit.Definitions (Fastℕ) + import Data.Either (Either(Right), isLeft) import Text.ParserCombinators.Parsec (Line, Column) @@ -33,19 +35,19 @@ pattern Name n = GIED.Name (Symbol n) infixr 1 --> (-->) :: String -> [StatementI] -> Expectation (-->) source stmts = - parseProgram source `shouldBe` Right stmts + parseProgram "noname" source `shouldBe` Right stmts -- | an expectation that a string generates an error. parsesAsError :: String -> Expectation -parsesAsError source = parseProgram source `shouldSatisfy` isLeft +parsesAsError source = parseProgram "noname" source `shouldSatisfy` isLeft -- | A single statement. single :: Statement StatementI -> [StatementI] -single st = [StatementI 1 1 st] +single st = [StatementI (SourcePosition 1 1 "noname") st] -- | A function call. -call :: String -> Column -> [(Maybe Symbol, Expr)] -> [StatementI] -> StatementI -call name position args stmts = StatementI 1 position (ModuleCall (Symbol name) args stmts) +call :: String -> Fastℕ -> [(Maybe Symbol, Expr)] -> [StatementI] -> StatementI +call name column args stmts = StatementI (SourcePosition 1 column "noname") (ModuleCall (Symbol name) args stmts) -- | Test a simple if block. ifSpec :: Spec