add framework for passing options to the scad execution engine. also clean some warnings, and use the messaging infrastructure more consistently.

Author: julialongtin

Graphics/Implicit/ExtOpenScad.hs

@@ -12,7 +12,7 @@ import Prelude(String, Either(Left, Right), IO, ($), fmap, return)
 
 import Graphics.Implicit.Definitions (SymbolicObj2, SymbolicObj3)
 
-import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, Message(Message), MessageType(SyntaxError))
+import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, ScadOpts, Message(Message), MessageType(SyntaxError))
 
 import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram)
 
@@ -35,12 +35,12 @@ import Control.Monad.State (runStateT)
 import System.Directory (getCurrentDirectory)
 
 -- | Small wrapper of our parser to handle parse errors, etc.
-runOpenscad :: String -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
-runOpenscad source =
+runOpenscad :: ScadOpts -> String -> IO (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
+runOpenscad scadOpts source =
     let
         initial =  defaultObjects
         rearrange :: (t, CompState) -> (VarLookup, [SymbolicObj2], [SymbolicObj3], [Message])
-        rearrange (_, (CompState (varlookup, ovals, _, messages))) = (varlookup, obj2s, obj3s, messages) where
+        rearrange (_, (CompState (varlookup, ovals, _, messages, _))) = (varlookup, obj2s, obj3s, messages) where
                                   (obj2s, obj3s, _ ) = divideObjs ovals
         show' err = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err)
         mesg e = Message SyntaxError (sourcePosition $ errorPos e) $ show' e
@@ -49,6 +49,6 @@ runOpenscad source =
         Right sts -> fmap rearrange
             $ (\sts' -> do
                 path <- getCurrentDirectory
-                runStateT sts' $ CompState (initial, [], path, [])
+                runStateT sts' $ CompState (initial, [], path, [], scadOpts)
             )
             $ mapM_ runStatementI sts

Graphics/Implicit/ExtOpenScad/Definitions.hs

@@ -14,6 +14,7 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch
                                                   SourcePosition(SourcePosition),
                                                   Message(Message),
                                                   MessageType(..),
+                                                  ScadOpts(ScadOpts),
                                                   lookupVarIn,
                                                   collector) where
 
@@ -143,7 +144,7 @@ instance Show OVal where
     show (OObj2 obj) = "<obj2: " ++ show obj ++ ">"
     show (OObj3 obj) = "<obj3: " ++ show obj ++ ">"
 
--- In order to not propagate Parsec or other modules around, create our own source position type for the AST.
+-- | 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ℕ
@@ -155,7 +156,7 @@ 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
 
--- | the types of messages the execution engine can send back to the application.
+-- | The types of messages the execution engine can send back to the application.
 data MessageType = Info
                  | Debug
                  | Trace
@@ -175,6 +176,16 @@ data Message = Message MessageType SourcePosition String
 instance Show Message where
   show (Message mtype pos text) = show mtype ++ " at " ++ show pos ++ ": " ++ text
 
+-- | Options changing the behavior of the extended OpenScad engine.
+data ScadOpts = ScadOpts
+    { openScadCompatibility :: Bool
+    }
+
+instance Show ScadOpts where
+  show (ScadOpts openScadCompat) =
+    "ScadOpts openScadCompatibility: " ++
+    show openScadCompat
+
 -- | 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

Graphics/Implicit/ExtOpenScad/Eval/Statement.hs

@@ -7,7 +7,7 @@
 
 module Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI) where
 
-import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), FilePath, IO, (.), ($), show, putStrLn, concatMap, return, (++), fmap, reverse, fst, readFile)
+import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), FilePath, IO, (.), ($), show, concatMap, return, (++), fmap, reverse, fst, readFile)
 
 import Graphics.Implicit.ExtOpenScad.Definitions (
                                                   Statement(Include, (:=), Echo, For, If, NewModule, ModuleCall, DoNothing),
@@ -16,12 +16,14 @@ import Graphics.Implicit.ExtOpenScad.Definitions (
                                                   OVal(OString, OBool, OList, OModule),
                                                   VarLookup(VarLookup),
                                                   StatementI(StatementI),
-                                                  Symbol(Symbol)
+                                                  Symbol(Symbol),
+                                                  MessageType(Info),
+                                                  ScadOpts
                                                  )
 
 import Graphics.Implicit.ExtOpenScad.Util.OVal (getErrors)
 import Graphics.Implicit.ExtOpenScad.Util.ArgParser (argument, defaultTo, argMap)
-import Graphics.Implicit.ExtOpenScad.Util.StateC (StateC, CompState(CompState), errorC, modifyVarLookup, mapMaybeM, lookupVar, pushVals, getRelPath, withPathShiftedBy, getVals, putVals)
+import Graphics.Implicit.ExtOpenScad.Util.StateC (StateC, CompState(CompState), errorC, modifyVarLookup, mapMaybeM, lookupVar, pushVals, getRelPath, withPathShiftedBy, getVals, putVals, addMessage, scadOptions)
 import Graphics.Implicit.ExtOpenScad.Eval.Expr (evalExpr, matchPat)
 import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram)
 
