X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=tests%2Forg.simantics.scl.compiler.tests%2Fsrc%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FLP.scl;h=98b8fa48446e3dca80340c0808b5e363ffbcdaad;hp=0c3ddc1217a2a5313b1c37a7384e9844990bb550;hb=172abed5dbf73c1304a7a95bb8504ea293556948;hpb=861a3da972d67bf5f0d246129c63f611922e03f0 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 index 0c3ddc121..98b8fa484 100644 --- 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 @@ -1,86 +1,86 @@ -import "Prelude" - -importJava "gnu.trove.map.hash.TIntFloatHashMap" where - data LMap - - @JavaName adjustOrPutValue - adjustLMap_ :: LMap -> Integer -> Float -> Float -> () - -@inline -adjustLMap :: LMap -> Integer -> Float -> () -adjustLMap m k v = adjustLMap_ m k v v - -data LPTerm = LPTerm (LMap -> Float -> ()) - -instance Additive LPTerm where - @inline - zero = LPTerm (\_ _ -> ()) - @inline - LPTerm a + LPTerm b = LPTerm (\m s -> do a m s ; b m s) - sum ts = LPTerm (\m s -> for ts (\(LPTerm t) -> t m s)) - -instance Ring LPTerm where - @inline - neg (LPTerm a) = LPTerm (\m s -> a m (-s)) - @inline - LPTerm a - LPTerm b = LPTerm (\m s -> do a m s ; b m (-s)) - @inline - fromInteger c = LPTerm (\m s -> adjustLMap m (-1) (fromInteger c*s)) - @inline - one = LPTerm (\m s -> adjustLMap m (-1) s) - _ * _ = fail "Multiplication is not supported." - -data LPProblem = LPProblem (Ref Integer) - -newProblem :: () -> LPProblem -newProblem _ = LPProblem (ref 0) - -newVar :: LPProblem -> LPTerm -newVar (LPProblem varCounter) = do - curId = getRef varCounter - varCounter := curId + 1 - LPTerm (\m s -> adjustLMap m curId s) - -infixl 7 (**) - -@inline -(**) :: Float -> LPTerm -> LPTerm -s0 ** LPTerm t = LPTerm (\m s -> t m (s0*s)) - -/* -data LPTerm = LPTerm Double (Map.T String Double) - -instance Additive LPTerm where - zero = LPTerm 0 Map.empty - LPTerm c1 m1 + LPTerm c2 m2 = LPTerm (c1+c2) (Map.merge (+) m1 m2) - -instance Ring LPTerm where - one = LPTerm 1 Map.empty - neg (LPTerm c m) = LPTerm (-c) (map neg m) - LPTerm c1 m1 - LPTerm c2 m2 = LPTerm (c1-c2) (Map.merge (-) m1 m2) - - LPTerm c1 [] * LPTerm c2 m2 = LPTerm (c1*c2) (Map.merge (\x -> c1*x) m2) - LPTerm c1 m1 * LPTerm c2 [] = LPTerm (c1*c2) (Map.merge (\x -> c2*x) m1) - _ * _ = fail "Invalid expression: not linear." - - fromInteger i = LPTerm (fromInteger i) Map.empty - -data LPConstraint = LPConstraint String LPTerm - -(>==) :: LPTerm -> LPTerm -> String -> [LPConstraint] -(a >== b) name = [LPConstraint name (a-b)] - -(<==) :: LPTerm -> LPTerm -> String -> [LPConstraint] -(a <== b) name = [LPConstraint name (b-a)] - -*/ - -testi () = do - problem = newProblem () - a = newVar problem - b = newVar problem - 3 ** a + 4 ** b + 15 - -main = "OK" --- +import "Prelude" + +importJava "gnu.trove.map.hash.TIntFloatHashMap" where + data LMap + + @JavaName adjustOrPutValue + adjustLMap_ :: LMap -> Integer -> Float -> Float -> () + +@inline +adjustLMap :: LMap -> Integer -> Float -> () +adjustLMap m k v = adjustLMap_ m k v v + +data LPTerm = LPTerm (LMap -> Float -> ()) + +instance Additive LPTerm where + @inline + zero = LPTerm (\_ _ -> ()) + @inline + LPTerm a + LPTerm b = LPTerm (\m s -> do a m s ; b m s) + sum ts = LPTerm (\m s -> for ts (\(LPTerm t) -> t m s)) + +instance Ring LPTerm where + @inline + neg (LPTerm a) = LPTerm (\m s -> a m (-s)) + @inline + LPTerm a - LPTerm b = LPTerm (\m s -> do a m s ; b m (-s)) + @inline + fromInteger c = LPTerm (\m s -> adjustLMap m (-1) (fromInteger c*s)) + @inline + one = LPTerm (\m s -> adjustLMap m (-1) s) + _ * _ = fail "Multiplication is not supported." + +data LPProblem = LPProblem (Ref Integer) + +newProblem :: () -> LPProblem +newProblem _ = LPProblem (ref 0) + +newVar :: LPProblem -> LPTerm +newVar (LPProblem varCounter) = do + curId = getRef varCounter + varCounter := curId + 1 + LPTerm (\m s -> adjustLMap m curId s) + +infixl 7 (**) + +@inline +(**) :: Float -> LPTerm -> LPTerm +s0 ** LPTerm t = LPTerm (\m s -> t m (s0*s)) + +/* +data LPTerm = LPTerm Double (Map.T String Double) + +instance Additive LPTerm where + zero = LPTerm 0 Map.empty + LPTerm c1 m1 + LPTerm c2 m2 = LPTerm (c1+c2) (Map.merge (+) m1 m2) + +instance Ring LPTerm where + one = LPTerm 1 Map.empty + neg (LPTerm c m) = LPTerm (-c) (map neg m) + LPTerm c1 m1 - LPTerm c2 m2 = LPTerm (c1-c2) (Map.merge (-) m1 m2) + + LPTerm c1 [] * LPTerm c2 m2 = LPTerm (c1*c2) (Map.merge (\x -> c1*x) m2) + LPTerm c1 m1 * LPTerm c2 [] = LPTerm (c1*c2) (Map.merge (\x -> c2*x) m1) + _ * _ = fail "Invalid expression: not linear." + + fromInteger i = LPTerm (fromInteger i) Map.empty + +data LPConstraint = LPConstraint String LPTerm + +(>==) :: LPTerm -> LPTerm -> String -> [LPConstraint] +(a >== b) name = [LPConstraint name (a-b)] + +(<==) :: LPTerm -> LPTerm -> String -> [LPConstraint] +(a <== b) name = [LPConstraint name (b-a)] + +*/ + +testi () = do + problem = newProblem () + a = newVar problem + b = newVar problem + 3 ** a + 4 ** b + 15 + +main = "OK" +-- OK \ No newline at end of file