1 {- 2 This module defines a Normal cless and a function normal 3 used for forcing evaluation. The idea is originally 4 from Colin and has been modified to do recursive 5 force evaluation. To prevent repeated force, the 6 expression to be forced should be packed with a flag 7 indicating if a force has been done. Functions 8 which support this idea are provided. 9 10 XZ, 19/2/92 11 -} 12 13 module Norm where 14 15 {- 16 class Normal 17 -} 18 19 infixr 3 `andAnd` -- partain 20 andAnd a b = if a then 21 if b then True 22 else error "andAnd: 2nd argument not True" 23 else 24 error "andAnd: first argument not True\n" 25 -- end partain 26 27 data (Normal a) => Norm_able a = Norm_pack Bool a deriving () 28 29 class Normal a where 30 normal :: a -> Bool 31 32 instance (Normal a) => Normal [a] where 33 normal (x:xs) = normal x `andAnd` normal xs 34 normal _ = True 35 36 instance (Normal a, Normal b) => Normal (a,b) where 37 normal (x,y) = normal x `andAnd` normal y 38 39 instance (Normal a, Normal b, Normal c) => Normal (a,b,c) where 40 normal (x,y,z) = normal x `andAnd` normal y `andAnd` normal z 41 42 instance 43 (Normal a, Normal b, Normal c, 44 Normal d, Normal e, Normal f) => 45 Normal (a,b,c,d,e,f) where 46 normal (x,y,z,u,v,w) = 47 normal x `andAnd` normal y `andAnd` normal z `andAnd` 48 normal u `andAnd` normal v `andAnd` normal w 49 50 {- not in 1.3: 51 instance (Normal a, Normal b) => 52 Normal (Assoc a b) where 53 normal (i:=v) = normal i `andAnd` normal v 54 -} 55 56 instance Normal Bool where 57 normal True = True 58 normal _ = True 59 60 instance Normal Int where 61 normal 0 = True 62 normal _ = True 63 64 instance Normal Float where 65 normal 0 = True 66 normal _ = True 67 68 instance Normal Double where 69 normal 0 = True 70 normal _ = True 71 72 {- 73 instance Normal ( a -> b ) where 74 normal _ = True 75 -} 76 77 pack_obj obj = Norm_pack (normal obj) obj 78 79 normalize_obj (Norm_pack b _) = b 80 81 retrieve_obj (Norm_pack _ obj) = obj