@@ -50,13 +52,15 @@ runStatementI (StatementI sourcePos (pat := expr)) = do
         (_, Just match) -> modifyVarLookup $ varUnion match
         (_,   Nothing ) -> errorC sourcePos "pattern match failed in assignment"
 
+-- FIXME: take scadOptions into account.
 runStatementI (StatementI sourcePos (Echo exprs)) = do
+    opts <- scadOptions
     let
         show2 (OString s) = s
         show2 x = show x
     vals <- mapM evalExpr exprs
     case getErrors (OList vals) of
-        Nothing  -> liftIO . putStrLn $ concatMap show2 vals
+        Nothing  -> addMessage Info sourcePos $ concatMap show2 vals
         Just err -> errorC sourcePos err
 
 runStatementI (StatementI sourcePos (For pat expr loopContent)) = do
@@ -80,10 +84,11 @@ runStatementI (StatementI sourcePos (If expr a b)) = do
         _                 -> return ()
 
 runStatementI (StatementI sourcePos (NewModule name argTemplate suite)) = do
+    opts <- scadOptions
     argTemplate' <- forM argTemplate $ \(name', defexpr) -> do
         defval <- mapMaybeM evalExpr defexpr
         return (name', defval)
-    (CompState (VarLookup varlookup, _, path, _)) <- get
+    (CompState (VarLookup varlookup, _, path, _, scadOpts)) <- get
 --  FIXME: \_? really?
     runStatementI . StatementI sourcePos $ (Name name :=) $ LitE $ OModule $ \_ -> do
         newNameVals <- forM argTemplate' $ \(name', maybeDef) -> do
@@ -109,13 +114,14 @@ runStatementI (StatementI sourcePos (NewModule name argTemplate suite)) = do
             newNameVals' = newNameVals ++ [("children", children),("child", child), ("childBox", childBox)]
 -}
             varlookup' = union (fromList newNameVals) varlookup
-            suiteVals  = runSuiteCapture (VarLookup varlookup') path suite
+            suiteVals  = runSuiteCapture (VarLookup varlookup') path scadOpts suite
         return suiteVals
 
 runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) = do
+        opts <- scadOptions
         maybeMod  <- lookupVar (Symbol name)
-        (CompState (varlookup, _, path, _)) <- get
-        childVals <- fmap reverse . liftIO $ runSuiteCapture varlookup path suite
+        (CompState (varlookup, _, path, _, _)) <- get
+        childVals <- fmap reverse . liftIO $ runSuiteCapture varlookup path opts suite
         argsVal   <- forM argsExpr $ \(posName, expr) -> do
             val <- evalExpr expr
             return (posName, val)
@@ -133,30 +139,26 @@ runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) =
                 return []
         pushVals newVals
 
-runStatementI (StatementI _ (Include name injectVals)) = do
+runStatementI (StatementI sourcePos (Include name injectVals)) = do
     name' <- getRelPath name
     content <- liftIO $ readFile name'
     case parseProgram name' content of
