Adding basic support for rands and lookup

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Version [next](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.4.0.0...master) (202Y-MM-DD)
 
+* ExtOpenScad interface changes
+  * Added `rands` and `lookup` support [#433](https://github.com/Haskell-Things/ImplicitCAD/pull/433)
+
+* Other changes
+  * Migrating StateC and StateE to a ReaderT/WriterT/StateT transformer stack, rather than being just StateT. [#432](https://github.com/Haskell-Things/ImplicitCAD/pull/432)
+
 # Version [0.4.0.0](https://github.com/Haskell-Things/ImplicitCAD/compare/v0.3.0.0...v0.4.0.0) (2022-06-06)
 
 * Changelog started. Previous release was `0.3.0.1`.
@@ -46,4 +52,3 @@
   * Rotate now internally uses quaternions [#314](https://github.com/Haskell-Things/ImplicitCAD/pull/314)
   * Fixes to triangle generation [#355](https://github.com/Haskell-Things/ImplicitCAD/pull/355) and [#375](https://github.com/Haskell-Things/ImplicitCAD/pull/375)
   * ExtOpenSCAD vector addition [#408](https://github.com/Haskell-Things/ImplicitCAD/pull/408)
-  * Migrating StateC and StateE to a ReaderT/WriterT/StateT transformer stack [#432](https://github.com/Haskell-Things/ImplicitCAD/pull/432)

Graphics/Implicit/ExtOpenScad/Default.hs

@@ -8,15 +8,16 @@
 
 -- Allow the use of \case
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Graphics.Implicit.ExtOpenScad.Default (defaultObjects) where
 
 -- be explicit about where we pull things in from.
-import Prelude (Bool(True, False), Maybe(Just, Nothing), ($), (<>), (<$>), fmap, 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, id, foldMap, fromIntegral)
+import Prelude (Bool(True, False), Maybe(Just, Nothing), ($), (<>), (<$>), fmap, 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, id, foldMap, fromIntegral, IO, pure)
 
 import Graphics.Implicit.Definitions (ℝ, ℕ)
 
-import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, OVargsModule), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts))
+import Graphics.Implicit.ExtOpenScad.Definitions (VarLookup(VarLookup), OVal(OBool, OList, ONum, OString, OUndefined, OError, OFunc, OVargsModule, OIO), Symbol(Symbol), StateC, StatementI, SourcePosition, MessageType(TextOut, Warning), ScadOpts(ScadOpts))
 
 import Graphics.Implicit.ExtOpenScad.Util.OVal (toOObj, oTypeStr)
 
@@ -28,13 +29,17 @@ import Data.Int (Int64)
 
 import Data.Map (Map, fromList, insert)
 
-import Data.List (genericIndex, genericLength)
+import Data.List (genericIndex, genericLength, find)
 
-import Data.Foldable (for_)
+import Data.Foldable (for_, foldr)
 
 import qualified Data.Text.Lazy as TL (index)
 
 import Data.Text.Lazy (Text, intercalate, unpack, pack, length, singleton)
+import Control.Monad (replicateM)
+import System.Random (randomRIO)
+import Data.Maybe (maybe)
+import Data.Tuple (snd)
 
 defaultObjects :: Bool -> VarLookup
 defaultObjects withCSG = VarLookup $ fromList $
@@ -46,9 +51,6 @@ defaultObjects withCSG = VarLookup $ fromList $
     <> (if withCSG then primitiveModules else [])
     <> varArgModules
 
--- FIXME: Missing standard ones(which standard?):
--- rand, lookup,
-
 defaultConstants :: [(Symbol, OVal)]
 defaultConstants = (\(a,b) -> (a, toOObj (b :: ℝ))) <$>
     [(Symbol "pi", pi),
@@ -180,11 +182,61 @@ defaultPolymorphicFunctions =
         (Symbol "list_gen", toOObj list_gen),
         (Symbol "<>", concatenate),
         (Symbol "len", toOObj olength),
-        (Symbol "str", toOObj (pack.show :: OVal -> Text))
+        (Symbol "str", toOObj (pack.show :: OVal -> Text)),
+        (Symbol "rands", toOObj rands),
+        (Symbol "lookup", toOObj lookup)
     ] where
 
         -- Some key functions are written as OVals in optimizations attempts
 
+        -- Lookup a value from the given table, or linearly interpolate a value from
+        -- the nearest entries. Lookups for keys that fall outside the bounds of the
+        -- table will be given the value of the nearest table entry.
+        -- TODO, a binary tree would be faster for large tables, but I'm not bothering
+        -- until we have a good reason to do so, i.e. we see a need for it.
+        lookup :: ℝ -> [(ℝ, ℝ)] -> OVal
+        lookup key table =
+            let
+                -- Find the next lower value, and the next upper value from key
+                search op op' = foldr
+                    (\t@(k, _) -> maybe
+                        ( if k `op` key
+                          then pure t
+                          else Nothing
+                        )
+                        $ \t'@(k', _) -> pure $
+                            if k `op'` k' && k `op` key
+                            then t
+                            else t'
+                    )
+                    Nothing
+                    table
+                lower = search (<) (>)
+                upper = search (>) (<)
+                -- Interpolate linearly
+                -- Take the extremes if the key is out of bounds.
+                -- Undefined for empty tables, as the docs don't say what it should be.
+                -- https://en.wikibooks.org/wiki/OpenSCAD_User_Manual/Mathematical_Functions#lookup
+                interpolated = case (lower, upper) of
+                    (Just (lk, lv), Just (uk, uv)) ->
+                        -- calculate the linear slope of the graph
+                        let scale = (uv - lv) / (uk - lk)
+                        -- Use the lower value as the base, and add on the
+                        -- required amount of scaling
+                        in ONum $ lv + ((key - lk) * scale)
+                    (Nothing, Just (_, uv)) -> ONum uv
+                    (Just (_, lv), Nothing) -> ONum lv
+                    (Nothing, Nothing)      -> OUndefined
+            in maybe
+                interpolated
+                (ONum . snd)
+                $ find (\(k, _) -> k == key) table
+
+        rands :: ℝ -> ℝ -> ℝ -> IO OVal
+        rands minR maxR count = do
+            l <- replicateM (round count) $ randomRIO (minR, maxR)
+            pure . OList $ ONum <$> l
+
         prod = OFunc $ \case
             (OList (y:ys)) -> foldl mult y ys
             (OList [])     -> ONum 1
@@ -259,6 +311,9 @@ defaultPolymorphicFunctions =
                 n :: Int64
                 n = floor ind
             in if n < length s then OString (singleton (TL.index s n)) else OError "List accessed out of bounds"
+        -- For IO actions, get the OVal inside the IO and try to index that, rewrapping the results.
+        index (OIO o) ind = OIO $ flip index ind <$> o
+
         index a b = errorAsAppropriate "index" a b
 
         osplice (OList  list) (ONum a) (    ONum b    ) =

Graphics/Implicit/ExtOpenScad/Definitions.hs

@@ -21,7 +21,7 @@ module Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch
                                                   Expr(LitE, Var, ListE, LamE, (:$)),
                                                   StatementI(StatementI),
                                                   Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)),
