Automatic execution of SCL tests in Maven

[simantics/platform.git] / tests / org.simantics.scl.compiler.tests / src / org / simantics / scl / compiler / tests / scl / LP.scl

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/LP.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/LP.scl
new file mode 100644 (file)
index 0000000..0c3ddc1
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/LP.scl
@@ -0,0 +1,86 @@
+import "Prelude"\r
+\r
+importJava "gnu.trove.map.hash.TIntFloatHashMap" where\r
+    data LMap\r
+    \r
+    @JavaName adjustOrPutValue\r
+    adjustLMap_ :: LMap -> Integer -> Float -> Float -> <Proc> ()\r
+    \r
+@inline\r
+adjustLMap :: LMap -> Integer -> Float -> <Proc> ()\r
+adjustLMap m k v = adjustLMap_ m k v v\r
+\r
+data LPTerm = LPTerm (LMap -> Float -> <Proc> ())\r
+\r
+instance Additive LPTerm where\r
+    @inline\r
+    zero = LPTerm (\_ _ -> ())\r
+    @inline\r
+    LPTerm a + LPTerm b = LPTerm (\m s -> do a m s ; b m s)\r
+    sum ts = LPTerm (\m s -> for ts (\(LPTerm t) -> t m s))\r
+\r
+instance Ring LPTerm where\r
+    @inline\r
+    neg (LPTerm a) = LPTerm (\m s -> a m (-s))\r
+    @inline\r
+    LPTerm a - LPTerm b = LPTerm (\m s -> do a m s ; b m (-s))\r
+    @inline\r
+    fromInteger c = LPTerm (\m s -> adjustLMap m (-1) (fromInteger c*s))\r
+    @inline\r
+    one = LPTerm (\m s -> adjustLMap m (-1) s)\r
+    _ * _ = fail "Multiplication is not supported."\r
+\r
+data LPProblem = LPProblem (Ref Integer)\r
+\r
+newProblem :: () -> <Proc> LPProblem\r
+newProblem _ = LPProblem (ref 0)\r
+\r
+newVar :: LPProblem -> <Proc> LPTerm\r
+newVar (LPProblem varCounter) = do\r
+    curId = getRef varCounter\r
+    varCounter := curId + 1\r
+    LPTerm (\m s -> adjustLMap m curId s)\r
+\r
+infixl 7 (**)\r
+\r
+@inline\r
+(**) :: Float -> LPTerm -> LPTerm\r
+s0 ** LPTerm t = LPTerm (\m s -> t m (s0*s))\r
+\r
+/*\r
+data LPTerm = LPTerm Double (Map.T String Double)\r
+\r
+instance Additive LPTerm where\r
+    zero = LPTerm 0 Map.empty\r
+    LPTerm c1 m1 + LPTerm c2 m2 = LPTerm (c1+c2) (Map.merge (+) m1 m2)\r
+\r
+instance Ring LPTerm where\r
+    one = LPTerm 1 Map.empty\r
+    neg (LPTerm c m) = LPTerm (-c) (map neg m)\r
+    LPTerm c1 m1 - LPTerm c2 m2 = LPTerm (c1-c2) (Map.merge (-) m1 m2)\r
+    \r
+    LPTerm c1 [] * LPTerm c2 m2 = LPTerm (c1*c2) (Map.merge (\x -> c1*x) m2)\r
+    LPTerm c1 m1 * LPTerm c2 [] = LPTerm (c1*c2) (Map.merge (\x -> c2*x) m1)\r
+    _ * _ = fail "Invalid expression: not linear."\r
+    \r
+    fromInteger i = LPTerm (fromInteger i) Map.empty\r
+\r
+data LPConstraint = LPConstraint String LPTerm\r
+\r
+(>==) :: LPTerm -> LPTerm -> String -> [LPConstraint]\r
+(a >== b) name = [LPConstraint name (a-b)] \r
+\r
+(<==) :: LPTerm -> LPTerm -> String -> [LPConstraint]\r
+(a <== b) name = [LPConstraint name (b-a)]\r
+\r
+*/\r
+\r
+testi () = do\r
+    problem = newProblem ()\r
+    a = newVar problem\r
+    b = newVar problem\r
+    3 ** a + 4 ** b + 15\r
+\r
+main = "OK"\r
+--\r
+OK
\ No newline at end of file