-        Left e -> liftIO $ putStrLn $ "Error parsing " ++ name ++ ":" ++ show e
+        Left e -> errorC sourcePos $ "Error parsing " ++ name ++ ":" ++ show e
         Right sts -> withPathShiftedBy (takeDirectory name) $ do
             vals <- getVals
             putVals []
             runSuite sts
             vals' <- getVals
             if injectVals then putVals (vals' ++ vals) else putVals vals
 
-runStatementI (StatementI _ DoNothing) = liftIO $ putStrLn "Do Nothing?"
+runStatementI (StatementI _ DoNothing) = return ()
 
 runSuite :: [StatementI] -> StateC ()
 runSuite = mapM_ runStatementI
 
-runSuiteCapture :: VarLookup -> FilePath -> [StatementI] -> IO [OVal]
-runSuiteCapture varlookup path suite = do
+runSuiteCapture :: VarLookup -> FilePath -> ScadOpts -> [StatementI] -> IO [OVal]
+runSuiteCapture varlookup path opts suite = do
     (res, _) <- runStateT
         (runSuite suite >> getVals)
-        (CompState (varlookup, [], path, []))
+        (CompState (varlookup, [], path, [], opts))
     return res
-
-
-
-

Graphics/Implicit/ExtOpenScad/Util/StateC.hs

@@ -9,11 +9,11 @@
 {-# LANGUAGE KindSignatures, FlexibleContexts #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
 
-module Graphics.Implicit.ExtOpenScad.Util.StateC (addMessage, getVarLookup, modifyVarLookup, lookupVar, pushVals, getVals, putVals, withPathShiftedBy, getPath, getRelPath, errorC, mapMaybeM, StateC, CompState(CompState)) where
+module Graphics.Implicit.ExtOpenScad.Util.StateC (addMessage, getVarLookup, modifyVarLookup, lookupVar, pushVals, getVals, putVals, withPathShiftedBy, getPath, getRelPath, errorC, mapMaybeM, StateC, CompState(CompState), scadOptions) where
 
 import Prelude(FilePath, IO, String, Maybe(Just, Nothing), Show, Monad, fmap, (.), ($), (++), return, putStrLn, show)
 
-import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition, Message(Message), MessageType(Error))
+import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition, Message(Message), MessageType(Error), ScadOpts)
 
 import Data.Map (lookup)
 import Control.Monad.State (StateT, get, put, modify, liftIO)
@@ -22,57 +22,63 @@ import Control.Monad.IO.Class (MonadIO)
 import Data.Kind (Type)
 
 -- | This is the state of a computation. It contains a hash of variables, an array of OVals, a path, and messages.
-newtype CompState = CompState (VarLookup, [OVal], FilePath, [Message])
+newtype CompState = CompState (VarLookup, [OVal], FilePath, [Message], ScadOpts)
 
 type StateC = StateT CompState IO
 
 getVarLookup :: StateC VarLookup
-getVarLookup = fmap (\(CompState (a,_,_,_)) -> a) get
+getVarLookup = fmap (\(CompState (a,_,_,_,_)) -> a) get
 
 modifyVarLookup :: (VarLookup -> VarLookup) -> StateC ()
-modifyVarLookup = modify . (\f (CompState (a,b,c,d)) -> CompState (f a, b, c, d))
+modifyVarLookup = modify . (\f (CompState (a,b,c,d,e)) -> CompState (f a, b, c, d, e))
 
 -- | Perform a variable lookup
+--   FIXME: generate a warning when we look up a variable that is not present.
 lookupVar :: Symbol -> StateC (Maybe OVal)
 lookupVar name = do
     (VarLookup varlookup) <- getVarLookup
     return $ lookup name varlookup
 
 pushVals :: [OVal] -> StateC ()
-pushVals vals = modify (\(CompState (a,b,c,d)) -> CompState (a, vals ++ b, c, d))
+pushVals vals = modify (\(CompState (a,b,c,d,e)) -> CompState (a, vals ++ b, c, d, e))
 
 getVals :: StateC [OVal]
 getVals = do
-    (CompState (_,b,_,_)) <- get
+    (CompState (_,b,_,_,_)) <- get
     return b
 
 putVals :: [OVal] -> StateC ()
 putVals vals = do
-    (CompState (a,_,c,d)) <- get
-    put $ CompState (a,vals,c,d)
+    (CompState (a,_,c,d,e)) <- get
+    put $ CompState (a,vals,c,d,e)
 
 withPathShiftedBy :: FilePath -> StateC a -> StateC a
 withPathShiftedBy pathShift s = do
-    (CompState (a,b,path,d)) <- get
-    put $ CompState (a, b, path </> pathShift,d)
+    (CompState (a,b,path,d,e)) <- get
+    put $ CompState (a, b, path </> pathShift, d, e)
     x <- s
