Verified Commit 1a9268df authored by Camil Staps's avatar Camil Staps 🙂

Add derived strictness information that was not exported yet

parent 2e427890
Pipeline #17441 passed with stage
in 3 minutes and 20 seconds
......@@ -12,10 +12,10 @@ foldrArr :: !(a .b -> .b) !.b !.(arr a) -> .b | Array arr a
foldrArrWithKey :: !(Int a -> .(.b -> .b)) !.b !.(arr a) -> .b | Array arr a
foldrUArr :: !(a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b *(arr a)
foldrUArr :: !(a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b !*(arr a)
-> *(.b, *(arr a)) | Array arr a
foldrUArrWithKey :: !(Int a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b *(arr a)
foldrUArrWithKey :: !(Int a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b !*(arr a)
-> *(.b, *(arr a)) | Array arr a
foldlArr :: !(.b a -> .b) !.b !.(arr a) -> .b | Array arr a
......@@ -33,8 +33,9 @@ appendArr :: !(arr a) !(arr a) -> arr a | Array arr a
instance +++ (arr a) | Array arr a
instance Functor {}, {!}
instance pure {}, {!}
instance pure {}
instance pure {!} where pure :: !a -> {!a}
instance <*> {}, {!}
instance Monad {}, {!}
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b !.(d c) -> b | Array d c
......@@ -32,11 +32,11 @@ foldrArrWithKey f b arr
#! (e, arr) = arr![idx]
= f idx e (foldrArr` arrSz (idx + 1) f b arr)
foldrUArr :: !(a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b *(arr a)
foldrUArr :: !(a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b !*(arr a)
-> *(.b, *(arr a)) | Array arr a
foldrUArr f b arr = foldrUArrWithKey (\_ -> f) b arr
foldrUArrWithKey :: !(Int a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b *(arr a)
foldrUArrWithKey :: !(Int a -> .(.b -> .(*(arr a) -> *(.b, *(arr a))))) .b !*(arr a)
-> *(.b, *(arr a)) | Array arr a
foldrUArrWithKey f b arr
# (sz, arr) = usize arr
......@@ -99,14 +99,13 @@ mapArr f arr
appendArr :: !(arr a) !(arr a) -> arr a | Array arr a
appendArr l r
#! szl = size l
#! szr = size r
#! totalSz = szl + szr
#! totalSz = szl + size r
| totalSz < 1 = l
| otherwise
#! el = if (szl > 0) l.[0] r.[0]
#! newArr = createArray totalSz el
#! newArr = addWithOffset totalSz 0 l newArr
#! newArr = addWithOffset totalSz (szl - 1) r newArr
# newArr = addWithOffset totalSz (szl - 1) r newArr
= newArr
where
addWithOffset totalSz offset oldArr newArr
......@@ -128,6 +127,7 @@ where
instance pure {!}
where
pure :: !a -> {!a}
pure x = {!x}
instance <*> {!}
......@@ -137,7 +137,7 @@ where
instance Monad {} where bind m k = foldrArr ((+++) o k) {} m
instance Monad {!} where bind m k = foldrArr ((+++) o k) {} m
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b !.(d c) -> b | Array d c
reduceArray f op e xs
= reduce f 0 (size xs) op e xs
where
......
......@@ -26,12 +26,12 @@ instance == DiffStatus
/**
* Recursively set the status in a Diff.
*/
setStatus :: DiffStatus Diff -> Diff
setStatus :: !DiffStatus !Diff -> Diff
/**
* Compute the {{`Diff`}} between two values.
*/
generic gDiff a :: a a -> [Diff]
generic gDiff a :: !a !a -> [Diff]
derive gDiff UNIT, PAIR, EITHER, OBJECT, CONS of d, RECORD of d, FIELD of d
derive gDiff Int, Char, Bool, Real, String
derive gDiff [], [!], [ !], [!!], {}, {!}
......
......@@ -23,10 +23,10 @@ where
== OnlyLeft OnlyLeft = True
== _ _ = False
setStatus :: DiffStatus Diff -> Diff
setStatus :: !DiffStatus !Diff -> Diff
setStatus s d = {d & status=s, children=map (setStatus s) d.children}
generic gDiff a :: a a -> [Diff]
generic gDiff a :: !a !a -> [Diff]
gDiff{|Int|} x y = eqDiff x y
gDiff{|Char|} x y = eqDiff x y
gDiff{|Bool|} x y = eqDiff x y
......
......@@ -3,7 +3,7 @@
definition module Data.Graph.Inductive.Graph
from Data.Maybe import :: Maybe
from StdOverloaded import class <, class ==
from StdOverloaded import class <, class ==, class toString
from StdClass import class Eq
from Data.GenLexOrd import generic gLexOrd, :: LexOrd
......
......@@ -56,13 +56,13 @@ where
foldr a b c = 'StdList'.foldr a b c
foldr` f x y = strictFoldr f x y
where
strictFoldr :: !(.a -> .(.b -> .b)) !.b ![.a] -> .b
strictFoldr :: (.a -> .(.b -> .b)) !.b ![.a] -> .b
strictFoldr _ b [] = b
strictFoldr f b [x:xs] = f x (strictFoldr f b xs)
foldl` f x y = strictFoldl f x y
where
strictFoldl :: !(.a -> .(.b -> .a)) !.a ![.b] -> .a
strictFoldl :: (.a -> .(.b -> .a)) !.a ![.b] -> .a
strictFoldl _ b [] = b
strictFoldl f b [x:xs] = strictFoldl f (f b x) xs
......
......@@ -41,13 +41,34 @@ instance Monoid ()
:: Last a = Last (Maybe a)
instance Semigroup (Dual a) | Semigroup a
where
mappend :: !(Dual a) !(Dual a) -> Dual a | Semigroup a
instance Semigroup (Endo .a)
where
mappend :: !(Endo .a) !(Endo .a) -> Endo .a
instance Semigroup All
where
mappend :: !All !All -> All
instance Semigroup Any
instance Semigroup (Sum a) | + a & zero a
instance Semigroup (Product a) | * a & one a
where
mappend :: !Any !Any -> Any
instance Semigroup (Sum a) | +, zero a
where
mappend :: !(Sum a) !(Sum a) -> Sum a | +, zero a
instance Semigroup (Product a) | *, one a
where
mappend :: !(Product a) !(Product a) -> Product a | *, one a
instance Semigroup (First a)
instance Semigroup (Last a)
where
mappend :: !(Last a) !(Last a) -> Last a
instance Monoid (Dual a) | Monoid a
instance Monoid (Endo .a)
......
......@@ -6,61 +6,86 @@ from StdFunc import o, id
from Data.Maybe import :: Maybe(..)
from StdList import ++
instance Semigroup () where
mappend _ _ = ()
instance Monoid () where
mempty = ()
instance Semigroup (Dual a) | Semigroup a where
mappend (Dual x) (Dual y) = Dual (mappend y x)
instance Monoid (Dual a) | Monoid a where
mempty = Dual mempty
instance Semigroup (Endo .a) where
mappend (Endo f) (Endo g) = Endo (f o g)
instance Monoid (Endo .a) where
mempty = Endo id
instance Semigroup All where
mappend (All x) (All y) = All (x && y)
instance Monoid All where
mempty = All True
instance Semigroup Any where
mappend (Any x) (Any y) = Any (x || y)
instance Monoid Any where
mempty = Any False
instance Semigroup (Sum a) | + a & zero a where
mappend (Sum x) (Sum y) = Sum (x + y)
instance Monoid (Sum a) | + a & zero a where
mempty = Sum zero
instance Semigroup (Product a) | * a & one a where
mappend (Product x) (Product y) = Product (x * y)
instance Monoid (Product a) | * a & one a where
mempty = Product one
instance Semigroup (First a) where
mappend r=:(First (Just _)) _ = r
mappend (First Nothing) r = r
instance Monoid (First a) where
mempty = First Nothing
instance Semigroup (Last a) where
mappend _ r=:(Last (Just _)) = r
mappend r (Last Nothing) = r
instance Monoid (Last a) where
mempty = Last Nothing
instance Semigroup ()
where
mappend _ _ = ()
instance Monoid ()
where
mempty = ()
instance Semigroup (Dual a) | Semigroup a
where
mappend :: !(Dual a) !(Dual a) -> Dual a | Semigroup a
mappend (Dual x) (Dual y) = Dual (mappend y x)
instance Monoid (Dual a) | Monoid a
where
mempty = Dual mempty
instance Semigroup (Endo .a)
where
mappend :: !(Endo .a) !(Endo .a) -> Endo .a
mappend (Endo f) (Endo g) = Endo (f o g)
instance Monoid (Endo .a)
where
mempty = Endo id
instance Semigroup All
where
mappend :: !All !All -> All
mappend (All x) (All y) = All (x && y)
instance Monoid All
where
mempty = All True
instance Semigroup Any
where
mappend :: !Any !Any -> Any
mappend (Any x) (Any y) = Any (x || y)
instance Monoid Any
where
mempty = Any False
instance Semigroup (Sum a) | +, zero a
where
mappend :: !(Sum a) !(Sum a) -> Sum a | +, zero a
mappend (Sum x) (Sum y) = Sum (x + y)
instance Monoid (Sum a) | + a & zero a
where
mempty = Sum zero
instance Semigroup (Product a) | *, one a
where
mappend :: !(Product a) !(Product a) -> Product a | *, one a
mappend (Product x) (Product y) = Product (x * y)
instance Monoid (Product a) | * a & one a
where
mempty = Product one
instance Semigroup (First a)
where
mappend r=:(First (Just _)) _ = r
mappend (First Nothing) r = r
instance Monoid (First a)
where
mempty = First Nothing
instance Semigroup (Last a)
where
mappend :: !(Last a) !(Last a) -> Last a
mappend _ r=:(Last (Just _)) = r
mappend r (Last Nothing) = r
instance Monoid (Last a)
where
mempty = Last Nothing
getDual :: !(Dual .a) -> .a
getDual (Dual x) = x
......
......@@ -25,9 +25,20 @@ instance Functor ((,,,,) a b c d)
instance Functor ((,,,,,) a b c d e)
instance Semigroup (a, b) | Semigroup a & Semigroup b
where
mappend :: !(a,b) !(a,b) -> (a,b) | Semigroup a & Semigroup b
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
where
mappend :: !(a,b,c) !(a,b,c) -> (a,b,c) | Semigroup a & Semigroup b & Semigroup c
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
where
mappend :: !(a,b,c,d) !(a,b,c,d) -> (a,b,c,d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
where
mappend :: !(a,b,c,d,e) !(a,b,c,d,e) -> (a,b,c,d,e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
instance Monoid (a, b) | Monoid a & Monoid b
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c
......
......@@ -56,6 +56,7 @@ where
instance Semigroup (a, b) | Semigroup a & Semigroup b
where
mappend :: !(a,b) !(a,b) -> (a,b) | Semigroup a & Semigroup b
mappend (a1, b1) (a2, b2) = (mappend a1 a2, mappend b1 b2)
instance Monoid (a, b) | Monoid a & Monoid b
......@@ -64,6 +65,7 @@ where
instance Semigroup (a, b, c) | Semigroup a & Semigroup b & Semigroup c
where
mappend :: !(a,b,c) !(a,b,c) -> (a,b,c) | Semigroup a & Semigroup b & Semigroup c
mappend (a1, b1, c1) (a2, b2, c2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2)
instance Monoid (a, b, c) | Monoid a & Monoid b & Monoid c
......@@ -72,6 +74,7 @@ where
instance Semigroup (a, b, c, d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
where
mappend :: !(a,b,c,d) !(a,b,c,d) -> (a,b,c,d) | Semigroup a & Semigroup b & Semigroup c & Semigroup d
mappend (a1, b1, c1, d1) (a2, b2, c2, d2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2)
instance Monoid (a, b, c, d) | Monoid a & Monoid b & Monoid c & Monoid d
......@@ -80,6 +83,7 @@ where
instance Semigroup (a, b, c, d, e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
where
mappend :: !(a,b,c,d,e) !(a,b,c,d,e) -> (a,b,c,d,e) | Semigroup a & Semigroup b & Semigroup c & Semigroup d & Semigroup e
mappend (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) = (mappend a1 a2, mappend b1 b2, mappend c1 c2, mappend d1 d2, mappend e1 e2)
instance Monoid (a, b, c, d, e) | Monoid a & Monoid b & Monoid c & Monoid d & Monoid e
......
......@@ -18,12 +18,12 @@
definition module MersenneTwister
genRandReal :: Int -> [Real]
genRandReal :: !Int -> [Real]
// Generates an infinite list of in [0, 1] uniformly distributed
// real pseudorandom numbers. There period is (2^19937)-1.
// Input any nonzero integer as seed value.
genRandInt :: Int -> [Int]
genRandInt :: !Int -> [Int]
// Generates an infinite list of in [-(2^31), (2^31)-1] uniformly distributed
// signed integer pseudorandom numbers. There period is (2^19937)-1.
// Input any nonzero integer as seed value.
......
......@@ -2,8 +2,8 @@ implementation module MersenneTwister
import qualified Math.Random
genRandReal :: Int -> [Real]
genRandReal :: !Int -> [Real]
genRandReal n = 'Math.Random'.genRandReal n
genRandInt :: Int -> [Int]
genRandInt :: !Int -> [Int]
genRandInt n = 'Math.Random'.genRandInt n
......@@ -5,10 +5,10 @@ from StdOverloaded import class toString, class ==
from Data.Maybe import :: Maybe
class ParseInput s where
parseInput :: s -> (Maybe Char, s)
parseInput :: !s -> (!Maybe Char, !s)
:: StringInput = { si_str :: !String, si_pos :: !Int}
mkStringInput :: String -> StringInput
mkStringInput :: !String -> StringInput
instance ParseInput StringInput
instance ParseInput File
......@@ -39,8 +39,8 @@ generic gParse a :: Expr -> Maybe a
derive gParse Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, CONS of d, RECORD of {grd_name}, FIELD of {gfd_name}, OBJECT of {gtd_num_conses,gtd_conses}, [], {!}, {}
preParseString :: String -> Expr
preParseFile :: File -> Expr
preParseString :: !String -> Expr
preParseFile :: !File -> Expr
parseString :: String -> Maybe a | gParse{|*|} a
parseFile :: File -> Maybe a | gParse{|*|} a
parseString :: !String -> Maybe a | gParse{|*|} a
parseFile :: !File -> Maybe a | gParse{|*|} a
......@@ -8,7 +8,7 @@ import Text
:: StringInput = { si_str :: !String, si_pos :: !Int}
mkStringInput :: String -> StringInput
mkStringInput :: !String -> StringInput
mkStringInput str = {si_str = str, si_pos = 0}
instance ParseInput StringInput where
......@@ -707,21 +707,21 @@ maybeAll [|Just x: mxs]
//----------------------------------------------------------------------------------
preParseInput :: s -> Expr | ParseInput s
preParseInput input
preParseInput :: !s -> Expr | ParseInput s
preParseInput input
# (expr, s) = preParse {ps_input=input, ps_char = Nothing, ps_tokens = [] }
= expr
preParseString :: String -> Expr
preParseString :: !String -> Expr
preParseString str = preParseInput {si_pos = 0, si_str = str}
preParseFile :: File -> Expr
preParseFile :: !File -> Expr
preParseFile file = preParseInput file
parseString :: String -> Maybe a | gParse{|*|} a
parseString :: !String -> Maybe a | gParse{|*|} a
parseString str = gParse{|*|} (preParseString str)
parseFile :: File -> Maybe a | gParse{|*|} a
parseFile :: !File -> Maybe a | gParse{|*|} a
parseFile file = gParse{|*|} (preParseFile file)
//Start = preParseString "{rec_field = A (B1, B2) (C D), rec_field2 = (X,Y)}"
......
......@@ -3,24 +3,24 @@ definition module Text.GenPrint
import StdGeneric
class PrintOutput s where
printOutput :: Char *s -> *s
printOutput :: !Char !*s -> *s
:: *StringOutput
:: PrintState s
mkPrintState :: *s -> PrintState *s | PrintOutput s
mkPrintState :: !*s -> PrintState *s | PrintOutput s
mkStringPrintState :: PrintState StringOutput
printToString :: a -> String | gPrint{|*|} a
printToString :: !a -> String | gPrint{|*|} a
(<<-) infixl 0 :: (PrintState *s) a -> *(PrintState *s)
(<<-) infixl 0 :: (PrintState *s) !a -> *(PrintState *s)
| gPrint{|*|} a & PrintOutput s
instance PrintOutput StringOutput
instance PrintOutput File
generic gPrint a :: a (PrintState *s) -> (PrintState *s) | PrintOutput s
generic gPrint a :: !a (PrintState *s) -> (PrintState *s) | PrintOutput s
derive gPrint Int, Real, Char, Bool, String, UNIT, PAIR, EITHER, RECORD of {grd_name}, FIELD of {gfd_name}, CONS of d, OBJECT of {gtd_num_conses,gtd_conses}, [], {!}, {}, (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
//derive bimap PrintState
......@@ -173,7 +173,7 @@ where
$ print_list f xs
//-------------------------------------------------------------------------------------
generic gPrint a :: a (PrintState *s) -> (PrintState *s) | PrintOutput s
generic gPrint a :: !a (PrintState *s) -> (PrintState *s) | PrintOutput s
gPrint{|Int|} x st
= printString (toString x) st
gPrint{|Real|} x st
......@@ -286,10 +286,10 @@ derive gPrint (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
//derive gOutput (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
//-------------------------------------------------------------------------------------
(<<-) infixl 0 :: (PrintState *s) a -> *(PrintState *s) | gPrint{|*|} a & PrintOutput s
(<<-) infixl 0 :: (PrintState *s) !a -> *(PrintState *s) | gPrint{|*|} a & PrintOutput s
(<<-) s x = gPrint{|*|} x s
mkPrintState :: *s -> PrintState *s | PrintOutput s
mkPrintState :: !*s -> PrintState *s | PrintOutput s
mkPrintState s =
{ ps_output = s
, ps_context = CtxNone
......@@ -304,7 +304,7 @@ openFilePrintState name fs
| ok = (Just (mkPrintState file), fs)
= (Nothing, fs)
printToString :: a -> String | gPrint{|*|} a
printToString :: !a -> String | gPrint{|*|} a
printToString x
# string_output = (mkStringPrintState <<- x).ps_output
= string_output.so_str % (0,string_output.so_pos-1)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment