Commit 7e7094f1 authored by thomie's avatar thomie

Testsuite: tabs -> spaces [skip ci]

parent 3dc12025
{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}
module PList1 where
-- Polymorphic lists 1: requires smart-app-res
module PList1 where
-- Polymorphic lists 1: requires smart-app-res
type Sid = forall a . a -> a
ids :: [Sid]
ids = []
ids :: [Sid]
ids = []
-- requires smart-app-res
test0 :: [Sid]
test0 = (\x->x) : ids
-- requires smart-app-res
test0 :: [Sid]
test0 = (\x->x) : ids
test1 :: [Sid] -- SLPJ added
test1 = ids ++ test0
test1 :: [Sid] -- SLPJ added
test1 = ids ++ test0
test2 :: [Sid]
test2 = tail test1
test2 :: [Sid]
test2 = tail test1
test3 :: [Sid] -- SLPJ added
test3 = reverse test2
test4 = (tail::([Sid]->[Sid])) test2
test3 :: [Sid] -- SLPJ added
test3 = reverse test2
test4 = (tail::([Sid]->[Sid])) test2
test5 = (head::([Sid]->Sid)) test2
\ No newline at end of file
test5 = (head::([Sid]->Sid)) test2
{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}
module PList2 where
module PList2 where
-- Polymorphic lists 2: require smart-app-arg & smart-app-res: Should fail w/o smart-app-arg
type Sid = forall a. a -> a
type Sid = forall a. a -> a
ids :: [Sid]
ids = []
ids :: [Sid]
ids = []
test0 :: [Sid]
test0 :: [Sid]
test0 = (\x -> x):ids -- requires smart-app-res
test1 :: [Sid] -- Added SLPJ
test1 = ids ++ test0
test1 :: [Sid] -- Added SLPJ
test1 = ids ++ test0
test2 :: [Sid]
test2 = tail test1 -- requires smart-app-arg
test2 = tail test1 -- requires smart-app-arg
test3 :: [Sid] -- Added SLPJ
test3 = reverse test2
test3 :: [Sid] -- Added SLPJ
test3 = reverse test2
test4 :: Sid
test4 = head ids --requires smart-app-arg
test5 :: Sid
test5 = head ids -- still requires smart-app-arg
test5 = head ids -- still requires smart-app-arg
......@@ -12,14 +12,14 @@ g :: Maybe (forall a. [a] -> a) -> (Int, Char)
g Nothing = (0, '0')
g (Just get) = (get [1,2], get ['a','b','c'])
sing x = [x]
sing x = [x]
id1 :: forall a. a -> a
id1 = id
{-
ids :: [forall a. a -> a]
ids = [id1,id1]
ids :: [forall a. a -> a]
ids = [id1,id1]
t1 :: [forall a. a -> a]
t1 = tail ids
......@@ -41,7 +41,7 @@ qG choose id = choose id
qH :: (forall a. a -> a -> a) -> (forall a. a -> a) -> (forall b. b -> b) -> (forall b. b -> b)
qH choose id = choose id
choose :: forall a. a -> a -> a
choose x y = x
......@@ -58,10 +58,10 @@ impred2 = id qF
--- all of these currently work in GHC with higher-rank types
self1 :: (forall a. a -> a) -> (forall a. a -> a)
self1 f = f f
self1 f = f f
self2 :: (forall a. a -> a) -> b -> b
self2 f = f f
self2 f = f f
gr1 = self1 id
......@@ -109,8 +109,8 @@ fixMT :: (MapTree -> MapTree) -> MapTree
fixMT f = f (fixMT f)
mapTree' = fixMT (\ (mapTree :: MapTree) -> \f tree -> case tree of
Branch a t -> Branch (f a) (mapTree (cross f) t)
Leaf -> Leaf)
Branch a t -> Branch (f a) (mapTree (cross f) t)
Leaf -> Leaf)
-- polymorphic fix
fix :: (a -> a) -> a
......@@ -119,6 +119,6 @@ fix f = f (fix f)
-- mapTree'' :: MapTree
mapTree'' = (fix :: (MapTree -> MapTree) -> MapTree)
(\ mapTree -> \f tree -> case tree of
Branch a t -> Branch (f a) (mapTree (cross f) t)
Leaf -> Leaf)
(\ mapTree -> \f tree -> case tree of
Branch a t -> Branch (f a) (mapTree (cross f) t)
Leaf -> Leaf)
......@@ -8,25 +8,25 @@ main =
solutions = queens 8
queens :: Int -> [[Int]]
queens n = valid n n
queens n = valid n n
valid :: Int -> Int -> [[Int]]
valid 0 n = [[]]
valid m n = filter safe (extend n (valid (m-1) n))
valid m n = filter safe (extend n (valid (m-1) n))
extend n b = cp (fromTo 1 n) b
extend n b = cp (fromTo 1 n) b
cp :: [a] -> [[a]] -> [[a]]
cp [] y = []
cp (a:x) y = map (a:) y ++ cp x y
cp (a:x) y = map (a:) y ++ cp x y
safe (a:b) = no_threat a b 1
no_threat a [] m = True
no_threat a (b:y) m =
a /= b && a+m /= b && a-m /= b && no_threat a y (m+1)
a /= b && a+m /= b && a-m /= b && no_threat a y (m+1)
board :: [Int] -> String
board :: [Int] -> String
board b =
unlines (concat (zipWith rank (from 1) b))
where
......@@ -34,12 +34,12 @@ board b =
map line ["o o o", " \\|/ ", " === "]
where
line crown_slice =
concat (zipWith square (from 1) b)
concat (zipWith square (from 1) b)
where
square scol _ =
if scol == qcol then crown_slice
else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then "....."
else " "
square scol _ =
if scol == qcol then crown_slice
else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then "....."
else " "
-- in place of ..
......
......@@ -6,57 +6,57 @@
-- The count monad
type M a = (a, Int)
type M a = (a, Int)
unit :: a -> M a
unit a = (a, 0)
unit :: a -> M a
unit a = (a, 0)
bind :: M a -> (a -> M b) -> M b
m `bind` k = case m of
(a,i) -> case k a of
bind :: M a -> (a -> M b) -> M b
m `bind` k = case m of
(a,i) -> case k a of
(b,j) -> (b,i+j)
-- disp :: Text a => M a -> String
disp (a,i) = show a ++ "\nCount: " ++ show i
-- disp :: Text a => M a -> String
disp (a,i) = show a ++ "\nCount: " ++ show i
tick :: M ()
tick = ((), 1)
tick :: M ()
tick = ((), 1)
-- The evaluator
-- Lines with * are only change from evalIdent
data Op = Add | Sub | Mul | Quo
data Term = Con Int | Bin Op Term Term
data Op = Add | Sub | Mul | Quo
data Term = Con Int | Bin Op Term Term
eval :: Term -> M Int
eval (Con i) = unit i
eval (Bin op u v) = eval u `bind` (\a ->
eval v `bind` (\b ->
go op a b `bind` (\c -> -- *
tick `bind` (\ () -> -- *
unit c)))) -- *
eval :: Term -> M Int
eval (Con i) = unit i
eval (Bin op u v) = eval u `bind` (\a ->
eval v `bind` (\b ->
go op a b `bind` (\c -> -- *
tick `bind` (\ () -> -- *
unit c)))) -- *
go :: Op -> Int -> Int -> M Int
go Add a b = unit (a+b)
go Sub a b = unit (a-b)
go Mul a b = unit (a*b)
go Quo a b = unit (a `quot` b) -- WDP: was "div"
go :: Op -> Int -> Int -> M Int
go Add a b = unit (a+b)
go Sub a b = unit (a-b)
go Mul a b = unit (a*b)
go Quo a b = unit (a `quot` b) -- WDP: was "div"
test :: Term -> String
test t = disp (eval t)
test :: Term -> String
test t = disp (eval t)
-- Test data
add, sub, mul, quo :: Term -> Term -> Term
u `add` v = Bin Add u v
u `sub` v = Bin Sub u v
u `mul` v = Bin Mul u v
u `quo` v = Bin Quo u v
add, sub, mul, quo :: Term -> Term -> Term
u `add` v = Bin Add u v
u `sub` v = Bin Sub u v
u `mul` v = Bin Mul u v
u `quo` v = Bin Quo u v
term0,term1,term2 :: Term
term0 = Con 6 `mul` Con 9
term1 = (Con 4 `mul` Con 13) `add` Con 2
term2 = (Con 1 `quo` Con 2) `add` Con 2
term0,term1,term2 :: Term
term0 = Con 6 `mul` Con 9
term1 = (Con 4 `mul` Con 13) `add` Con 2
term2 = (Con 1 `quo` Con 2) `add` Con 2
term3 = ((((((((((((((((((((((((((((((((
((((((((((((((((((((((((((((((
Con 7777 `mul` Con 13) `quo` Con 13)
......
......@@ -33,10 +33,10 @@ instance Signal SignalRep where
toSig = id
instance (Physical a, Physical b) => Eq (a -> b) where
a == b = error "Attempt to apply equality to functions"
binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
(a -> b) -> (a -> b) -> a -> b
binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
unop:: (Physical a, Physical b ) => (Float -> Float) ->
unop:: (Physical a, Physical b ) => (Float -> Float) ->
(a -> b) -> a -> b
unop op f t = toPhysical (op (fromPhysical (f t)))
instance (Physical a, Physical b) => Num (SignalRep a b) where
......@@ -47,11 +47,11 @@ instance (Physical a, Physical b) => Num (SignalRep a b) where
signum f = FunctionRep (unop abs (mapSignal f))
fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
--fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
instance (Physical a, Physical b) =>
instance (Physical a, Physical b) =>
Fractional (SignalRep a b) where
f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
instance (Physical a, Physical b) =>
instance (Physical a, Physical b) =>
Floating (SignalRep a b) where
pi = FunctionRep (\t -> (toPhysical pi))
exp f = FunctionRep (unop exp (mapSignal f))
......@@ -67,7 +67,7 @@ instance (Physical a, Physical b) =>
acosh f = FunctionRep (unop acosh (mapSignal f))
atanh f = FunctionRep (unop atanh (mapSignal f))
data Event =
TimeEvent Float |
TimeEvent Float |
FunctionEvent (Float -> Bool) |
BurstEvent Int Event
......@@ -82,7 +82,7 @@ instance Eq Event where
eventOccurs:: Event -> Float -> Float
eventOccurs (TimeEvent t) x = if x < t then x else t
eventOccurs (FunctionEvent f) x = stepEval f x
eventOccurs (BurstEvent i e) x =
eventOccurs (BurstEvent i e) x =
if i == 1 then
eventOccurs e x
else
......@@ -90,7 +90,7 @@ eventOccurs (BurstEvent i e) x =
stepEval:: (Float -> Bool) -> Float -> Float
stepEval f x = if f x then x else stepEval f (x + eventEps x)
data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
data {- (Physical a, Physical b) => -} FunctionWindow a b =
data {- (Physical a, Physical b) => -} FunctionWindow a b =
Window ZeroIndicator Event (SignalRep a b)
deriving (Eq, Show)
data PieceCont a b = Windows [FunctionWindow a b]
......@@ -100,43 +100,43 @@ instance Signal PieceCont where
mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
toSig = PieceContRep
getWindow:: (Physical a, Physical b) =>
Float -> Float -> [ FunctionWindow a b ] ->
getWindow:: (Physical a, Physical b) =>
Float -> Float -> [ FunctionWindow a b ] ->
(Float, FunctionWindow a b, [ FunctionWindow a b ])
getWindow st t [] = (t, Window LocalZero e f, [])
where e = TimeEvent (realmul 2 t)
f = FunctionRep (\t -> toPhysical 0.0)
getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
else getWindow (st+wt) t wl
where wt = eventOccurs e t'
(Window z e s) = w
t' = if z == LocalZero then t-st else t
(|>) :: (Physical a, Physical b) => FunctionWindow a b ->
(|>) :: (Physical a, Physical b) => FunctionWindow a b ->
PieceCont a b -> PieceCont a b
w |> (Windows wl) = Windows (w:wl)
nullWindow = Windows []
cycleWindows:: (Physical a, Physical b) =>
cycleWindows:: (Physical a, Physical b) =>
PieceCont a b -> PieceCont a b
cycleWindows (Windows wl) = Windows (cycle wl)
constant:: (Physical a, Physical b) => b -> SignalRep a b
constant x = FunctionRep (\t -> x)
linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
linear m b = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
sine:: (Physical a, Physical b) =>
sine:: (Physical a, Physical b) =>
b -> Frequency -> Float -> SignalRep a b
sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
waveform samp ampls =
let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
(linear (stepSlope v v') v)
points = cycle ampls
in PieceContRep (Windows (map makeWin (zip points (tail points))))
random:: (Physical a, Physical b) =>
random:: (Physical a, Physical b) =>
Integer -> a -> SignalRep a b
random i s = waveform s (map toPhysical (rand i))
ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
ramp per v =
ramp per v =
let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
......@@ -163,7 +163,7 @@ pulse st wid lvl =
f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
in FunctionRep f
trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
SignalRep a b
trap st r wid f lvl =
let stepSlope y y' t = realdiv (y' - y) (fromPhysical t)
......@@ -226,7 +226,7 @@ pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
amplitude = toPhysical 0.0}
-}
makeWin:: (Physical a, Physical b) => a -> a ->
makeWin:: (Physical a, Physical b) => a -> a ->
SignalRep a b -> SignalRep a b
makeWin st wid sig =
let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
......@@ -238,7 +238,7 @@ instance Signal BasicSignal where
let ring = sine ringing oscillation 0.0
cond = asTypeOf (expc damp_fac) ring
sig = temp ring cond
temp:: (Physical a, Physical b) => SignalRep a b ->
temp:: (Physical a, Physical b) => SignalRep a b ->
SignalRep a b -> SignalRep a b
temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
-- temp f g = f * g
......@@ -249,21 +249,21 @@ instance Signal BasicSignal where
in PieceContRep wins
toSig Pulse_dc{ start_delay = start_delay
, rise_time = rise_time
, pulse_width = pulse_width
, fall_time = fall_time
, dc_offset = dc_offset
, period = period
, amplitude = amplitude
, over = over
, under = under
} =
, pulse_width = pulse_width
, fall_time = fall_time
, dc_offset = dc_offset
, period = period
, amplitude = amplitude
, over = over
, under = under
} =
let pul = trap start_delay rise_time pulse_width fall_time amplitude
so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))
oversh = toSig over{start_delay=so}
undersh = toSig under{start_delay=su}
off = constant dc_offset
temp:: (Physical a, Physical b) => SignalRep a b ->
temp:: (Physical a, Physical b) => SignalRep a b ->
SignalRep a b -> SignalRep a b
temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
sig = temp (temp (temp pul oversh) undersh) off
......@@ -272,13 +272,13 @@ instance Signal BasicSignal where
in PieceContRep (cycleWindows wins)
sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
(s a b) -> (s' a b) -> SignalRep a b
sumSig f f' =
sumSig f f' =
let s1 t = fromPhysical (mapSignal f t)
s2 t = fromPhysical (mapSignal f' t)
in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
(s a b) -> (s' a b) -> SignalRep a b
mulSig f f' =
mulSig f f' =
let f1 t = fromPhysical (mapSignal f t)
f2 t = fromPhysical (mapSignal f' t)
in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))
......
......@@ -6,12 +6,12 @@
land_i, lnot_i, lor_i, lshift_i, rshift_i,
descr,
destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {
import Data.Bits;
import Data.Bits;
-- import Word2;
import Data.Word;
import Data.Complex; -- 1.3
import Data.Array; -- 1.3
-- import Data.Int ( Num(fromInt) );
import Data.Complex; -- 1.3
import Data.Array; -- 1.3
-- import Data.Int ( Num(fromInt) );
type Complex_type = Complex Double;
type Array_type b = Array Int b;
type Assoc_type a = (Int, a);
......
......@@ -4,10 +4,10 @@
-- which is included in the distribution.
module CSG(module Construct,
module Geometry,
module Intersections,
module Interval,
module Misc) where
module Geometry,
module Intersections,
module Interval,
module Misc) where
import Construct
import Geometry
......
......@@ -69,7 +69,7 @@ data CSG a
-- the a is application-specific texture information
type Texture a = (Face, Point, a)
union, intersect, difference :: CSG a -> CSG a -> CSG a
union, intersect, difference :: CSG a -> CSG a -> CSG a
union p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Union p q)
union p q = Union p q
......@@ -85,25 +85,25 @@ difference p q = Difference p q
mkBox b p = Box b p
plane, sphere, cube, cylinder, cone :: a -> CSG a
plane, sphere, cube, cylinder, cone :: a -> CSG a
plane = Plane
sphere s =
mkBox (B (-1 - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Sphere s)
(-1 - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Sphere s)
cone s =
mkBox (B (-1 - epsilon) (1 + epsilon)
( - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Cone s)
( - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Cone s)
cube s =
mkBox (B (- epsilon) (1 + epsilon)
(- epsilon) (1 + epsilon)
(- epsilon) (1 + epsilon)) (Cube s)
(- epsilon) (1 + epsilon)
(- epsilon) (1 + epsilon)) (Cube s)
cylinder s =
mkBox (B (-1 - epsilon) (1 + epsilon)
( - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Cylinder s)
( - epsilon) (1 + epsilon)
(-1 - epsilon) (1 + epsilon)) (Cylinder s)
----------------------------
-- Object transformations
......@@ -120,16 +120,16 @@ transform mm' (Difference p q) = Difference (transform mm' p) (trans
transform mm'@(m,_) (Box box p) = Box (transformBox m box) (transform mm' p)
transform (m, m') prim = Transform m m' prim
translate :: Coords -> CSG a -> CSG a
translateX, translateY, translateZ :: Double -> CSG a -> CSG a
translate :: Coords -> CSG a -> CSG a
translateX, translateY, translateZ :: Double -> CSG a -> CSG a
translate xyz = transform $ transM xyz
translateX x = translate (x, 0, 0)
translateY y = translate (0, y, 0)
translateZ z = translate (0, 0, z)
scale :: Coords -> CSG a -> CSG a
scaleX, scaleY, scaleZ, uscale :: Double -> CSG a -> CSG a
scale :: Coords -> CSG a -> CSG a
scaleX, scaleY, scaleZ, uscale :: Double -> CSG a -> CSG a
scale xyz = transform $ scaleM xyz
scaleX x = scale (x, 1, 1)
......@@ -137,7 +137,7 @@ scaleY y = scale (1, y, 1)
scaleZ z = scale (1, 1, z)
uscale u = scale (u,u,u)
rotateX, rotateY, rotateZ :: Radian -> CSG a -> CSG a
rotateX, rotateY, rotateZ :: Radian -> CSG a -> CSG a
rotateX a = transform $ rotxM a
rotateY a = transform $ rotyM a