-    (CompState (a',b',_,d')) <- get
-    put $ CompState (a', b', path, d')
+    (CompState (a',b',_,d',e')) <- get
+    put $ CompState (a', b', path, d', e')
     return x
 
 -- | Return the path stored in the state.
 getPath :: StateC FilePath
 getPath = do
-    (CompState (_,_,c,_)) <- get
+    (CompState (_,_,c,_,_)) <- get
     return c
 
 getRelPath :: FilePath -> StateC FilePath
 getRelPath relPath = do
     path <- getPath
     return $ path </> relPath
 
+scadOptions :: StateC ScadOpts
+scadOptions = do
+  (CompState (_, _, _, _, opts)) <- get
+  return opts
+
 addMesg :: Message -> StateC ()
-addMesg = modify . (\message (CompState (a, b, c, messages)) -> (CompState (a, b, c, messages ++ [message])))
+addMesg = modify . (\message (CompState (a, b, c, messages, d)) -> (CompState (a, b, c, messages ++ [message], d)))
 
 addMessage :: MessageType -> SourcePosition -> String -> StateC ()
 addMessage mtype pos text = addMesg $ Message mtype pos text

programs/extopenscad.hs

@@ -11,7 +11,7 @@
 
 -- Let's be explicit about what we're getting from where :)
 
-import Prelude (Read(readsPrec), Maybe(Just, Nothing), IO, FilePath, Show, Eq, String, (++), ($), (*), (/), (==), (>), (**), (-), readFile, minimum, drop, error, map, fst, min, sqrt, tail, take, length, putStrLn, show, (>>=), lookup, return, unlines)
+import Prelude (Read(readsPrec), Maybe(Just, Nothing), IO, Bool, FilePath, Show, Eq, String, (++), ($), (*), (/), (==), (>), (**), (-), readFile, minimum, drop, error, map, fst, min, sqrt, tail, take, length, putStrLn, show, (>>=), lookup, return, unlines)
 
 -- Our Extended OpenScad interpreter, and functions to write out files in designated formats.
 import Graphics.Implicit (runOpenscad, writeSVG, writeDXF2, writeBinSTL, writeOBJ, writeSCAD2, writeSCAD3, writeGCodeHacklabLaser, writePNG2, writePNG3)
@@ -34,17 +34,18 @@ import Data.Tuple (swap)
 -- Functions and types for dealing with the types used by runOpenscad.
 
 -- The definition of the symbol type, so we can access variables, and see the requested resolution.
-import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, OVal(ONum), lookupVarIn, Message)
+import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup, OVal(ONum), lookupVarIn, Message, ScadOpts(ScadOpts))
 
 -- Operator to subtract two points. Used when defining the resolution of a 2d object.
 import Data.AffineSpace ((.-.))
 
+-- For defining the <> operator.
 import Data.Monoid (Monoid, mappend)
 
 import Control.Applicative ((<$>), (<*>))
 
 -- NOTE: make sure we don't import (<>) in new versions.
-import Options.Applicative (fullDesc, progDesc, header, auto, info, helper, help, str, argument, long, short, option, metavar, execParser, Parser, optional, strOption)
+import Options.Applicative (fullDesc, progDesc, header, auto, info, helper, help, str, argument, long, short, option, metavar, execParser, Parser, optional, strOption, switch)
 
 -- For handling input/output files.
 import System.FilePath (splitExtension)
@@ -65,6 +66,7 @@ data ExtOpenScadOpts = ExtOpenScadOpts
     , resolution :: Maybe ℝ
     , inputFile :: FilePath
     , messageOutputFile :: Maybe FilePath
+    , openScadCompatibility :: Bool
     }
 
 -- | A type serving to enumerate our output formats.
@@ -136,11 +138,16 @@ extOpenScadOpts = ExtOpenScadOpts
     <*> optional (
         strOption
           (  short 'e'
-            <> long "echo-output"
-            <> metavar "FILE"
-            <> help "Output file name for echo statements"
+             <> long "echo-output"
+             <> metavar "FILE"
+             <> help "Output file name for echo statements"
           )
         )
+    <*> switch
+        (  short 'O'
+           <> long "fopenscad-compat"
+           <> help "Favour compatibility with OpenSCAD semantics, where they are incompatible with ExtOpenScad semantics"
+        )
 
 -- | Try to look up an output format from a supplied extension.
 readOutputFormat :: String -> Maybe OutputFormat
@@ -223,7 +230,8 @@ run args = do
                 _ | Just fmt <- outputFormat args -> Just fmt
                 _ | Just file <- outputFile args  -> Just $ guessOutputFormat file
                 _                                 -> Nothing
-        openscadProgram = runOpenscad content
+        scadOpts = ScadOpts (openScadCompatibility args)
+        openscadProgram = runOpenscad scadOpts content
 
     putStrLn "Processing File."