-                                                  OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3),
+                                                  OVal(OIO, ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3),
                                                   TestInvariant(EulerCharacteristic),
                                                   SourcePosition(SourcePosition),
                                                   StateC,
@@ -195,6 +195,7 @@ data OVal = OUndefined
          | OList [OVal]
          | OString Text
          | OFunc (OVal -> OVal)
+         | OIO (IO OVal)
          -- Name, arguments, argument parsers.
          | OUModule Symbol (Maybe [(Symbol, Bool)]) (VarLookup -> ArgParser (StateC [OVal]))
          -- Name, implementation, arguments, whether the module accepts/requires a suite.
@@ -218,6 +219,7 @@ instance Show OVal where
     show (OList l) = show l
     show (OString s) = show s
     show (OFunc _) = "<function>"
+    show (OIO _) = "<IO>"
     show (OUModule (Symbol name) arguments _) = "module " <> unpack name <> " (" <> unpack (intercalate ", " (showArg <$> fromMaybe [] arguments)) <> ") {}"
       where
         showArg :: (Symbol, Bool) -> Text

Graphics/Implicit/ExtOpenScad/Util/OVal.hs

@@ -12,14 +12,16 @@
 
 -- Allow us to use string literals for Text
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Graphics.Implicit.ExtOpenScad.Util.OVal(OTypeMirror, (<||>), fromOObj, toOObj, divideObjs, caseOType, oTypeStr, getErrors) where
 
-import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return)
+import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left,Right), (==), fromInteger, floor, ($), (.), fmap, error, (<>), show, flip, filter, not, return, IO)
 
 import Graphics.Implicit.Definitions(V2, ℝ, ℝ2, ℕ, SymbolicObj2, SymbolicObj3, ExtrudeMScale(C1, C2, Fn), fromℕtoℝ)
 
-import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3))
+import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OBool, OString, OList, OFunc, OUndefined, OUModule, ONModule, OVargsModule, OError, OObj2, OObj3, OIO))
 
 import Control.Monad (msum)
 
@@ -44,6 +46,12 @@ class OTypeMirror a where
     {-# INLINABLE fromOObjList #-}
     toOObj :: a -> OVal
 
+instance OTypeMirror (IO OVal) where
+    fromOObj (OIO m) = Just m
+    fromOObj _       = Nothing
+    {-# INLINABLE fromOObj #-}
+    toOObj = OIO
+
 instance OTypeMirror OVal where
     fromOObj = Just
     {-# INLINABLE fromOObj #-}
@@ -75,6 +83,7 @@ instance (OTypeMirror a) => OTypeMirror [a] where
 instance OTypeMirror Text where
     fromOObj (OString str) = Just str
     fromOObj _ = Nothing
+    toOObj :: Text -> OVal
     toOObj a = OString a
 
 instance (OTypeMirror a) => OTypeMirror (Maybe a) where
@@ -160,6 +169,7 @@ oTypeStr (ONum           _ ) = "Number"
 oTypeStr (OList          _ ) = "List"
 oTypeStr (OString        _ ) = "String"
 oTypeStr (OFunc          _ ) = "Function"
+oTypeStr (OIO            _ ) = "IO"
 oTypeStr (OUModule   _ _ _ ) = "User Defined Module"
 oTypeStr (ONModule   _ _ _ ) = "Built-in Module"
 oTypeStr (OVargsModule _ _ ) = "VargsModule"

implicit.cabal

@@ -92,7 +92,8 @@ Library
                   mtl,
                   linear,
                   show-combinators,
-                  lens
+                  lens,
+                  random
 
 
     Exposed-modules:

tests/ExecSpec/Expr.hs

@@ -6,22 +6,25 @@
 module ExecSpec.Expr (exprExec) where
 
 -- Be explicit about what we import.
-import Prelude (($))
+import Prelude (($), (==), length, Bool (False), (<=), (&&), (<>), show)
 
 -- Hspec, for writing specs.
-import Test.Hspec (describe, Spec, it)
+import Test.Hspec (describe, Spec, it, shouldSatisfy, expectationFailure)
 
 -- The type used for variables, in ImplicitCAD.
 import Graphics.Implicit.Definitions (ℝ)
 
 -- Our utility library, for making these tests easier to read.
 import ExecSpec.Util ((-->), num, list, vect)
 
+import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr)
+import Graphics.Implicit.ExtOpenScad.Definitions (OVal(OIO, OList, ONum, OUndefined))
+
 -- Default all numbers in this file to being of the type ImplicitCAD uses for values.
 default (ℝ)
 
 exprExec :: Spec
-exprExec =
+exprExec = do
   describe "arithmetic" $ do
     it "performs simple addition" $
       "1+1" --> num 2
@@ -41,3 +44,52 @@ exprExec =
       "2 + [1, 2]" --> vect [3, 4]
     it "performs number and list/vector multiplication" $
       "2 * [3, 4, 5]" --> vect [6, 8, 10]
+  describe "rands" $ do
+    it "generates random numbers" $ do
+      case runExpr "rands(1,2,1)" False of
+        (OIO m, _) -> do
+          OList l <- m
+          shouldSatisfy l $ \l' -> length l' == 1
+        _ -> expectationFailure "Not an OIO"
+      case runExpr "rands(1,2,10)" False of
+        (OIO m, _) -> do
+          OList l <- m
+          shouldSatisfy l $ \l' -> length l' == 10
+        _ -> expectationFailure "Not an OIO"
+      case runExpr "rands(1,2,0)" False of
+        (OIO m, _) -> do
+          OList l <- m
+          shouldSatisfy l $ \l' -> length l' == 0
+        _ -> expectationFailure "Not an OIO"
+      case runExpr "rands(1,1,1)" False of
+        (OIO m, _) -> do
+          OList l <- m
+          shouldSatisfy l $ \l' ->
+            length l' == 1 &&
+            l' == [num 1]
+        _ -> expectationFailure "Not an OIO"
+      case runExpr "rands(1,2,1)[0]" False of
+        (OIO m, _) -> do
+          ONum n <- m
+          shouldSatisfy n $ \n' -> 1 <= n' && n' <= 2
+        o -> expectationFailure $ "Not an OIO: " <> show o
+      case runExpr "rands(1,2,2)[0+1]" False of
+        (OIO m, _) -> do
+          ONum n <- m
+          shouldSatisfy n $ \n' -> 1 <= n' && n' <= 2
+        o -> expectationFailure $ "Not an OIO: " <> show o
+  describe "lookup" $ do
+    it "Gets a value from a table" $ do
+      "lookup(1, [[0, 0], [1, 1], [2, 2]])" --> num 1
+    it "Interpolates values from a table" $ do
+      "lookup(1, [[0, 0], [2, 2]])" --> num 1
+      "lookup(7, [[0, 0], [5, 50], [10, 100], [11, 0]])" --> num 70
+      "lookup(10.5, [[0, 0], [5, 50], [10, 100], [11, 0]])" --> num 50
+    it "Gets an upper extreme from a table" $ do
+      "lookup(10, [[0, 0], [1, 1], [2, 2]])" --> num 2
+    it "Gets an lower extreme from a table" $ do
+      "lookup(0, [[1, 1], [2, 2]])" --> num 1
+    it "Gets an nothing from a table" $ do
+      "lookup(0, [])" --> OUndefined
+    it "Handles embedded statements" $ do
+      "lookup(0+1, [[0*2, 0], [1+1, 4/2]])" --> num 1

tests/ExecSpec/Util.hs

@@ -10,16 +10,17 @@ module ExecSpec.Util
        , num
        , list
        , vect
+       , io
        ) where
 
 -- be explicit about where we get things from.
-import Prelude (String, Bool(False), map, (.))
+import Prelude (String, Bool(False), map, (.), IO)
 
 -- The datatype of positions in our world.
 import Graphics.Implicit.Definitions (ℝ)
 
 -- Expressions, symbols, and values in the OpenScad language.
-import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OList))
+import Graphics.Implicit.ExtOpenScad.Definitions (OVal(ONum, OList, OIO))
 
 import Graphics.Implicit.ExtOpenScad.Eval.Constant (runExpr)
 
@@ -41,3 +42,6 @@ list = OList
 
 vect :: [ℝ] -> OVal
 vect =  list . map num
+
+io :: IO OVal -> OVal
+io = OIO