diff --git a/Readme b/Readme new file mode 100644 index 0000000..33dc999 --- /dev/null +++ b/Readme @@ -0,0 +1,17 @@ + +--------------------------------------------------------------------+ + | | + | This is the Readme file for Gofer version 2.30: Please read the | + | documentation supplied in src/Readme before compiling this version | + | of Gofer on your machine and consult the documentation in the docs | + | directory before using the system. | + | | + | If you would like to keep upto date with future developments, | + | bugfixes and enhancements to Gofer and have not already contacted | + | me, please send mail to me and I will add your name to the | + | mailing list. | + | | + | ANY COMMENTS **GRATEFULLY** RECEIVED !!!! THANKS !!!! | + | | + | Enjoy! Until mid-July 1994: jones-mark@cs.yale.edu | + | Mark From Sept/Oct 1994: mpj@cs.nott.ac.uk | + +--------------------------------------------------------------------+ diff --git a/array.gs b/array.gs new file mode 100644 index 0000000..0959875 --- /dev/null +++ b/array.gs @@ -0,0 +1,106 @@ +------------------------------------------------------------------------------- +-- This file contains a Gofer implementation of the Haskell array datatype +-- using new Gofer primitives added in Gofer 2.30. +-- +-- This file requires the standard, or cc prelude. +-- You will not be able to use this file unless the version of Gofer that +-- is installed on your machine has been compiled with the HASKELL_ARRAYS +-- flag set to 1. +-- +-- Based on the standard prelude for Haskell 1.2. +-- Mark P Jones, 1994 +------------------------------------------------------------------------------- + +module PreludeArray( Array, Assoc((:=)), array, listArray, (!), bounds, + indices, elems, assocs, accumArray, (//), accum, amap, + ixmap + ) where + +infixl 9 ! +infixl 9 // +infix 1 := + +-- Associations: Frankly, any pair type would do just as well ... ------------ + +data Assoc a b = a := b + +instance (Eq a, Eq b) => Eq (Assoc a b) where + (x := y) == (u := v) = x==u && y==v + +instance (Ord a, Ord b) => Ord (Assoc a b) where + (x := y) <= (u := v) = x Text (Assoc a b) where + showsPrec d (x := y) + = if d > 1 then showChar '(' . s . showChar ')' + else s + where s = showsPrec 2 x . showString " := " . showsPrec 2 y + +-- Array primitives: ---------------------------------------------------------- + +array :: Ix a => (a,a) -> [Assoc a b] -> Array a b +listArray :: Ix a => (a,a) -> [b] -> Array a b +(!) :: Ix a => Array a b -> a -> b +bounds :: Ix a => Array a b -> (a,a) +indices :: Ix a => Array a b -> [a] +elems :: Ix a => Array a b -> [b] +assocs :: Ix a => Array a b -> [Assoc a b] +accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b +(//) :: Ix a => Array a b -> [Assoc a b] -> Array a b +accum :: Ix a => (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b +amap :: Ix a => (b -> c) -> Array a b -> Array a c +ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c + +instance (Ix a, Eq [Assoc a b]) => Eq (Array a b) where + a == a' = assocs a == assocs a' + +instance (Ix a, Ord [Assoc a b]) => Ord (Array a b) where + a <= a' = assocs a <= assocs a' + +instance (Ix a, Text (a,a), Text [Assoc a b]) => Text (Array a b) where + showsPrec p a = if (p>9) then showChar '(' . s . showChar ')' else s + where s = showString "array " . + shows (bounds a) . + showChar ' ' . + shows (assocs a) + +-- Implementation: ------------------------------------------------------------ + +primitive primArray "primArray" + :: (a -> Int) -> (a,a) -> [Assoc a b] -> Array a b +primitive primUpdate "primUpdate" + :: (a -> Int) -> Array a b -> [Assoc a b] -> Array a b +primitive primAccum "primAccum" + :: (a -> Int) -> (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b +primitive primAccumArray "primAccumArray" + :: (a -> Int) -> (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b +primitive primBounds "primBounds" :: Array a b -> (a,a) +primitive primElems "primElems" :: Array a b -> [b] +primitive primSubscript "primSubscript" :: (a -> Int) -> Array a b -> a -> b +primitive primAmap "primAmap" :: (b -> c) -> Array a b -> Array a c + +array bounds assocs = primArray (index bounds) bounds assocs +listArray b vs = array b (zipWith (:=) (range b) vs) +(!) a = primSubscript (index (bounds a)) a +bounds = primBounds +indices = range . bounds +elems = primElems +assocs a = zipWith (:=) (indices a) (elems a) +accumArray f z b = primAccumArray (index b) f z b +a // as = primUpdate (index (bounds a)) a as +accum f a = primAccum (index (bounds a)) f a +amap = primAmap +ixmap b f a = array b [ i := (a ! f i) | i <- range b ] + +instance (Ix a, Ix b) => Ix (a,b) where + range ((l,l'),(u,u')) + = [ (i,i') | i <- range (l,u), i' <- range (l',u') ] + index ((l,l'),(u,u')) (i,i') + = index (l,u) i * rangeSize (l',u') + index (l',u') i' + inRange ((l,l'),(u,u')) (i,i') + = inRange (l,u) i && inRange (l',u') i' + +rangeSize :: (Ix a) => (a,a) -> Int +rangeSize r@(l,u) = index r u + 1 + +------------------------------------------------------------------------------- diff --git a/cc.prelude b/cc.prelude new file mode 100644 index 0000000..8421a53 --- /dev/null +++ b/cc.prelude @@ -0,0 +1,917 @@ +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.30 +-- Copyright Mark P Jones 1991-1994. +-- +-- Enhanced prelude for use of overloading with constructor classes. +-- Based on the Haskell standard prelude version 1.2. + +help = "press :? for a list of commands" + +-- Operator precedence table: ----------------------------------------------- + +infixl 9 !! +infixr 9 ., @@ +infixr 8 ^ +infixl 7 * +infix 7 /, `div`, `quot`, `rem`, `mod` +infixl 6 +, - +infix 5 \\ +infixr 5 ++, : +infix 4 ==, /=, <, <=, >=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +infixr 0 $ + +-- Standard combinators: ---------------------------------------------------- + +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b -- pronounced as `apply' elsewhere +f $ x = f x + +-- Boolean functions: ------------------------------------------------------- + +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True + +-- Character functions: ----------------------------------------------------- + +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' + +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c + +minChar, maxChar :: Char +minChar = chr 0 +maxChar = chr 255 + +-- Standard type classes: --------------------------------------------------- + +class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +class Ord a => Ix a where + range :: (a,a) -> [a] + index :: (a,a) -> a -> Int + inRange :: (a,a) -> a -> Bool + +class Ord a => Enum a where + enumFrom :: a -> [a] -- [n..] + enumFromThen :: a -> a -> [a] -- [n,m..] + enumFromTo :: a -> a -> [a] -- [n..m] + enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] + + enumFromTo n m = takeWhile (m>=) (enumFrom n) + enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m) + (enumFromThen n n') + +class (Eq a, Text a) => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +-- Type class instances: ---------------------------------------------------- + +primitive primEqInt "primEqInt", + primLeInt "primLeInt" :: Int -> Int -> Bool +primitive primPlusInt "primPlusInt", + primMinusInt "primMinusInt", + primDivInt "primDivInt", + primMulInt "primMulInt" :: Int -> Int -> Int +primitive primNegInt "primNegInt" :: Int -> Int + +instance Eq () where () == () = True +instance Ord () where () <= () = True + +instance Eq Int where (==) = primEqInt + +instance Ord Int where (<=) = primLeInt + +instance Ix Int where + range (m,n) = [m..n] + index b@(m,n) i + | inRange b i = i - m + | otherwise = error "index out of range" + inRange (m,n) i = m <= i && i <= n + +instance Enum Int where + enumFrom n = iterate (1+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + +{- PC version off -} +primitive primEqFloat "primEqFloat", + primLeFloat "primLeFloat" :: Float -> Float -> Bool +primitive primPlusFloat "primPlusFloat", + primMinusFloat "primMinusFloat", + primDivFloat "primDivFloat", + primMulFloat "primMulFloat" :: Float -> Float -> Float +primitive primNegFloat "primNegFloat" :: Float -> Float +primitive primIntToFloat "primIntToFloat" :: Int -> Float + +instance Eq Float where (==) = primEqFloat + +instance Ord Float where (<=) = primLeFloat + +instance Enum Float where + enumFrom n = iterate (1.0+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +primitive sin "primSinFloat", asin "primAsinFloat", + cos "primCosFloat", acos "primAcosFloat", + tan "primTanFloat", atan "primAtanFloat", + log "primLogFloat", log10 "primLog10Float", + exp "primExpFloat", sqrt "primSqrtFloat" :: Float -> Float +primitive atan2 "primAtan2Float" :: Float -> Float -> Float +primitive truncate "primFloatToInt" :: Float -> Int + +pi :: Float +pi = 3.1415926535 + +{- PC version on -} + +primitive primEqChar "primEqChar", + primLeChar "primLeChar" :: Char -> Char -> Bool + +instance Eq Char where (==) = primEqChar -- c == d = ord c == ord d + +instance Ord Char where (<=) = primLeChar -- c <= d = ord c <= ord d + +instance Ix Char where + range (c,c') = [c..c'] + index b@(m,n) i + | inRange b i = ord i - ord m + | otherwise = error "index out of range" + inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci + +instance Enum Char where + enumFrom c = map chr [ord c .. ord maxChar] + enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar] + where lastChar = if c' < c then minChar else maxChar + +instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +instance Ord a => Ord [a] where + [] <= _ = True + (_:_) <= [] = False + (x:xs) <= (y:ys) = x Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + +instance (Ord a, Ord b) => Ord (a,b) where + (x,y) <= (u,v) = x Int -> Int + +subtract :: Num a => a -> a -> a +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Num a => a -> Int -> a +x ^ 0 = fromInteger 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`quot`2) + | otherwise = f x (n-1) (x*y) + +abs :: (Num a, Ord a) => a -> a +abs x | x>=fromInteger 0 = x + | otherwise = -x + +signum :: (Num a, Ord a) => a -> Int +signum x + | x==fromInteger 0 = 0 + | x> fromInteger 0 = 1 + | otherwise = -1 + +sum, product :: Num a => [a] -> a +sum = foldl' (+) (fromInteger 0) +product = foldl' (*) (fromInteger 1) + +sums, products :: Num a => [a] -> [a] +sums = scanl (+) (fromInteger 0) +products = scanl (*) (fromInteger 1) + +-- Constructor classes: ----------------------------------------------------- + +class Functor f where + map :: (a -> b) -> (f a -> f b) + +class Functor m => Monad m where + result :: a -> m a + join :: m (m a) -> m a + bind :: m a -> (a -> m b) -> m b + + join x = bind x id + x `bind` f = join (map f x) + +class Monad m => Monad0 m where + zero :: m a + +class Monad0 c => MonadPlus c where + (++) :: c a -> c a -> c a + +class (Functor left, Functor right) => Adjoint left right where + univ :: (a -> right b) -> (left a -> b) + unit :: a -> right (left a) + couniv :: (left a -> b) -> (a -> right b) + counit :: left (right a) -> a + + unit = couniv id + counit = univ id + univ g = counit . map g + couniv g = map g . unit + +class (Functor f, Functor g) => NatTransf f g where + eta :: f a -> g a + +-- Monad based utilities: --------------------------------------------------- + +apply :: Monad m => (a -> m b) -> (m a -> m b) +apply = flip bind + +(@@) :: Monad m => (a -> m b) -> (c -> m a) -> (c -> m b) +f @@ g = join . map f . g + +concat :: MonadPlus c => [c a] -> c a +concat = foldr (++) zero + +filter :: Monad0 m => (a -> Bool) -> m a -> m a +filter p xs = [ x | x<-xs, p x ] + +mfoldl :: Monad m => (a -> b -> m a) -> a -> [b] -> m a +mfoldl f a [] = result a +mfoldl f a (x:xs) = f a x `bind` (\fax -> mfoldl f fax xs) + +mfoldr :: Monad m => (a -> b -> m b) -> b -> [a] -> m b +mfoldr f a [] = result a +mfoldr f a (x:xs) = mfoldr f a xs `bind` (\y -> f x y) + +mapl :: Monad m => (a -> m b) -> ([a] -> m [b]) +mapl f [] = [ [] ] +mapl f (x:xs) = [ y:ys | y <- f x, ys <- mapl f xs ] + +mapr :: Monad m => (a -> m b) -> ([a] -> m [b]) +mapr f [] = [ [] ] +mapr f (x:xs) = [ y:ys | ys <- mapr f xs, y <- f x ] + +-- The monad of lists: ------------------------------------------------------ + +instance Functor [] where map f [] = [] + map f (x:xs) = f x : map f xs + +instance Monad [] where result x = [x] + [] `bind` f = [] + (x:xs) `bind` f = f x ++ (xs `bind` f) + +instance Monad0 [] where zero = [] + +instance MonadPlus [] where [] ++ ys = ys + (x:xs) ++ ys = x : (xs ++ ys) + +-- Standard list processing functions: -------------------------------------- + +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [] +init (x:xs) = x : init xs + +genericLength :: Num a => [b] -> a -- calculate length of list +genericLength = foldl' (\n _ -> n + fromInteger 1) (fromInteger 0) + +length :: [a] -> Int +length = foldl' (\n _ -> n + 1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: Eq a => [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: Eq a => a -> [a] -> Bool +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: Ord a => [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a]. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs + +-- List breaking functions: +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws + +-- Merging and sorting lists: + +merge :: Ord a => [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: Ord a => [a] -> [a] +sort = foldr insert [] + +insert :: Ord a => a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: Ord a => [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] + +-- zip and zipWith families of functions: + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) + +-- Formatted output: -------------------------------------------------------- + +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show' :: a -> String +show' x = primPrint 0 x [] + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs + +-- Miscellaneous: ----------------------------------------------------------- + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +primitive error "primError" :: String -> a + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x + +-- A trimmed down version of the Haskell Text class: ------------------------ + +type ShowS = String -> String + +class Text a where + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + + showsPrec = primPrint + showList [] = showString "[]" + showList (x:xs) = showChar '[' . shows x . showl xs + where showl [] = showChar ']' + showl (x:xs) = showChar ',' . shows x . showl xs + +shows :: Text a => a -> ShowS +shows = showsPrec 0 + +show :: Text a => a -> String +show x = shows x "" + +showChar :: Char -> ShowS +showChar = (:) + +showString :: String -> ShowS +showString = (++) + +instance Text () where + showsPrec d () = showString "()" + +instance Text Bool where + showsPrec d True = showString "True" + showsPrec d False = showString "False" + +primitive primShowsInt "primShowsInt" :: Int -> Int -> String -> String +instance Text Int where showsPrec = primShowsInt + +{- PC version off -} +primitive primShowsFloat "primShowsFloat" :: Int -> Float -> String -> String +instance Text Float where showsPrec = primShowsFloat +{- PC version on -} + +instance Text Char where + showsPrec p c = showString [q, c, q] where q = '\'' + showList cs = showChar '"' . showl cs + where showl "" = showChar '"' + showl ('"':cs) = showString "\\\"" . showl cs + showl (c:cs) = showChar c . showl cs + -- Haskell has showLitChar c . showl cs + +instance Text a => Text [a] where + showsPrec p = showList + +instance (Text a, Text b) => Text (a,b) where + showsPrec p (x,y) = showChar '(' . shows x . showChar ',' . + shows y . showChar ')' + +-- I/O functions and definitions: ------------------------------------------- + +stdin = "stdin" +stdout = "stdout" +stderr = "stderr" +stdecho = "stdecho" + +{- The Dialogue, Request, Response and IOError datatypes are now builtin: +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + | GetArgs + | GetProgName + | GetEnv String + +data Response = Success + | Str String + | Failure IOError + | StrList [String] + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +type Dialogue = [Response] -> [Request] +-} + +type SuccCont = Dialogue +type StrCont = String -> Dialogue +type StrListCont = [String] -> Dialogue +type FailCont = IOError -> Dialogue + +done :: Dialogue +readFile :: String -> FailCont -> StrCont -> Dialogue +writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue +appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue +readChan :: String -> FailCont -> StrCont -> Dialogue +appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue +echo :: Bool -> FailCont -> SuccCont -> Dialogue +getArgs :: FailCont -> StrListCont -> Dialogue +getProgName :: FailCont -> StrCont -> Dialogue +getEnv :: String -> FailCont -> StrCont -> Dialogue + +done resps = [] +readFile name fail succ resps = + (ReadFile name) : strDispatch fail succ resps +writeFile name contents fail succ resps = + (WriteFile name contents) : succDispatch fail succ resps +appendFile name contents fail succ resps = + (AppendFile name contents) : succDispatch fail succ resps +readChan name fail succ resps = + (ReadChan name) : strDispatch fail succ resps +appendChan name contents fail succ resps = + (AppendChan name contents) : succDispatch fail succ resps +echo bool fail succ resps = + (Echo bool) : succDispatch fail succ resps +getArgs fail succ resps = + GetArgs : strListDispatch fail succ resps +getProgName fail succ resps = + GetProgName : strDispatch fail succ resps +getEnv name fail succ resps = + (GetEnv name) : strDispatch fail succ resps + +strDispatch fail succ (resp:resps) = + case resp of Str val -> succ val resps + Failure msg -> fail msg resps + +succDispatch fail succ (resp:resps) = + case resp of Success -> succ resps + Failure msg -> fail msg resps + +strListDispatch fail succ (resp:resps) = + case resp of StrList val -> succ val resps + Failure msg -> fail msg resps + +abort :: FailCont +abort err = done + +exit :: FailCont +exit err = appendChan stderr msg abort done + where msg = case err of ReadError s -> s + WriteError s -> s + SearchError s -> s + FormatError s -> s + OtherError s -> s + +print :: Text a => a -> Dialogue +print x = appendChan stdout (show x) exit done + +prints :: Text a => a -> String -> Dialogue +prints x s = appendChan stdout (shows x s) exit done + +interact :: (String -> String) -> Dialogue +interact f = readChan stdin exit + (\x -> appendChan stdout (f x) exit done) + +run :: (String -> String) -> Dialogue +run f = echo False exit (interact f) + +primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a + +openfile :: String -> String +openfile f = primFopen f (error ("can't open file "++f)) id + +-- End of Gofer standard prelude: -------------------------------------------- diff --git a/demos/Cal/calendar.gs b/demos/Cal/calendar.gs new file mode 100644 index 0000000..c00dafa --- /dev/null +++ b/demos/Cal/calendar.gs @@ -0,0 +1,111 @@ +-- This is a modification of the calendar program described in section 4.5 +-- of Bird and Wadler's ``Introduction to functional programming'', with +-- two ways of printing the calendar ... as in B+W, or like UNIX `cal': + +-- Picture handling: + +infixr 5 `above`, `beside` + +type Picture = [[Char]] + +height, width :: Picture -> Int +height p = length p +width p = length (head p) + +above, beside :: Picture -> Picture -> Picture +above = (++) +beside = zipWith (++) + +stack, spread :: [Picture] -> Picture +stack = foldr1 above +spread = foldr1 beside + +empty :: (Int,Int) -> Picture +empty (h,w) = copy h (copy w ' ') + +block, blockT :: Int -> [Picture] -> Picture +block n = stack . map spread . group n +blockT n = spread . map stack . group n + +group :: Int -> [a] -> [[a]] +group n [] = [] +group n xs = take n xs : group n (drop n xs) + +lframe :: (Int,Int) -> Picture -> Picture +lframe (m,n) p = (p `beside` empty (h,n-w)) `above` empty (m-h,n) + where h = height p + w = width p + +-- Information about the months in a year: + +monthLengths year = [31,feb,31,30,31,30,31,31,30,31,30,31] + where feb | leap year = 29 + | otherwise = 28 + +leap year = if year`mod`100 == 0 then year`mod`400 == 0 + else year`mod`4 == 0 + +monthNames = ["January","February","March","April", + "May","June","July","August", + "September","October","November","December"] + +jan1st year = (year + last`div`4 - last`div`100 + last`div`400) `mod` 7 + where last = year - 1 + +firstDays year = take 12 + (map (`mod`7) + (scanl (+) (jan1st year) (monthLengths year))) + +-- Producing the information necessary for one month: + +dates fd ml = map (date ml) [1-fd..42-fd] + where date ml d | d<1 || ml + case strs of [year] -> calFor year + _ -> appendChan stdout "Usage: cal year\n" exit done) + +calFor year | illFormed = appendChan stderr "Bad argument" exit done + | otherwise = appendChan stdout (cal yr) exit done + where illFormed = null ds || not (null rs) + (ds,rs) = span isDigit year + yr = atoi ds + atoi s = foldl (\a d -> 10*a+d) 0 (map toDigit s) + toDigit d = ord d - ord '0' + + +-- End of calendar program diff --git a/demos/CallingC/Readme b/demos/CallingC/Readme new file mode 100644 index 0000000..5dfa396 --- /dev/null +++ b/demos/CallingC/Readme @@ -0,0 +1,42 @@ +Here is a simple example using the external function mechanism. +It involves the following short Gofer and C programs: + +(gix1.gs): primitive howdy "sayHello" :: Int -> IO () + + main = howdy (length (filter even [1..5])) + + +(cix1.c): #include + #include "gofc.h" + + Void sayHello(i) + Int i; { + while (i-- > 0) + printf("hello, world\n"); + } + +First, we compile gix1.gs to get a C program gix1.c: + + machine% gofc gix1.gs + Gofer->C Version 1.02 (2.30) Copyright (c) Mark P Jones 1992-1994 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "gix1.gs": + + Writing C output file "gix1.c": + [Leaving Gofer->C] + +Now we compile the C programs, and link them into a single executable +file, ix1: + + + machine% cc -O -o ix1 gix1.c cix1.c runtime.o + +Finally, we get to run the program: + + machine% ix1 + hello, world + hello, world + +Wow! + diff --git a/demos/CallingC/cix1.c b/demos/CallingC/cix1.c new file mode 100644 index 0000000..8c1951e --- /dev/null +++ b/demos/CallingC/cix1.c @@ -0,0 +1,8 @@ +#include +#include "gofc.h" + +Void sayHello(i) +Int i; { + while (i-- > 0) + printf("hello, world\n"); +} diff --git a/demos/CallingC/gix1.gs b/demos/CallingC/gix1.gs new file mode 100644 index 0000000..ffb59fd --- /dev/null +++ b/demos/CallingC/gix1.gs @@ -0,0 +1,5 @@ + +primitive howdy "sayHello" :: Int -> IO () + +main = howdy (length (filter even [1..5])) + diff --git a/demos/Ccexamples/abstack.lgs b/demos/Ccexamples/abstack.lgs new file mode 100644 index 0000000..970424f --- /dev/null +++ b/demos/Ccexamples/abstack.lgs @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +Another, rather different application of constructor classes, described +to me by Stuart Clayman: + +I may want to implement a stack using different mechanisms, namely +built in list type, or my own contructor. Type classes don't allow +this, but constructor classes do. Consider this: + +> class Stack s where +> push :: a -> s a -> s a +> pop :: s a -> s a +> top :: s a -> a +> empty :: s a +> +> instance Stack [] where +> push v s = v:s +> pop (t:s) = s +> top (t:s) = t +> empty = [] +> +> teststack :: Stack s => s Int +> teststack = push 5 (push 4 (push 3 (push 2 (push 1 empty)))) + +This defines a stack of things. Now we can instantiate it: + +> stack1 :: [Int] +> stack1 = teststack + +to give a stack implemented as a list. If we want to use our own +constructor we can do this + +> data List a = Nil | Cons a (List a) +> +> instance Stack List where +> push v s = Cons v s +> pop (Cons t s) = s +> top (Cons t s) = t +> empty = Nil +> +> stack2 :: List Int +> stack2 = teststack + +to give a different sort of stack. In this way we can overload +operators to any construct. The use of restricted types can hide +the real types of [Int] and List Int in stack1 and stack2. + +How about the following for a stack of numerics: + +> newteststack :: (Num a,Stack s) => s a +> newteststack = foldr push empty (map fromInteger [5,4,3,2,1]) + +This can be instantiated in several different ways. Generic stacks of +integers or floats: + +> inewstack :: Stack s => s Int +> inewstack = newteststack + +> fnewstack :: Stack s => s Float +> fnewstack = newteststack + +List or [] stacks of generic numbers: + +> lnewstack1 :: Num a => [a] +> lnewstack1 = newteststack + +> lnewstack2 :: Num a => List a +> lnewstack2 = newteststack + +Or specific stack/number combinations: + +> ilnewstack1 :: [Int] +> ilnewstack1 = newteststack + +> ilnewstack2 :: List Int +> ilnewstack2 = newteststack + +> flnewstack1 :: [Float] +> flnewstack1 = newteststack + +> flnewstack2 :: List Float +> flnewstack2 = newteststack + +------------------------------------------------------------------------------ diff --git a/demos/Ccexamples/ccexamples.gs b/demos/Ccexamples/ccexamples.gs new file mode 100644 index 0000000..d21a3e3 --- /dev/null +++ b/demos/Ccexamples/ccexamples.gs @@ -0,0 +1,493 @@ +-- ccexamples.gs Mark P. Jones, 1992 +-- +-- This file contains a range of examples using the system of constructor +-- classes implemented in Gofer 2.28. You will need to start Gofer running +-- with the cc.prelude to use this file. +-- + +-- Constructor class examples: ---------------------------------------------- + +class Functor2 f where + map2 :: (a -> b) -> (c -> d) -> (f a c -> f b d) + +-- The identity monad (well nearly): ---------------------------------------- + +data Id a = Id a + +instance Functor Id where map f (Id x) = Id (f x) +instance Monad Id where result = Id + join (Id x) = x + Id x `bind` f = f x + +-- The `Maybe' datatype: ---------------------------------------------------- + +data Maybe a = Just a | Nothing + +instance Functor Maybe where + map f (Just x) = Just (f x) + map f Nothing = Nothing + +instance Monad Maybe where + result x = Just x + Just x `bind` f = f x + Nothing `bind` f = Nothing + +instance Monad0 Maybe where + zero = Nothing + +instance MonadPlus Maybe where + Nothing ++ y = y + x ++ y = x + +trap :: Maybe a -> a -> a +Just x `trap` def = x +Nothing `trap` def = def + +listToMaybe :: [a] -> Maybe a -- a monad homomorphism +listToMaybe = concat . map result + +-- Error monads -------------------------------------------------------------- + +class Monad m => ErrorMonad m where -- a class of monads for describing + fail :: String -> m a -- computations that might go wrong + +data Error a = Done a | Err String -- a variation on the maybe type + +instance Functor Error where -- which is a Functor, + map f (Done x) = Done (f x) + map f (Err s) = Err s + +instance Monad Error where -- a Monad, + result = Done + Done x `bind` f = f x + Err msg `bind` f = Err msg + +instance ErrorMonad Error where -- and an ErrorMonad ... + fail = Err + +-- Parser monad: ------------------------------------------------------------ + +type Parser token value = [token] -> [(value,[token])] + in mapP, resultP, joinP, bindP, zeroP, orP, sat, tok, toks, spaces, parse + +mapP :: (a -> b) -> Parser t a -> Parser t b +mapP f p = \s -> [ (f x, s') | (x,s') <- p s ] + +resultP :: a -> Parser t a +resultP v = \s -> [(v,s)] + +joinP :: Parser t (Parser t a) -> Parser t a +joinP pp = \s -> [ (x,s'') | (p,s') <- pp s, (x,s'') <- p s' ] + +bindP :: Parser t a -> (a -> Parser t b) -> Parser t b +p `bindP` f = \s -> [ (a',s'') | (a,s') <- p s, (a',s'') <- f a s' ] + +zeroP :: Parser t a +zeroP = \s -> [] + +orP :: Parser t a -> Parser t a -> Parser t a +p `orP` q = \s -> p s ++ q s + +sat :: (t -> Bool) -> Parser t t +sat p [] = [] +sat p (h:ts) = [ (h,ts) | p h ] + +tok :: Eq t => t -> Parser t t +tok t = sat (t==) + +toks :: Eq [t] => [t] -> Parser t () +toks w = \ts -> [ ((),drop n ts) | w == take n ts ] + where n = length w + +spaces :: Parser Char a -> Parser Char a +spaces p = p . dropWhile isSpace + +parse :: Parser t a -> [t] -> Maybe a +parse p ts = listToMaybe [ x | (x,[]) <- p ts ] + +instance Functor (Parser t) where map = mapP +instance Monad (Parser t) where result = resultP + bind = bindP + join = joinP +instance Monad0 (Parser t) where zero = zeroP +instance MonadPlus (Parser t) where (++) = orP + +-- Continuation monad: ------------------------------------------------------ + +type Cont r a = (a -> r) -> r + in mapC, resultC, joinC, bindC, callcc + +mapC :: (a -> b) -> Cont r a -> Cont r b +mapC f m = \k -> m (k . f) + +resultC :: a -> Cont r a +resultC x = \k -> k x + +joinC :: Cont r (Cont r a) -> Cont r a +joinC m = \k -> m (\x -> x k) + +bindC :: Cont r a -> (a -> Cont r b) -> Cont r b +m `bindC` f = \k -> m (\y -> (f y) k) + +callcc :: ((a -> Cont r b) -> Cont r a) -> Cont r a +callcc g = \k -> g (\x k' -> k x) k + +instance Functor (Cont r) where map = mapC + +instance Monad (Cont r) where result = resultC + bind = bindC + join = joinC + +-- State monads: ------------------------------------------------------------ + +class Monad (m s) => StateMonad m s where + update :: (s -> s) -> m s s -- the principal characteristic of a + set :: s -> m s s -- state based compuation is that you + fetch :: m s s -- can update the state! + set new = update (\old -> new) + fetch = update id + +incr :: StateMonad m Int => m Int Int +incr = update (1+) + +random :: StateMonad m Int => Int -> m Int Int +random n = update min_stand_test `bind` \m -> + result (m `mod` n) + +min_stand_test :: Int -> Int -- see demos/minsrand.gs for explanation +min_stand_test n = if test > 0 then test else test + 2147483647 + where test = 16807 * lo - 2836 * hi + hi = n `div` 127773 + lo = n `rem` 127773 + +data State s a = ST (s -> (a,s)) -- The standard example: state + -- transformers (not used in the rest + -- of this program). +instance Functor (State s) where + map f (ST st) = ST (\s -> let (x,s') = st s in (f x, s')) + +instance Monad (State s) where + result x = ST (\s -> (x,s)) + ST m `bind` f = ST (\s -> let (x,s') = m s + ST f' = f x + in f' s') + +instance StateMonad State s where + update f = ST (\s -> (s, f s)) + +ST m `startingWith` s0 = result where (result,_) = m s0 + +data STM m s a = STM (s -> m (a,s)) -- a more sophisticated example, + -- where the state monad is + -- parameterised by a second, + -- arbitrary monad. + +instance Monad m => Functor (STM m s) where + map f (STM xs) = STM (\s -> [ (f x, s') | ~(x,s') <- xs s ]) + +instance Monad m => Monad (STM m s) where + result x = STM (\s -> result (x,s)) + join (STM xss) = STM (\s -> [ (x,s'') | ~(STM xs, s') <- xss s, + ~(x,s'') <- xs s' ]) + STM xs `bind` f = STM (\s -> xs s `bind` (\(x,s') -> + let STM f' = f x + in f' s')) + +instance ErrorMonad m => ErrorMonad (STM m s) where + fail msg = STM (\s -> fail msg) + +instance StateMonad (STM m) s where + update f = STM (\s -> result (s, f s)) + +protect :: Monad m => m a -> STM m s a +protect m = STM (\s -> [ (x,s) | x<-m ]) + +execute :: Monad m => s -> STM m s a -> m a +execute s (STM f) = [ x | ~(x,s') <- f s ] + +-- Reader monad: ------------------------------------------------------------ +-- I imagine there must be some deep philosophical reason why the following +-- functions turn out to be very well-known combinators? +----------------------------------------------------------------------------- + +type Reader r a = r -> a + in mapR, resultR, bindR, joinR, read, readOnly + +mapR :: (a -> b) -> (Reader r a -> Reader r b) +mapR f m = f . m -- B + +resultR :: a -> Reader r a +resultR x = \r -> x -- K + +joinR :: Reader r (Reader r a) -> Reader r a +joinR mm = \r -> mm r r -- W? + +bindR :: Reader r a -> (a -> Reader r b) -> Reader r b +x `bindR` f = \r -> f (x r) r -- S + +read :: Reader r r +read r = r + +readOnly :: Reader s a -> State s a +readOnly m = ST (\s -> (m s, s)) + +instance Functor (Reader r) where map = mapR + +instance Monad (Reader r) where result = resultR + bind = bindR + join = joinR + +-- Output monad: ------------------------------------------------------------ + +type Output a = (a, ShowS) + in mapO, resultO, bindO, joinO, write + +mapO :: (a -> b) -> Output a -> Output b +mapO f (x, ss) = (f x, ss) + +resultO :: a -> Output a +resultO x = (x, id) + +bindO :: Output a -> (a -> Output b) -> Output b +(a, ss) `bindO` f = let (b, ss') = f a in (b, ss . ss') + +joinO :: Output (Output a) -> Output a +joinO ((m,ss'),ss) = (m, ss . ss') + +write :: String -> Output () +write msg = ((), (++) msg) + +instance Functor Output where map = mapO + +instance Monad Output where result = resultO + bind = bindO + join = joinO + +-- Association lists --------------------------------------------------------- + +type Assoc v t = [(v,t)] in mapAssoc, noAssoc, extend, lookup + +instance Functor (Assoc v) where map = mapAssoc + +mapAssoc :: (a -> b) -> (Assoc v a -> Assoc v b) +mapAssoc f vts = [ (v, f t) | (v,t) <- vts ] + +noAssoc :: Assoc v t +noAssoc = [] + +extend :: v -> t -> Assoc v t -> Assoc v t +extend v t a = [(v,t)] ++ a + +lookup :: (Eq v, ErrorMonad m) => v -> Assoc v t -> m t +lookup v = foldr find (fail "Undefined value") + where find (w,t) alt | w==v = result t + | otherwise = alt + +-- Types: ------------------------------------------------------------------- + +data Type v = TVar v -- Type variable + | Fun (Type v) (Type v) -- Function type + +instance Text v => Text (Type v) where + showsPrec p (TVar v) = shows v + showsPrec p (Fun (TVar v) r) = shows v . showString " -> " . shows r + showsPrec p (Fun l r) = showChar '(' . shows l . showChar ')' + . showString " -> " + . shows r + +instance Functor Type where map f (TVar v) = TVar (f v) + map f (Fun d r) = Fun (map f d) (map f r) +instance Monad Type where result v = TVar v + TVar v `bind` f = f v + Fun d r `bind` f = Fun (d `bind` f) (r `bind` f) + +vars :: Type v -> [v] +vars (TVar v) = [v] +vars (Fun d r) = vars d ++ vars r + +-- Substitutions: ----------------------------------------------------------- + +type Subst m v = v -> m v + +nullSubst :: Monad m => Subst m v +nullSubst = result + +(>>) :: (Eq v, Monad m) => v -> m v -> Subst m v +(v >> t) w = if v==w then t else result w + +varBind v t = if (v `elem` vars t) then fail "unification fails" + else result (v>>t) + +unify (TVar v) (TVar w) + | v==w = result nullSubst + | otherwise = result (v>>TVar w) +unify (TVar v) t = varBind v t +unify t (TVar v) = varBind v t +unify (Fun d r) (Fun e s) = [ s2 @@ s1 | s1 <- unify d e, + s2 <- unify (apply s1 r) + (apply s1 s) ] + +-- Terms: -------------------------------------------------------------------- + +data Term v = Var v -- variable + | Ap (Term v) (Term v) -- application + | Lam v (Term v) -- lambda abstraction + +examples = [ lamx x, -- identity + k, -- k + s, -- s + lamx (lamy (lamz (Ap x (Ap y z)))),-- b + lamx (Ap x x), -- \x. x x + Ap (Ap s k) k, -- s k k + Ap (Ap s (Ap k s)) k, -- s (k s) k + x -- unbound x + ] + where s = lamx (lamy (lamz (Ap (Ap x z) (Ap y z)))) + k = lamx (lamy x) + x = Var "x" + y = Var "y" + z = Var "z" + lamx = Lam "x" + lamy = Lam "y" + lamz = Lam "z" + +-- Type inference: ----------------------------------------------------------- + +type Infer a = STM Error Int a +type Expr = Term String +type Assume = Assoc String (Type Int) + +infer :: Assume -> Expr -> Infer (Subst Type Int, Type Int) +infer a (Var v) = lookup v a `bind` \t -> + result (nullSubst,t) +infer a (Lam v e) = newVar `bind` \b -> + infer (extend v (TVar b) a) e `bind` \(s,t) -> + result (s, s b `Fun` t) +infer a (Ap l r) = infer a l `bind` \(s,lt) -> + infer (map (apply s) a) r `bind` \(t,rt) -> + newVar `bind` \b -> + unify (apply t lt) (rt `Fun` TVar b) `bind` \u -> + result (u @@ t @@ s, u b) + +newVar :: Infer Int +newVar = incr + +try = layn (map (show' . typeOf) examples) + +typeOf = map (show.snd) . execute 0 . infer noAssoc + +-- Now for something rather different: Trees: ------------------------------- + +class Functor t => TreeCon t where -- tree constructors + branches :: t a -> [t a] + +-- standard calculations involving trees + +depth :: TreeCon t => t a -> Int +depth = (1+) . foldl max 0 . map depth . branches + +dfs :: TreeCon t => t a -> [t a] +dfs t = t : concat (map dfs (branches t)) + +bfs :: TreeCon t => t a -> [t a] +bfs = concat . lev + where lev t = [t] : foldr cat [] (map lev (branches t)) + cat = longzw (++) + +longzw f (x:xs) (y:ys) = f x y : longzw f xs ys +longzw f [] ys = ys +longzw f xs [] = xs + +paths t | null br = [ [t] ] + | otherwise = [ t:p | b<-br, p<-paths b ] + where br = branches t + +-- now here are a variety of trees, all of which are instances of +-- the TreeCon class above: + +data Tree a = Leaf a | Tree a :^: Tree a + +instance Functor Tree where -- `context free relabeling' + map f (Leaf a) = Leaf (f a) + map f (l :^: r) = map f l :^: map f r + +instance Monad Tree where -- `substitution' + result = Leaf + Leaf x `bind` f = f x + (l :^: r) `bind` f = (l `bind` f) :^: (r `bind` f) + +instance TreeCon Tree where -- the tree structure + branches (Leaf n) = [] + branches (l :^: r) = [l,r] + +data LabTree l a = Tip a | LFork l (LabTree l a) (LabTree l a) + +instance Functor (LabTree l) where + map f (Tip x) = Tip (f x) + map f (LFork x l r) = LFork x (map f l) (map f r) + +instance Monad (LabTree l) where + result = Tip + Tip x `bind` f = f x + LFork x l r `bind` f = LFork x (l `bind` f) (r `bind` f) + +instance TreeCon (LabTree l) where + branches (Tip x) = [] + branches (LFork x l r) = [l,r] + +data STree a = Empty | Split a (STree a) (STree a) + +instance Functor STree where + map f Empty = Empty + map f (Split x l r) = Split (f x) (map f l) (map f r) + +instance TreeCon STree where + branches Empty = [] + branches (Split x l r) = [l,r] + +data GenTree a = Node a [GenTree a] + +instance Functor GenTree where + map f (Node x gts) = Node (f x) (map (map f) gts) + +instance TreeCon GenTree where + branches (Node x gts) = gts + +-- The tree labeling program: ----------------------------------------------- + +label :: Tree a -> Tree (a,Int) -- error prone explicit +label tree = fst (lab tree 0) -- counters + where lab (Leaf n) c = (Leaf (n,c), c+1) + lab (l :^: r) c = (l' :^: r', c'') + where (l',c') = lab l c + (r',c'') = lab r c' + +label1 :: Tree a -> Tree (a,Int) -- monad version +label1 tree = lab tree `startingWith` 0 + where lab (Leaf n) = incr `bind` \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l `bind` \l' -> + lab r `bind` \r' -> + result (l' :^: r') + +label2 :: Tree a -> Tree (a,Int) -- using monad comprehensions +label2 tree = lab tree `startingWith` 0 + where lab (Leaf n) = [ Leaf (n,c) | c <- incr ] + lab (l :^: r) = [ l :^: r | l <- lab l, r <- lab r ] + +-- A `while loop' for an arbitrary monad: ----------------------------------- + +while :: Monad m => m Bool -> m b -> m () +while c s = c `bind` \b -> + if b then s `bind` \x -> + while c s + else result () + +skip :: Monad m => m () +skip = result () + +loop = while isDot skip + +isDot = [ True | x <- sat ('.'==) ] + +-- End of program ----------------------------------------------------------- diff --git a/demos/Ccexamples/combine.gs b/demos/Ccexamples/combine.gs new file mode 100644 index 0000000..556bd28 --- /dev/null +++ b/demos/Ccexamples/combine.gs @@ -0,0 +1,42 @@ +-- combine.gs Mark P Jones December 1992 +-- +-- The following script resulted from a discussion between myself +-- and Luc Duponcheel on the comp.lang.functional newsgroup in +-- December 1992. +-- +-- This code fragment shows how the composition of monads can be +-- described in Gofer using constructor classes. + +class (Monad m, Monad l) => Composable m l where + prod :: l (m (l a)) -> m (l a) + swap :: l (m a) -> m (l a) + app :: (l a -> m b) -> l (m a) -> m b + + prod = app (result . join) + swap = prod . map (map result) + app f = join . map f . swap + +mmap f = swap . map f + +instance Composable m [ ] where + swap [] = [ [] ] + swap (x:xs) = [ y:ys | y<-x, ys<-swap xs ] + +type Comp f g a = f (g a) in mapComp, resultComp, joinComp + +mapComp :: (Functor f, Functor g) => (a -> b) -> (Comp f g a -> Comp f g b) +mapComp = map . map + +instance (Functor f, Functor g) => Functor (Comp f g) where + map = mapComp + +resultComp :: (Monad f, Monad g) => a -> Comp f g a +resultComp = result . result + +joinComp :: (Composable f g) => Comp f g (Comp f g a) -> Comp f g a +joinComp = join . map prod + +instance Composable f g => Monad (Comp f g) where + result = resultComp + join = joinComp + diff --git a/demos/Ccexamples/democomb.gs b/demos/Ccexamples/democomb.gs new file mode 100644 index 0000000..50c407c --- /dev/null +++ b/demos/Ccexamples/democomb.gs @@ -0,0 +1,262 @@ +-- A demonstration of the use of a composition of monads to implement an +-- `imperative' version of the fibonacci numbers program. +-- +-- Original code by Luc Dupocheel, with small changes to allow the code to +-- be used with the standard Gofer 2.28 cc.prelude. +-- + +-- begin -------------------------------------------------------------------- + +infix 1 :=:, =: +infixr 0 :&:, & + +-- expressions -------------------------------------------------------------- + +type Value = Int +type Name = String + +data Expression = Con Int | Var String | Expression :+: Expression + +-- evaluating expressions --------------------------------------------------- + +type Rom = [(Name,Value)] + +expr1 :: Expression -> Read Rom Value +expr1 (Con v) = result v +expr1 (Var n) = lookup n +expr1 (e:+:f) = [ x+y | x <- expr1 e, y <- expr1 f ] + +-- evaluating expressions reused -------------------------------------------- + +type Ram = Int + +expr2 :: Expression -> Composition (Read Rom) (State Ram) Value +expr2 (Con v) = plug (expr1 (Con v)) +expr2 (Var n) = join [ plug (doS (+1) v) | v <- plug (expr1 (Var n))] +expr2 (e:+:f) = [ x+y | x <- expr2 e, y <- expr2 f ] + + +-- programs ------------------------------------------------------------------ + +data Program = Name :=: Expression | Out Expression | Program :&: Program | Forever Program + +-- interpreting programs ----------------------------------------------------- + +type Memory = Rom +type Output = [Value] + +(=:) :: Name -> Value -> Memory -> Memory +n =: v = ((n,v) :) + +out :: Value -> Output -> Output +out v = (v :) + +(&) :: () -> () -> () +() & () = () + +prg1 :: Program -> Cont (Memory -> Output) () +prg1 (n:=:e) = join [ plug (doS (x=:v) ()) | x <- result n, + v <- plug (expr1 e)] +prg1 (Out e) = join [ doC (out v) | v <- plug (expr1 e) ] +prg1 (p:&:q) = [ u&v | u <- prg1 p , v <- prg1 q] +prg1 (Forever p) = [ v&w | v <- prg1 p, w <- prg1 (Forever p)] + +-- expressions : an example + +rom :: Rom +rom = [("n",3),("m",4)] + +expression :: Expression +expression = ((Con 1 :+: Var "n") :+: ((Var "m" :+: Con 2) :+: Var "n")) + +showV :: Value -> String -> String +showV v = showString "value : " . shows v . showChar '\n' + +instance Text (Read Rom Value) where + showsPrec p (Rd f) = let v = f rom in showV v . showChar '\n' + +ex1 = show (expr1 expression) + +-- expressions with state : an example + +ram0 :: Ram +ram0 = 0 + +showR :: Ram -> String -> String +showR r = showString "ram : " . shows r . showChar '\n' + +instance Text (Composition (Read Rom) (State Ram) Value) where + showsPrec p (Comp f) = let (v,r) = tS (dR f rom) ram0 + in showV v . showR r . showChar '\n' + +ex2 = show (expr2 expression) + +-- programs an example -------------------------------------------------------- + +mem0 :: Memory +mem0 = [] + +cont0 :: () -> Memory -> Output +cont0 () mem = [] + +instance Text (Cont (Memory -> Output) ()) where + showsPrec p (Cnt f) = fold showV (f cont0 mem0) . showChar '\n' + +output :: Name -> Program +output = Out . Var + +program :: Program +program = "x" :=: Con 1 :&: + "y" :=: Con 1 :&: + output "x" :&: + output "y" :&: + Forever ( + "z" :=: Var "x" :+: Var "y" :&: + "x" :=: Var "y" :&: + "y" :=: Var "z" :&: + output "z" + ) + +main :: Dialogue +main = appendChan stdout fibs exit done + where fibs = show (prg1 program) + + +-- Monad morphisms, algebras and composition: -------------------------------- + +class (Monad m, Monad n) => MonadMorphism m n where + plug :: m a -> n a + +class Monad m => Algebra m a where + bindA :: m x -> (x -> a) -> a + applyA :: (x -> a) -> m x -> a + (##) :: (x -> m y) -> (y -> a) -> x -> a + joinA :: m a -> a + + applyA = flip bindA + g ## f = (`bindA` f) . g + joinA = (`bindA` id) + x `bindA` f = joinA (map f x) + +instance Monad m => Algebra m (m x) where + bindA = bind + +class (Monad m, Monad n) => ComposableMonads m n where + prod :: n (m (n x)) -> m (n x) + swap :: n (m x) -> m (n x) + + prod = map join . swap + swap = prod . map (map result) + +bindC :: ComposableMonads m n => n x -> (x -> m (n y)) -> m (n y) +x `bindC` f = prod (map f x) + +applyC :: ComposableMonads m n => (x -> m (n y)) -> n x -> m (n y) +applyC = flip bindC + +applyC' :: ComposableMonads m n => (n x -> m y) -> n (m x) -> m y +applyC' f = apply f . swap + +(**) :: ComposableMonads m n => (x -> n y) -> (y -> m (n z)) -> x -> m (n z) +g ** f = (`bindC` f) . g + +mapC :: ComposableMonads m n => (x -> m y) -> n x -> m (n y) +mapC f = swap . map f + +-- I prefer to use 'data' instead of 'type' for Composition +-- This avoids the need for restricted type synonyms +-- but it complicates things a bit (pmoC is needed ...) + +data Composition m n a = Comp (m (n a)) + +pmoC (Comp x) = x + +instance (Functor f, Functor g) => Functor (Composition f g) where + map f = Comp . (map . map) f . pmoC + +instance ComposableMonads m n => Monad (Composition m n) where + result = Comp . (result . result) + join = Comp . join . map (prod . map pmoC) . pmoC + +-- this would give an overlap + +--instance MonadMorphism n (Composition m n) where +-- plug = Comp . result + +--instance MonadMorphism m (Composition m n) where +-- plug = Comp . map result + +instance (Monad (Composition m l), Monad (Composition r s), + MonadMorphism m r, MonadMorphism l s) => + MonadMorphism (Composition m l) (Composition r s) where + plug = Comp . map plug . plug . pmoC + +mfold f = foldr (@@) result . map f +fold f = foldr (.) id . map f + +-- The read monad: ----------------------------------------------------------- + +data Read r x = Rd (r -> x) +dR (Rd f) = f + +instance Functor (Read r) where + map f (Rd g) = Rd (\r -> let x = g r in f x) + +instance Monad (Read r) where + result x = Rd (\r -> x) + (Rd g) `bind` f = Rd (\r -> let x = g r in dR (f x) r) + +lookup :: Eq b => b -> Read [(b,a)] a +lookup x = Rd f where f ((y,v):bs) | x == y = v + | otherwise = f bs + +-- The state monad: ---------------------------------------------------------- + +data State s x = St (s -> (x,s)) +tS (St f) = f + +instance Functor (State s) where + map f (St g) = St (\s -> let (x,t) = g s in (f x,t)) + +instance Monad (State s) where + result x = St (\s -> (x,s)) + (St g) `bind` f = St (\s -> let (x,t) = g s in tS (f x) t) + +doS :: (s -> s) -> x -> State s x +doS f x = St g where g s = (x, f s) + +-- The continuation monad: --------------------------------------------------- + +data Cont a x = Cnt ((x -> a) -> a) +tnC (Cnt f) = f + +instance Functor (Cont a) where + map f (Cnt g) = Cnt (\c -> g (c . f)) + +instance Monad (Cont a) where + result x = Cnt (\c -> c x) + (Cnt g) `bind` f = Cnt (\c -> g (\x -> tnC (f x) c)) + +doC :: (a -> a) -> Cont (s -> a) () +doC f = Cnt (\c s -> f (c () s)) + +instance MonadMorphism (State s) (Cont (s -> a)) where + plug (St g) = Cnt (\c s -> let (x,t) = g s in c x t) + +instance MonadMorphism (Read r) (Cont (r -> a)) where + plug (Rd g) = Cnt (\c r -> let x = g r in c x r) + +-- The read-state monad: ----------------------------------------------------- + +instance ComposableMonads (Read r) (State s) where + swap mf = Rd (\x -> [ dR m x | m <- mf ]) + +-- needed explicitly because of overlap in general case + +instance MonadMorphism (State s) (Composition (Read r) (State s)) where + plug = Comp . result + +instance MonadMorphism (Read r) (Composition (Read r) (State s)) where + plug = Comp . map result + +-- end ----------------------------------------------------------------------- diff --git a/demos/Ccexamples/fancycat.gs b/demos/Ccexamples/fancycat.gs new file mode 100644 index 0000000..794e52f --- /dev/null +++ b/demos/Ccexamples/fancycat.gs @@ -0,0 +1,146 @@ +------------------------------------------------------------------------------- +-- Using constructor classes to model concepts from category theory. A more +-- general approach than that provided by the standard constructor classes +-- prelude cc.prelude, acknowledging the fact that not everybody works in the +-- same category all the time ... +-- +-- [Use the standard.prelude to load this file in Gofer 2.28] +-- +-- Mark P. Jones, March 1993 +------------------------------------------------------------------------------- + +-- Categories: ---------------------------------------------------------------- + +class Cat fn where + identity :: fn a a + compose :: fn b c -> fn a b -> fn a c + +instance Cat (->) where + identity x = x + compose f g x = f (g x) + + +-- In general, functors can go between different categories: ------------------ + +class (Cat fn, Cat fn') => Functor fn fn' f where + functor :: fn a b -> fn' (f a) (f b) + +instance Functor (->) (->) [] where + functor f [] = [] + functor f (x:xs) = f x : functor f xs + +data Tree a = Leaf a | Tree a :^: Tree a + +instance Functor (->) (->) Tree where + functor f (Leaf x) = Leaf (f x) + functor f (l :^: r) = functor f l :^: functor f r + + +-- An endofunctor has the same source and target categories: ------------------ + +class Functor fn fn f => EndoFunctor fn f +instance Functor fn fn f => EndoFunctor fn f + + +-- Monads are built on top of endofunctors: ----------------------------------- + +class EndoFunctor fn m => Monad fn m where + result :: fn a (m a) + join :: fn (m (m a)) (m a) + +instance Monad (->) [] where + result x = [x] + join = foldr (++) [] + + +-- Kleisli categories: -------------------------------------------------------- + +type Kleisli fn m a b = fn a (m b) + in kleisliId :: Monad fn m => Kleisli fn m a a, + kleisliComp :: Monad fn m => Kleisli fn m b c -> + Kleisli fn m a b -> Kleisli fn m a c, + kleisli :: fn a (m b) -> Kleisli fn m a b, + kleisliMap :: Monad fn m => Kleisli fn m a b -> fn (m a) (m b), + kleisliUniv :: Monad fn m => fn a (m b) -> Kleisli fn m (Id a) b, + kleisliCouniv :: Monad fn m => Kleisli fn m (Id a) b -> fn a (m b), + idKleisli + +kleisliId = result +kleisliComp f g = compose join (compose (functor f) g) +kleisli f = f +kleisliMap f = compose join (functor f) +kleisliUniv = id +kleisliCouniv = id + +instance Monad fn m => Cat (Kleisli fn m) where + identity = kleisliId + compose = kleisliComp + +instance Monad fn m => Functor (Kleisli fn m) fn m where + functor = kleisliMap + + +-- The identity functor: ------------------------------------------------------ + +type Id x = x in idFunctor :: fn a b -> fn (Id a) (Id b), + idResult :: Cat fn => fn a (Id a), + idJoin :: Cat fn => fn (Id (Id a)) (Id a), + idKleisli :: Monad fn m => fn a b ->Kleisli fn m (Id a) (Id b), + kleisliUniv, kleisliCouniv + +idFunctor = id +idResult = identity +idJoin = identity +idKleisli = compose result + +instance Functor fn fn Id where + functor = idFunctor + +instance Monad fn Id where + result = idResult + join = idJoin + +instance Monad fn m => Functor fn (Kleisli fn m) Id where + functor = idKleisli + + +-- Natural transformations: --------------------------------------------------- + +{- You'd think this was easy. But uncomment the following and you'll find + that the obvious definition gives an ambiguous type for eta. It's not + obvious whether you can genuinely express naturality in this framework. + + Note that these definitions work if you restrict attention to single + category as in cc.prelude. + +class (Functor c d f, Functor c d g) => NatTransf c d f g where + eta :: f a -> g a + +instance NatTransf (->) (->) Tree [] where + eta (Leaf x) = [x] + eta (l :^: r) = eta l ++ eta r +-} + + +-- Since we've come this far, let's (try to) code up adjunctions too: --------- + +class (Functor ca cb left, Functor cb ca right) => + Adjoint ca cb left right where + univ :: ca a (right b) -> cb (left a) b + couniv :: cb (left a) b -> ca a (right b) + + -- ideally, we'd also like to include the unit and counit of an adjunction + -- in this definition. These can be defined by: + -- unit = couniv identity + -- counit = univ identit + -- but, once again, the types for these turn out to be ambiguous; they + -- only determine the category in which the unit or counit (resp) lies, + -- not the intermediate category. + +-- the well-know categorical construction of an adjunction from a monad: ------ + +instance Monad fn m => Adjoint fn (Kleisli fn m) Id m where + univ = kleisliUniv + couniv = kleisliCouniv + +------------------------------------------------------------------------------- diff --git a/demos/Ccexamples/parsers.gs b/demos/Ccexamples/parsers.gs new file mode 100644 index 0000000..083d6d2 --- /dev/null +++ b/demos/Ccexamples/parsers.gs @@ -0,0 +1,183 @@ +------------------------------------------------------------------------------- +-- A variety of parsers, with the ability to use overloading to choose between +-- parsers by a top-level type signature: +-- +-- ? parse topExpr "1+2" :: [Int] ==> [3 +-- Program error: +-- Unexpected character `+' +-- ? parse topExpr "1+2" :: Maybe Int ==> Just 3 +-- ? parse topExpr "1+2" :: ParseResult Int ==> ParsedAs 3 +-- +-- ? parse topExpr "(1+2" :: [Int] ==> Program error: missing `)' +-- ? parse topExpr "(1+2" :: Maybe Int ==> Program error: missing `)' +-- ? parse topExpr "(1+2" :: ParseResult Int ==> ParseError "missing `)'" +-- +-- Mark P. Jones, April 12 1993 +------------------------------------------------------------------------------- + +infixr 7 `seq` +infixl 6 `pam`, `bind_` + +-- All parsers are constructed from a monad in the following way: ------------- + +type Parser m a = String -> m (a,String) + in mapP, resultP, bindP, zeroP, plusP, parse, lookahead, sat, errPE + +mapP :: Monad m => (a -> b) -> Parser m a -> Parser m b +mapP f p s = [ (f x, s') | ~(x,s') <- p s ] + +resultP :: Monad m => a -> Parser m a +resultP x s = result (x,s) + +bindP :: Monad m => Parser m a -> (a -> Parser m b) -> Parser m b +(p `bindP` q) s = p s `bind` \ ~(x,s') -> q x s' + +zeroP :: Monad0 m => Parser m a +zeroP s = zero + +plusP :: MonadPlus m => Parser m a -> Parser m a -> Parser m a +(p `plusP` q) s = p s ++ q s + +instance Monad m => Functor (Parser m) where + map = mapP + +instance Monad m => Monad (Parser m) where + result = resultP + bind = bindP + +instance Monad0 m => Monad0 (Parser m) where + zero = zeroP + +instance MonadPlus m => MonadPlus (Parser m) where + (++) = plusP + +class MonadPlus (Parser m) => ParseMonad m where + parseError :: String -> Parser m a + parseError s = error s -- the user really ought to use a monad that + -- provides a better defn than this if they + -- want to use parseError in real programs + +-- Auxiliary functions, using the definition of Parser: ----------------------- + +parse :: Monad m => Parser m a -> String -> m a +parse p s = [ x | ~(x,s') <- p s ] + +parse' p s = [ x | ~(x,s') <- p s ] + +lookahead :: Monad m => Parser m String +lookahead s = [ (s,s) ] + +sat :: Monad0 m => (Char -> Bool) -> Parser m Char +sat p [] = zero +sat p (h:ts) = [ (h,ts) | p h ] + +-- General utility functions: ------------------------------------------------- + +pam :: Functor f => f a -> (a -> b) -> f b +m `pam` f = map f m + +bind_ :: Monad m => m a -> m b -> m b +p `bind_` q = p `bind` const q + +seq :: Monad m => m a -> m b -> m (a,b) +p `seq` q = p `bind` \x -> q `bind` \y -> result (x,y) + +many :: MonadPlus m => m a -> m [a] +many p = q where q = (p `bind` \x -> q `bind` \xs -> result (x:xs)) + ++ + result [] + +many1 :: MonadPlus m => m a -> m [a] +many1 p = p `bind` \x -> many p `bind` \xs -> result (x:xs) + +tok :: ParseMonad m => String -> Parser m () +tok = foldr bind_ (result ()) . map (sat . (==)) + +-- Simple parsers, uncontrolled backtracking, list of parses: ----------------- + +instance ParseMonad [] + +-- The Maybe monad: ----------------------------------------------------------- + +data Maybe a = Just a | None + +instance Functor Maybe where + map f (Just x) = Just (f x) + map f None = None + +instance Monad Maybe where + result = Just + Just x `bind` f = f x + None `bind` f = None + +instance Monad0 Maybe where + zero = None + +instance MonadPlus Maybe where + None ++ y = y + Just x ++ y = Just x + +instance ParseMonad Maybe + +-- Simple parsers, uncontrolled backtracking, list of parses: ----------------- + +data ParseResult a = ParsedAs a + | ParseError String + | Backtrack + +instance Functor ParseResult where + map f (ParsedAs x) = ParsedAs (f x) + map f (ParseError msg) = ParseError msg + map f Backtrack = Backtrack + +instance Monad ParseResult where + result x = ParsedAs x + ParsedAs x `bind` f = f x + ParseError msg `bind` f = ParseError msg + Backtrack `bind` f = Backtrack + +instance Monad0 ParseResult where + zero = Backtrack + +instance MonadPlus ParseResult where + Backtrack ++ y = y + other ++ y = other + +errPE :: String -> Parser ParseResult a +errPE msg s = ParseError msg + +instance ParseMonad ParseResult where + parseError = errPE + +-- A silly grammar for arithmetic expressions: ------------------------------- + +topExpr, expr, term, atom, number, digit:: ParseMonad m => Parser m Int + +topExpr = expr `bind` \e -> + lookahead `bind` \s -> + if null s then result e + else parseError ("Unexpected character `"++[head s]++"'") + +expr = term `bind` \x -> + (tok "+" `bind_` expr `pam` (x+) ++ + tok "-" `bind_` expr `pam` (x-) ++ + result x) + +term = atom `bind` \x -> + (tok "*" `bind_` term `pam` (x*) ++ + tok "/" `bind_` term `pam` (x/) ++ + result x) + +atom = tok "-" `bind_` expr `pam` negate + ++ + tok "(" `bind_` expr `bind` (\n -> tok ")" `bind_` result n + ++ + parseError "missing `)'") + ++ + number + +number = many1 digit `pam` foldl1 (\a x -> 10*a+x) + +digit = sat isDigit `pam` \d -> ord d - ord '0' + +------------------------------------------------------------------------------- diff --git a/demos/Cse/csexpr.gs b/demos/Cse/csexpr.gs new file mode 100644 index 0000000..c207695 --- /dev/null +++ b/demos/Cse/csexpr.gs @@ -0,0 +1,378 @@ +-- This is a program to illustrate a simple form of common subexpression +-- elimination ... essentially turning trees into DAGs. Uses two state +-- monads (more precisely, same monad but different state types). +-- This program doesn't use constructor classes, although it could +-- obviously be modified to fit into that framework. +-- +-- This programs should be loaded after `stateMonad': For example: +-- ? :l stateMonad.gs csexpr.gs +-- ? test +-- +-- The output for this `test' is included at the end of the file. +-- +-- Mark P. Jones, 1992 +-- + +-- Data type definitions: ---------------------------------------------------- + +data GenTree a = Node a [GenTree a] +type LabGraph a = [ (Label, a, [Label]) ] +type Label = Int + +-- Add distinct (integer) labels to each node of a tree: --------------------- + +labelTree :: GenTree a -> GenTree (Label,a) +labelTree t = label t `startingWith` 0 + where label (Node x xs) = incr `bind` \n -> + mmapl label xs `bind` \ts -> + return (Node (n,x) ts) + +-- Convert tree after labelling each node to a labelled graph: --------------- + +ltGraph :: GenTree (Label,a) -> LabGraph a +ltGraph (Node (n,x) xs) = (n, x, map labelOf xs) : concat (map ltGraph xs) + where labelOf (Node (n,x) xs) = n + +-- Build tree from labelled graph: ------------------------------------------- + +unGraph :: LabGraph a -> GenTree a +unGraph ((n,x,cs):ts) = Node x (map (unGraph . find) cs) + where find c = dropWhile (\(d,_,_) -> c/=d) ts + + +-- Build tree but avoid duplicating shared parts: ---------------------------- + +unGraph' :: LabGraph String -> GenTree (Int,String) +unGraph' lg = ung lg `startingWith` [] + where ung ((n,x,cs):ts) = mif (visited n) + (return (Node (n,"<>") [])) + (mmapl (ung . find) cs `bind` \ts -> + return (Node (n,x) ts)) + where find c = dropWhile (\(d,_,_) -> c/=d) ts + +visited :: Label -> SM [Label] Bool +visited n = fetch `bind` \us -> + if n `elem` us then return True + else set (n:us) `bind` \_ -> + return False + +-- Find (and eliminate) repeated subtrees in a labelled graph: --------------- +-- Described as a transformation on labelled graphs: During the calculation +-- we use a pair (r,lg) :: (Label->Label, LabGraph a) where lg contains the +-- simplified portion of the graph calculated so far and r is a renaming (or +-- replacement?) which maps node labels in the original graph to the approp. +-- labels in the new graph. + +findCommon :: Eq a => LabGraph a -> LabGraph a +findCommon = snd . foldr sim (id,[]) + where sim (n,s,cs) (r,lg) = (r, [(n,s,rcs)]++lg), if null ms + = ((n +-> head ms) r, lg), otherwise + where ms = [m | (m,s',cs')<-lg, s==s', cs'==rcs] + rcs = map r cs + +infix +-> -- overide function at single point +(+->) :: Eq a => a -> b -> (a -> b) -> (a -> b) +(x +-> fx) f y = if x==y then fx else f y + +-- Common subexpression elimination: ----------------------------------------- + +cse :: Eq a => GenTree a -> LabGraph a +cse = findCommon . ltGraph . labelTree + +-- Pretty printers: ---------------------------------------------------------- + +instance Text (GenTree String) where + showsPrec d (Node x ts) + | null ts = showString x + | otherwise = showChar '(' . showString x + . showChar ' ' + . (foldr1 (\x y -> x . showChar ' ' . y) + (map shows ts)) + . showChar ')' + +drawTree :: GenTree String -> String +drawTree = unlines . draw +draw (Node x ts) = grp (s1 ++ pad width x ++ "]") (space (width+3)) (stLoop ts) + where stLoop [] = [""] + stLoop [t] = grp s2 " " (draw t) + stLoop (t:ts) = grp s3 s4 (draw t) ++ [s4] ++ rsLoop ts + + rsLoop [t] = grp s5 " " (draw t) + rsLoop (t:ts) = grp s6 s4 (draw t) ++ [s4] ++ rsLoop ts + + grp fst rst = zipWith (++) (fst:repeat rst) + + -- Define the strings used to print tree diagrams: + [s1,s2,s3,s4,s5,s6] | pcGraphics = ["\196[", "\196\196", "\196\194", + " \179", " \192", " \195"] + | otherwise = ["-[", "--", "-+", + " |", " `", " +"] + + pad n x = take n (x ++ repeat ' ') + width = 4 + pcGraphics = False + +showGraph :: LabGraph a -> String +showGraph [] = "[]\n" +showGraph xs = "[" ++ loop (map show' xs) + where loop [x] = x ++ "]\n" + loop (x:xs) = x ++ ",\n " ++ loop xs + +-- Examples: ----------------------------------------------------------------- + +plus x y = Node "+" [x,y] +mult x y = Node "*" [x,y] +prod xs = Node "X" xs +zero = Node "0" [] +a = Node "a" [] +b = Node "b" [] +c = Node "c" [] +d = Node "d" [] + +examples = [example0, example1, example2, example3, example4, example5] +example0 = a +example1 = plus a a +example2 = plus (mult a b) (mult a b) +example3 = plus (mult (plus a b) c) (plus a b) +example4 = prod (scanl plus zero [a,b,c,d]) +example5 = prod (scanr plus zero [a,b,c,d]) + +test = appendChan "stdout" -- writeFile "csoutput" + (unlines (map (\t -> let c = cse t + in copy 78 '-' ++ + "\nExpression:\n" ++ show t ++ + "\n\nTree:\n" ++ drawTree t ++ + "\nLabelled graph:\n" ++ showGraph c ++ + "\nSimplified tree:\n" ++ showCse c) + examples)) + exit + done + where + showCse = drawTree + . mapGenTree (\(n,s) -> show n++":"++s) + . unGraph' + mapGenTree f (Node x ts) = Node (f x) (map (mapGenTree f) ts) + +{----------------------------------------------------------------------------- +Expression: +a + +Tree: +-[a ] + +Labelled graph: +[(0,"a",[])] + +Simplified tree: +-[0:a ] + +------------------------------------------------------------------------------ +Expression: +(+ a a) + +Tree: +-[+ ]-+-[a ] + | + `-[a ] + +Labelled graph: +[(0,"+",[2, 2]), + (2,"a",[])] + +Simplified tree: +-[0:+ ]-+-[2:a ] + | + `-[2:<>] + +------------------------------------------------------------------------------ +Expression: +(+ (* a b) (* a b)) + +Tree: +-[+ ]-+-[* ]-+-[a ] + | | + | `-[b ] + | + `-[* ]-+-[a ] + | + `-[b ] + +Labelled graph: +[(0,"+",[4, 4]), + (4,"*",[5, 6]), + (5,"a",[]), + (6,"b",[])] + +Simplified tree: +-[0:+ ]-+-[4:* ]-+-[5:a ] + | | + | `-[6:b ] + | + `-[4:<>] + +------------------------------------------------------------------------------ +Expression: +(+ (* (+ a b) c) (+ a b)) + +Tree: +-[+ ]-+-[* ]-+-[+ ]-+-[a ] + | | | + | | `-[b ] + | | + | `-[c ] + | + `-[+ ]-+-[a ] + | + `-[b ] + +Labelled graph: +[(0,"+",[1, 6]), + (1,"*",[6, 5]), + (5,"c",[]), + (6,"+",[7, 8]), + (7,"a",[]), + (8,"b",[])] + +Simplified tree: +-[0:+ ]-+-[1:* ]-+-[6:+ ]-+-[7:a ] + | | | + | | `-[8:b ] + | | + | `-[5:c ] + | + `-[6:<>] + +------------------------------------------------------------------------------ +Expression: +(X 0 (+ 0 a) (+ (+ 0 a) b) (+ (+ (+ 0 a) b) c) (+ (+ (+ (+ 0 a) b) c) d)) + +Tree: +-[X ]-+-[0 ] + | + +-[+ ]-+-[0 ] + | | + | `-[a ] + | + +-[+ ]-+-[+ ]-+-[0 ] + | | | + | | `-[a ] + | | + | `-[b ] + | + +-[+ ]-+-[+ ]-+-[+ ]-+-[0 ] + | | | | + | | | `-[a ] + | | | + | | `-[b ] + | | + | `-[c ] + | + `-[+ ]-+-[+ ]-+-[+ ]-+-[+ ]-+-[0 ] + | | | | + | | | `-[a ] + | | | + | | `-[b ] + | | + | `-[c ] + | + `-[d ] + +Labelled graph: +[(0,"X",[21, 20, 19, 18, 17]), + (17,"+",[18, 25]), + (18,"+",[19, 24]), + (19,"+",[20, 23]), + (20,"+",[21, 22]), + (21,"0",[]), + (22,"a",[]), + (23,"b",[]), + (24,"c",[]), + (25,"d",[])] + +Simplified tree: +-[0:X ]-+-[21:0] + | + +-[20:+]-+-[21:<] + | | + | `-[22:a] + | + +-[19:+]-+-[20:<] + | | + | `-[23:b] + | + +-[18:+]-+-[19:<] + | | + | `-[24:c] + | + `-[17:+]-+-[18:<] + | + `-[25:d] + + +------------------------------------------------------------------------------ +Expression: +(X (+ a (+ b (+ c (+ d 0)))) (+ b (+ c (+ d 0))) (+ c (+ d 0)) (+ d 0) 0) + +Tree: +-[X ]-+-[+ ]-+-[a ] + | | + | `-[+ ]-+-[b ] + | | + | `-[+ ]-+-[c ] + | | + | `-[+ ]-+-[d ] + | | + | `-[0 ] + | + +-[+ ]-+-[b ] + | | + | `-[+ ]-+-[c ] + | | + | `-[+ ]-+-[d ] + | | + | `-[0 ] + | + +-[+ ]-+-[c ] + | | + | `-[+ ]-+-[d ] + | | + | `-[0 ] + | + +-[+ ]-+-[d ] + | | + | `-[0 ] + | + `-[0 ] + +Labelled graph: +[(0,"X",[1, 10, 17, 22, 25]), + (1,"+",[2, 10]), + (2,"a",[]), + (10,"+",[11, 17]), + (11,"b",[]), + (17,"+",[18, 22]), + (18,"c",[]), + (22,"+",[23, 25]), + (23,"d",[]), + (25,"0",[])] + +Simplified tree: +-[0:X ]-+-[1:+ ]-+-[2:a ] + | | + | `-[10:+]-+-[11:b] + | | + | `-[17:+]-+-[18:c] + | | + | `-[22:+]-+-[23:d] + | | + | `-[25:0] + | + +-[10:<] + | + +-[17:<] + | + +-[22:<] + | + `-[25:<] + +-}---------------------------------------------------------------------------- diff --git a/demos/Cse/stateMonad.gs b/demos/Cse/stateMonad.gs new file mode 100644 index 0000000..19be5d4 --- /dev/null +++ b/demos/Cse/stateMonad.gs @@ -0,0 +1,68 @@ +-- General purpose state monad ----------------------------------------------- + +type SM s a = s -> (s, a) + +-- Primitive monad operators ------------------------------------------------- + +return :: a -> SM s a +return x = \s -> (s, x) + +bind :: SM s a -> (a -> SM s b) -> SM s b +m `bind` f = \s -> let (s',a) = m s in f a s' + +join :: SM s (SM s a) -> SM s a +join m = \s -> let (s',ma) = m s in ma s' + +mmap :: (a -> b) -> (SM s a -> SM s b) +mmap f m = \s -> let (s',a) = m s in (s', f a) + +-- General monad operators --------------------------------------------------- + +mmapl :: (a -> SM s b) -> ([a] -> SM s [b]) +mmapl f [] = return [] +mmapl f (a:as) = f a `bind` \b -> + mmapl f as `bind` \bs -> + return (b:bs) + +mmapr :: (a -> SM s b) -> ([a] -> SM s [b]) +mmapr f [] = return [] +mmapr f (x:xs) = mmapr f xs `bind` \ys -> + f x `bind` \y -> + return (y:ys) + +mfoldl :: (a -> b -> SM s a) -> a -> [b] -> SM s a +mfoldl f a [] = return a +mfoldl f a (x:xs) = f a x `bind` \fax -> + mfoldl f fax xs + +mfoldr :: (a -> b -> SM s b) -> b -> [a] -> SM s b +mfoldr f a [] = return a +mfoldr f a (x:xs) = mfoldr f a xs `bind` \y -> + f x y + +mif :: SM s Bool -> SM s a -> SM s a -> SM s a +mif c t f = c `bind` \cond -> + if cond then t + else f + +-- Specific utilities for state monads --------------------------------------- + +startingWith :: SM s a -> s -> a +m `startingWith` v = answer where (final,answer) = m v + +fetch :: SM s s +fetch = \s -> (s,s) + +fetchWith :: (s -> a) -> SM s a +fetchWith f = \s -> (s, f s) + +update :: (s -> s) -> SM s s +update f = \s -> (f s, s) + +set :: s -> SM s s +set s' = \s -> (s',s) + +-- Common use of state monad: counter ---------------------------------------- + +incr :: SM Int Int +incr = update (1+) diff --git a/demos/Eliza/eliza.gs b/demos/Eliza/eliza.gs new file mode 100644 index 0000000..70c1dba --- /dev/null +++ b/demos/Eliza/eliza.gs @@ -0,0 +1,267 @@ +-- Eliza: an implementation of the classic pseudo-psychoanalyst --------------- +-- +-- Gofer version by Mark P. Jones, January 12 1992 +-- +-- Adapted from a pascal implementation provided as part of an experimental +-- package from James Risner (risner@ms.uky.edu), Univ. of KY. with original +-- pascal code apparently provided by Robert Migliaccio (mig@ms.uky.edu). +------------------------------------------------------------------------------- + +main = eliza + +eliza :: Dialogue +eliza = interact (("\n\ + \Hi! I'm Eliza. I am your personal therapy computer.\n\ + \Please tell me your problem.\n\ + \\n" ++) + . session initial [] + . filter (not.null) + . map (words . trim) + . lines) + +trim :: String -> String -- strip punctuation characters +trim = foldr cons "" . dropWhile (`elem` punct) + where x `cons` xs | x `elem` punct && null xs = [] + | otherwise = x : xs + punct = [' ', '.', '!', '?', ','] + +-- Read a line at a time, and produce some kind of response ------------------- + +session :: State -> Words -> [Words] -> String +session rs prev [] = [] +session rs prev (l:ls) = response ++ "\n\n" ++ session rs' l ls + where (response, rs') | prev == l = repeated rs + | otherwise = answer rs l + +answer :: State -> Words -> (String, State) +answer st l = (response, newKeyTab kt st) + where (response, kt) = ans (keyTabOf st) + e `cons` (r, es) = (r, e:es) + ans (e:es) | null rs = e `cons` ans es + | otherwise = (makeResponse a (head rs), (key,as):es) + where rs = replies key l + (key,(a:as)) = e + +-- Find all possible replies (without leading string for given key ------------ + +replies :: Words -> Words -> [String] +replies key l = ( map (conjugate l . drop (length key)) + . filter (prefix key . map ucase) + . tails) l + +prefix :: Eq a => [a] -> [a] -> Bool +[] `prefix` xs = True +(x:xs) `prefix` [] = False +(x:xs) `prefix` (y:ys) = x==y && (xs `prefix` ys) + +tails :: [a] -> [[a]] -- non-empty tails of list +tails [] = [] +tails xs = xs : tails (tail xs) + +ucase :: String -> String -- map string to upper case +ucase = map toUpper + +-- Replace keywords in a list of words with appropriate conjugations ---------- + +conjugate :: Words -> Words -> String +conjugate d = unwords . trailingI . map conj . maybe d -- d is default input + where maybe d xs = if null xs then d else xs + conj w = head ([m | (w',m)<-conjugates, uw==w'] ++ [w]) + where uw = ucase w + trailingI = foldr cons [] + where x `cons` xs | x=="I" && null xs = ["me"] + | otherwise = x:xs + +conjugates :: [(Word, Word)] +conjugates = prepare (oneways ++ concat [[(x,y), (y,x)] | (x,y) <- bothways]) + where oneways = [ ("me", "you") ] + bothways = [ ("are", "am"), ("we're", "was"), + ("you", "I"), ("your", "my"), + ("I've", "you've"), ("I'm", "you're") ] + prepare = map (\(w,r) -> (ucase w, r)) + +-- Response data -------------------------------------------------------------- + +type Word = String +type Words = [Word] +type KeyTable = [(Key, Replies)] +type Replies = [String] +type State = (KeyTable, Replies) +type Key = Words + +repeated :: State -> (String, State) +repeated (kt, (r:rp)) = (r, (kt, rp)) + +newKeyTab :: KeyTable -> State -> State +newKeyTab kt' (kt, rp) = (kt', rp) + +keyTabOf :: State -> KeyTable +keyTabOf (kt, rp) = kt + +makeResponse :: String -> String -> String +makeResponse ('?':cs) us = cs ++ " " ++ us ++ "?" +makeResponse ('.':cs) us = cs ++ " " ++ us ++ "." +makeResponse cs us = cs + +initial :: State +initial = ([(words k, cycle rs) | (k,rs) <-respMsgs], cycle repeatMsgs) + +repeatMsgs = [ "Why did you repeat yourself?", + "Do you expect a different answer by repeating yourself?", + "Come, come, elucidate your thoughts.", + "Please don't repeat yourself!" ] + +respMsgs = [ ("CAN YOU", canYou), + ("CAN I", canI), + ("YOU ARE", youAre), + ("YOU'RE", youAre), + ("I DON'T", iDont), + ("I FEEL", iFeel), + ("WHY DON'T YOU", whyDont), + ("WHY CAN'T I", whyCant), + ("ARE YOU", areYou), + ("I CAN'T", iCant), + ("I AM", iAm), + ("I'M", iAm), + ("YOU", you), + ("YES", yes), + ("NO", no), + ("COMPUTER", computer), + ("COMPUTERS", computer), + ("I WANT", iWant), + ("WHAT", question), + ("HOW", question), + ("WHO", question), + ("WHERE", question), + ("WHEN", question), + ("WHY", question), + ("NAME", name), + ("BECAUSE", because), + ("CAUSE", because), + ("SORRY", sorry), + ("DREAM", dream), + ("DREAMS", dream), + ("HI", hello), + ("HELLO", hello), + ("MAYBE", maybe), + ("YOUR", your), + ("ALWAYS", always), + ("THINK", think), + ("ALIKE", alike), + ("FRIEND", friend), + ("FRIENDS", friend), + ("", nokeyMsgs) ] + where + canYou = [ "?Don't you believe that I can", + "?Perhaps you would like to be able to", + "?You want me to be able to" ] + canI = [ "?Perhaps you don't want to", + "?Do you want to be able to" ] + youAre = [ "?What makes you think I am", + "?Does it please you to believe I am", + "?Perhaps you would like to be", + "?Do you sometimes wish you were" ] + iDont = [ "?Don't you really", + "?Why don't you", + "?Do you wish to be able to", + "Does that trouble you?" ] + iFeel = [ "Tell me more about such feelings.", + "?Do you often feel", + "?Do you enjoy feeling" ] + whyDont = [ "?Do you really believe I don't", + ".Perhaps in good time I will", + "?Do you want me to" ] + whyCant = [ "?Do you think you should be able to", + "?Why can't you" ] + areYou = [ "?Why are you interested in whether or not I am", + "?Would you prefer if I were not", + "?Perhaps in your fantasies I am" ] + iCant = [ "?How do you know you can't", + "Have you tried?", + "?Perhaps you can now" ] + iAm = [ "?Did you come to me because you are", + "?How long have you been", + "?Do you believe it is normal to be", + "?Do you enjoy being" ] + you = [ "We were discussing you --not me.", + "?Oh,", + "You're not really talking about me, are you?" ] + yes = [ "You seem quite positive.", + "Are you Sure?", + "I see.", + "I understand." ] + no = [ "Are you saying no just to be negative?", + "You are being a bit negative.", + "Why not?", + "Are you sure?", + "Why no?" ] + computer = [ "Do computers worry you?", + "Are you talking about me in particular?", + "Are you frightened by machines?", + "Why do you mention computers?", + "What do you think machines have to do with your problems?", + "Don't you think computers can help people?", + "What is it about machines that worries you?" ] + iWant = [ "?Why do you want", + "?What would it mean to you if you got", + "?Suppose you got", + "?What if you never got", + ".I sometimes also want" ] + question = [ "Why do you ask?", + "Does that question interest you?", + "What answer would please you the most?", + "What do you think?", + "Are such questions on your mind often?", + "What is it that you really want to know?", + "Have you asked anyone else?", + "Have you asked such questions before?", + "What else comes to mind when you ask that?" ] + name = [ "Names don't interest me.", + "I don't care about names --please go on." ] + because = [ "Is that the real reason?", + "Don't any other reasons come to mind?", + "Does that reason explain anything else?", + "What other reasons might there be?" ] + sorry = [ "Please don't apologise!", + "Apologies are not necessary.", + "What feelings do you have when you apologise?", + "Don't be so defensive!" ] + dream = [ "What does that dream suggest to you?", + "Do you dream often?", + "What persons appear in your dreams?", + "Are you disturbed by your dreams?" ] + hello = [ "How do you...please state your problem." ] + maybe = [ "You don't seem quite certain.", + "Why the uncertain tone?", + "Can't you be more positive?", + "You aren't sure?", + "Don't you know?" ] + your = [ "?Why are you concerned about my", + "?What about your own" ] + always = [ "Can you think of a specific example?", + "When?", + "What are you thinking of?", + "Really, always?" ] + think = [ "Do you really think so?", + "?But you are not sure you", + "?Do you doubt you" ] + alike = [ "In what way?", + "What resemblence do you see?", + "What does the similarity suggest to you?", + "What other connections do you see?", + "Cound there really be some connection?", + "How?" ] + friend = [ "Why do you bring up the topic of friends?", + "Do your friends worry you?", + "Do your friends pick on you?", + "Are you sure you have any friends?", + "Do you impose on your friends?", + "Perhaps your love for friends worries you." ] + + nokeyMsgs = [ "I'm not sure I understand you fully.", + "What does that suggest to you?", + "I see.", + "Can you elaborate on that?", + "Say, do you have any psychological problems?" ] + +------------------------------------------------------------------------------- diff --git a/demos/Expert/Knowledge.hs b/demos/Expert/Knowledge.hs new file mode 100644 index 0000000..53b3b9e --- /dev/null +++ b/demos/Expert/Knowledge.hs @@ -0,0 +1,83 @@ +{------------------------------------------------------------------------------ + KNOWLEDGE + +Knowledge, in the form of sentences and phrases with variables in them, is +represented using a tree structure. Simple parsers are provided for rules, +goals, relations and nouns. Functions are provided for converting a text file +into a table of definitions and for accessing the table. +------------------------------------------------------------------------------} + +module Knowledge where +import Result +import Table + +-- The type `Phrase' is a tree-like data structure for storing sentences and +-- phrases. A phrase is usually a term consisting of a word with a list of +-- subphrases. Variables are picked out separately as they have a special role, +-- and a function is provided for extracting a duplicate-free list of the names +-- of the variables in a phrase. Variable names start with capital letters. A +-- single type is used rather than separate types for rules, goals, relations +-- and so on to make it easier to write the matching and searching modules. + +data Phrase = Term String [Phrase] | Var String + +vars p = nub (names p) where + names (Var x) = [x] + names (Term x ps) = concat [names p | p <- ps] + +-- The display function `showPhrase' assumes that the only phrases are +-- variables, nouns, and pairs of subphrases with joining words between them. + +showPhrase (Var x) = x +showPhrase (Term x []) = x +showPhrase (Term op [p1,p2]) = + showPhrase p1 ++ " " ++ op ++ " " ++ showPhrase p2 + +-- Each parser takes a list of words and returns a Phrase. The parsers for +-- rules, goals and relations involve finding the joining word and the two +-- lists of words on either side with `split', and then parsing the two lists. +-- A rule is a relation and a goal joined by `if'. A goal is a collection of +-- relations joined by `and' and `or', with `and' binding tighter. A relation +-- is two nouns joined by a verb, and a noun is a word, perhaps preceded by +-- `a', `an' or `the' for readability. These parsers are neither very general +-- (no brackets, for instance) nor very efficient, nor do they detect errors. + +rule ws = split ws relation "if" goal + +goal ws + | elem "or" ws = split ws goal "or" goal + | elem "and" ws = split ws goal "and" goal + | otherwise = relation ws + +relation ws = + split ws noun verb noun where + verb = head [w | w<-ws, elem w verbs] + verbs = ["is","describes","has","can","eats"] + +noun [a,x] | elem a ["a","an","the"] = noun [a++" "++x] +noun [x] | ('A' <= head x) && (head x <= 'Z') = Var x +noun [x] = Term x [] + +split ws f op g = + Term op [f lhs, g rhs] + where + lhs = takeWhile (/=op) ws + rhs = tail (dropWhile (/=op) ws) + +-- The `definitions' function takes a list of text lines and converts it into a +-- table of definitions. Each entry is a verb, together with the rules which +-- are define that verb. Each verb is either completely defined in the table +-- (eg `is', `describes') or is completely undefined so that the user has to be +-- asked (eg `has', `eats'). The `relevant' function extracts from the table +-- the list of rules which are relevant to a given relation. + +definitions ls = + updateList newTable [(v, def v) | v<-verbs] where + def v = [r | r<-rs, verb r == v] + verbs = nub [verb r | r<-rs] + verb (Term "if" [Term v ns, g]) = v + rs = [rule (words l) | l<-ls] + +relevant defs (Term v ns) = + if fails lookup then [] else answer lookup where + lookup = find defs v diff --git a/demos/Expert/Main.hs b/demos/Expert/Main.hs new file mode 100644 index 0000000..61a0895 --- /dev/null +++ b/demos/Expert/Main.hs @@ -0,0 +1,89 @@ +{------------------------------------------------------------------------------ + EXPERT SYSTEM + +This prototype expert system program uses the modules `result.g', `table.g', +`knowledge.g', `match.g' and `search.g'. The main program reads in the file +`animals', treats the first line as the main goal to be solved, and converts +the remaining lines into the table of definitions representing the permanent +knowledge about the problem area. The program then solves the main goal and +displays the questions and solutions to the user, using the answers to the +questions to continue the search for solutions. Each answer should be `yes' or +`no'. After each solution, the user is asked whether the solution is adequate +or whether the search should be continued for alternative solutions. +------------------------------------------------------------------------------} + +module Main where +import Result +import Table +import Knowledge +import Match +import Search + +-- The `main' function reads in the data file before interacting with user. +-- The `process' function takes the contents of the file and the input from the +-- user and produces the output. It builds an initial goal and a definition +-- table from the file contents, and an information table from the user's +-- input, and calls the `solve' function. The list of questions and solutions +-- from this call is stripped to remove duplicate questions, and displayed as +-- output. The questions are also extracted and used to help build the +-- information table which contains question-and-answer pairs. + +main rs = + GetProgName : GetArgs : + let (r0:r1:rrs) = rs in + case r1 of + StrList [filename] -> getData filename rrs + StrList [] -> getData "animals" rrs + StrList args -> case r0 of + Str prog -> [AppendChan stderr ("Usage: " ++ prog ++ " datafile\n")] + Failure _ -> [] + +getData filename rs = + ReadFile filename : + let (r:rrs) = rs in + case r of + Failure ioerr -> [AppendChan stderr + ("Unable to read file " ++ filename ++ "\n")] + Str contents -> interact (process contents) rrs + +process contents input = + "Solving: " ++ showPhrase problem ++ "\n" ++ + display results (vars problem) replies + where + problem = goal (words (head (lines contents))) + defs = definitions (tail (lines contents)) + info = enterList newTable [(q,a) | (Question q, a) <- zip results replies] + replies = [words l /= ["no"] | l <- lines input] + db = (defs,info) + newsoln = Soln newTable ['X' : show n | n<-[0..]] + results = strip [] (solve db newsoln problem) + +-- The `strip' function takes the list of questions and solutions from the main +-- call to `solve' and removes all but the first occurrence of each question, +-- to make sure that the user is not asked the same question twice. The first +-- argument is a list of the questions seen so far. + +strip qs [] = [] +strip qs (Question q : rs) = + if elem q qs then strip qs rs else + Question q : strip (q:qs) rs +strip qs (soln:rs) = soln : strip qs rs + +-- The display function displays a list of questions and solutions as a +-- character stream. It also takes the list of variable names in the original +-- goal to interpret solution environments using `showVars', and the list of +-- answers from the user to determine whether to continue displaying more +-- solutions. + +display [] xs as = "No (more) solutions\n" +display (Question q : rs) xs as = + "Is it true that " ++ q ++ "?\n" ++ display rs xs (tail as) +display (Soln env vs : rs) xs as = + "Solution: " ++ sol ++ ". More?\n" ++ etc where + sol = showVars env xs + etc = if as == [] || head as == False then "" else display rs xs (tail as) + +showVars env vs = + foldr1 join (map showVar vs) where + join x y = x ++ "; " ++ y + showVar v = v ++ " = " ++ showPhrase (subst env (Var v)) diff --git a/demos/Expert/Makefile b/demos/Expert/Makefile new file mode 100644 index 0000000..5d6010a --- /dev/null +++ b/demos/Expert/Makefile @@ -0,0 +1,25 @@ +# Two ways to compile the expert system, one with gofer and one with hbc: + +expert: Result.hs Table.hs Knowledge.hs Match.hs Search.hs Main.hs + goferc + expert.prj + +expert2: Result.o Table.o Knowledge.o Match.o Search.o Main.o + hbc -o expert2 *.o + +Result.o: Result.hs + hbc -c Result.hs + +Table.o: Table.hs Result.o + hbc -c Table.hs + +Knowledge.o: Knowledge.hs Table.o Result.o + hbc -c Knowledge.hs + +Match.o: Match.hs Knowledge.o Table.o Result.o + hbc -c Match.hs + +Search.o: Search.hs Match.o Knowledge.o Table.o Result.o + hbc -c Search.hs + +Main.o: Main.hs Search.o Match.o Knowledge.o Table.o Result.o + hbc -c Main.hs diff --git a/demos/Expert/Match.hs b/demos/Expert/Match.hs new file mode 100644 index 0000000..45eb8d3 --- /dev/null +++ b/demos/Expert/Match.hs @@ -0,0 +1,70 @@ +{------------------------------------------------------------------------------ + MATCHING + +This module provides a `match' function which implements the famous unification +algorithm. It takes a pair of `patterns', ie structures with variables in them, +matches them against each other, and extracts information about the values +which variables must have in order for the match to be successful. For example, +if `X has stripes' is matched against `Y has Z' then the match is successful, +and the information X=Y and Z=stripes is gleaned. The information about +variables is stored using the `Environment' type; a table which maps variable +names to phrases. The exports from this module are the `Environment' type and +the `match' function. +------------------------------------------------------------------------------} + +module Match where +import Result +import Table +import Knowledge + +-- The `Environment' type stores information about variables. The `subst' +-- function is used whenever a phrase contains variables about which +-- information may be known. The variables in the phrase are (recursively) +-- substituted by their values in the given environment. + +type Environment = Table String Phrase + +subst env (Term x ps) = Term x [subst env p | p<-ps] +subst env (Var x) = + if fails lookup then (Var x) else subst env (answer lookup) where + lookup = find env x + +-- The `match' function substitutes any known information about the variables +-- in its argument patterns before comparing them with `compare'. The +-- `matchList' function deals with a list of pairs of patterns which need to be +-- matched. The information gleaned from each pair is used in matching the +-- next, and the final result contains all the information. + +match env p1 p2 = compare env (subst env p1) (subst env p2) + +matchList env [] = success env +matchList env ((p1,p2):pairs) = + if fails res then res else matchList (answer res) pairs where + res = match env p1 p2 + +-- The `compare' function is the heart of the algorithm. It compares two +-- phrases and updates the given environment accordingly. For normal terms, it +-- compares the joining words. If these are equal, then it compares +-- corresponding pairs of subphrases. If one or other of the phrases is a +-- variable, then it makes a suitable entry in the environment. + +compare env (Term x1 ps1) (Term x2 ps2) + | x1 == x2 = matchList env (zip ps1 ps2) + | otherwise = failure "no match" +compare env (Var x) (Var y) + | x /= y = success (update env x (Var y)) + | otherwise = success env +compare env (Var x) p + | not (occurs (Var x) p) = success (update env x p) + | otherwise = failure "occurs check failed" +compare env p (Var x) = + compare env (Var x) p + +-- The `occurs' check makes sure that a variable does not itself occur in the +-- phrase which it is being set equal to. For example, if X were being set +-- equal to `the animal eats X', then there would be no solution for X, +-- indicating some sort of logical error. + +occurs v (Term x ps) = or [occurs v p | p<-ps] +occurs (Var y) (Var x) = y == x +occurs p (Var x) = False diff --git a/demos/Expert/README b/demos/Expert/README new file mode 100644 index 0000000..e2777aa --- /dev/null +++ b/demos/Expert/README @@ -0,0 +1,25 @@ +This is a minimal expert system, intended as a vehicle for discussing the +unification and inference algorithms, and as an example of using functional +programming for artificial intelligence applications. + +One particularly interesting feature is the use of the request/response stream +and lazy table techniques to allow the inference algorithm to ask questions and +get answers from the user while in the middle of a search. + +Of course, compared to the use of logic programming for such a task, the +algorithms have to be much more explicit and the program will run much slower, +because unification and inference aren't built-in (although they could be). On +the other hand, the program is purely declarative, whereas expert system +programs written in logic programming languages are usually very far from +declarative (and very far from being understandable or provable). + +The program was translated and adapted from the version in: + + Functional programming with Miranda + Ian Holyer, Pitman 1991 + +It can be interpreted with gofer (using project file `expert.prj') or it can be +compiled with gofer, hbc or ghc (using `Makefile'). + +Ian Holyer +March 1993 diff --git a/demos/Expert/Result.hs b/demos/Expert/Result.hs new file mode 100644 index 0000000..cfd3ee4 --- /dev/null +++ b/demos/Expert/Result.hs @@ -0,0 +1,53 @@ +{------------------------------------------------------------------------------ + RESULTS + +RESULTS which may succeed or fail can be represented in two ways, both of which +have important advantages. When only one possible answer is expected, a tagged +union allows a value of one type (the answer) to be returned in the case of +success, and a value of a different type (a reason) to be returned in case of +failure. The Result type is presented here as an (abstract) type with the +following functions: + + success a creates a value representing a successful result with value a + succeeds x tests a result to see if it is successful + answer x extracts the answer from a successful result + + failure r creates a failure value with reason r + fails x tests a result to see if it is a failure + reason x extracts the reason from a failed result + +There is a potential confusion with the constructors Success and Failure which +are used by the IO Response type. The Answer and Reason constructors here are +not intended to be used directly in programs. +------------------------------------------------------------------------------} + +module Result where + +data Result a r = Answer a | Reason r + + +success a = Answer a + +succeeds (Answer a) = True +succeeds _ = False + +answer (Answer a) = a + + +failure r = Reason r + +fails = not . succeeds + +reason (Reason r) = r + + +-- The second representation of results, invaluable for use in search +-- algorithms which may produce many answers, is as a list of successful +-- answers. There is no provision for a reason to be given in the case of +-- failure, which is represented by []. The `answers' function converts from +-- the above representation to the new one, otherwise normal list operations +-- are used (eg `null' to test for failure). + + +answers (Answer a) = [a] +answers _ = [] diff --git a/demos/Expert/Search.hs b/demos/Expert/Search.hs new file mode 100644 index 0000000..f6a27e3 --- /dev/null +++ b/demos/Expert/Search.hs @@ -0,0 +1,89 @@ +{------------------------------------------------------------------------------ + SEARCHING + +The `solve' function is the logical inference mechanism which allows the expert +system to search for solutions to goals, by making deductions from the stored +definitions and from the answers to the questions which it asks the user. This +is essentially the same as the inference mechanism which is built into logic +programming languages, with two main differences. The first is that the search +algorithm has to be programmed explicitly, and the second is that interaction +with the user cannot be handled as a side effect; questions are returned as +part of the result, and answers are fed in as part of the argument. +------------------------------------------------------------------------------} + +module Search where +import Result +import Table +import Knowledge +import Match + +-- A call to `solve' returns a list of solutions and questions of type +-- `Solution'. Each solution will be preceded by the questions to which `solve' +-- needs answers in order to form that solution, and the answers to these +-- questions are passed to `solve' in its database argument. A solution +-- consists of an environment giving information about variables, and a list of +-- variable names which are not mentioned in the environment and are therefore +-- available for general use. In particular, the search procedure often calls +-- for a copy of a goal to be made using fresh variables, and the `freshCopy' +-- function performs this, returning a modified solution along with the copy. + +data Solution = Soln Environment [String] | Question String + +freshCopy (Soln env vs) p = + ((Soln env (drop n vs)), subst tab p) where + tab = updateList newTable (zip xs [Var v | v <- take n vs]) + xs = vars p + n = length xs + +-- The arguments to `solve' are: a database of stored definitions and +-- information gained from answers to questions, a partial solution +-- representing the information gained about variables so far in the search, +-- and a goal to be satisfied. The first equation allows questions which are +-- generated deep within the search to be passed up and out in the main +-- solution stream. Compound goals are solved by solving the two subgoals and +-- combining the solutions. In the case of `and', information gained in each +-- solution to the first subgoal is used in solving the second. A simple goal +-- (a relation) is solved either by consulting the stored definitions, or by +-- asking the user a question, depending on the verb in that relation. + +solve db (Question q) g = [Question q] + +solve db soln (Term "or" [g1,g2]) = + solve db soln g1 ++ solve db soln g2 + +solve db soln (Term "and" [g1,g2]) = + concat [solve db res g2 | res <- solve db soln g1] + +solve db soln g = + if not (null rs) then lookup db soln g rs else ask info soln g + where + (defs,info) = db + rs = relevant defs g + +-- To `lookup' a simple goal using the list of rules `rs', a fresh copy of each +-- rule is made (to avoid name clashes with variables about which information +-- is already known), and `try' is used to see if the left hand side of the +-- rule matches the goal. If it does, the goal on the right hand side of the +-- rule is used to continue the search for solutions. + +lookup db soln g rs = + concat [try db soln' g r' | (soln',r') <- copies] where + copies = [freshCopy soln r | r<-rs] + +try db (Soln env vs) g (Term "if" [p,newg]) = + if fails m then [] else solve db (Soln (answer m) vs) newg + where + m = match env g p + +-- If the solver must ask a question then that question is returned in the list +-- of solutions. The answer is then looked up in the table `info' of +-- questions-and-answers passed as an argument. If the answer is `yes', then +-- the current partial solution is returned. This assumes that questions +-- contain no variables, eg `the animal has stripes?'. Note that, as with other +-- interactive i/o functions, `ask' must return the question before testing the +-- answer. + +ask info (Soln env vs) g = + Question (showPhrase (subst env g)) : + if ans then [Soln env vs] else [] where + ans = answer (find info (showPhrase (subst env g))) diff --git a/demos/Expert/Table.hs b/demos/Expert/Table.hs new file mode 100644 index 0000000..c93130b --- /dev/null +++ b/demos/Expert/Table.hs @@ -0,0 +1,118 @@ +{------------------------------------------------------------------------------ + TABLES + +A Table is a set of entries, each containing a key and an associated value, the +key being used to look up the value. + +In database-style applications, the value may be a record, and the key may be a +field in it. The normal effect of sharing of subexpressions should avoid +serious space problems. However, `computed' keys may cause a space problem. + +Keys are assumed to be unique. The effect of non-unique keys can be obtained by +associated a list value such as [v1,v2,...] with each key. + +With the `enterList' function, the first entry for a key takes precedence over +any later ones with the same key. This allows a table to be built `lazily', the +entries in the list only being evaluated as needed to satisfy `find' calls. + +REQUIREMENTS: + The results module `result.g' must be loaded before this one. + The key type must be ordered (an instance of class Ord). + +EXPORTS: + Table k v the type of tables; k and v are the key and value types + newTable an empty table + enter t k v add entry to t (no effect if old entry for k exists) + enterList t es add a list of (key,val) pairs to t + update t k v change entry in t (or add new entry if necessary) + updateList t es change a list of (key,val) pairs in t + find t k lookup k in t giving (success v) or (failure "not found") + delete t k remove entry in t for key k (if any) + entries t return list of all (key,val) pairs in t in key order +------------------------------------------------------------------------------} + +module Table where +import Result + +-- The implementation here uses a binary search tree, giving `log n' time +-- operations, provided that the tree remains well-balanced. Eventually, there +-- should be a constant-time version with the same semantics. + +data Table k v = Empty | Fork (Table k v) (k,v) (Table k v) + +newTable = Empty + +find Empty key = failure "not found" +find (Fork left (k,v) right) key + | key < k = find left key + | key == k = success v + | key > k = find right key + +enter Empty key val = Fork Empty (key,val) Empty +enter (Fork left (k,v) right) key val + | key < k = Fork (enter left key val) (k,v) right + | key == k = Fork left (k,v) right + | key > k = Fork left (k,v) (enter right key val) + +update Empty key val = Fork Empty (key,val) Empty +update (Fork left (k,v) right) key val + | key < k = Fork (update left key val) (k,v) right + | key == k = Fork left (key,val) right + | key > k = Fork left (k,v) (update right key val) + +delete Empty key = Empty +delete (Fork left (k,v) right) key + | key < k = Fork (delete left key) (k,v) right + | key == k = graft left right + | key > k = Fork left (k,v) (delete right key) + where + graft left Empty = left + graft left right = Fork left e right' where (e,right') = leftmost right + leftmost (Fork Empty e r) = (e,r) + leftmost (Fork l e r) = (e2, Fork l' e r) where (e2,l') = leftmost l + +-- `enterList t es' adds a list of new entries. It is lazy in es (but may build +-- a poorly balanced tree). + +enterList t [] = t +enterList Empty (e:res) = Fork left e right where + k = fst e + left = enterList Empty [e1 | e1<-res, fst e1 < k] + right = enterList Empty [e1 | e1<-res, fst e1 > k] +enterList (Fork left e right) es = Fork left' e right' where + k = fst e + left' = enterList left [e1 | e1<-es, fst e1 < k] + right' = enterList right [e1 | e1<-es, fst e1 > k] + +-- `updateList t es' makes a list of updates. It is strict in es, and optimised +-- to produce a well balanced tree. it can be used with es==[] purely to +-- rebalance the tree. + +updateList t es = balance (mergeKey (entries t) (unique (sortKey es))) where + balance [] = Empty + balance es = Fork left (es!!m) right where + left = balance (take m es) + right = balance (drop (m+1) es) + m = length es `div` 2 + unique [] = [] + unique [e] = [e] + unique ((k1,v1):(k2,v2):res) = + if k1==k2 then unique ((k2,v2):res) else (k1,v1) : unique ((k2,v2):res) + +sortKey kvs = foldr insertKey [] kvs where + insertKey kv [] = [kv] + insertKey (k1,v1) ((k2,v2):res) + | k1 <= k2 = (k1,v1):(k2,v2):res + | otherwise = (k2,v2):insertKey (k1,v1) res + +mergeKey [] kvs = kvs +mergeKey kvs [] = kvs +mergeKey ((k1,v1):kvs1) ((k2,v2):kvs2) + | k1 <= k2 = (k1,v1) : mergeKey kvs1 ((k2,v2):kvs2) + | otherwise = (k2,v2) : mergeKey ((k1,v1):kvs1) kvs2 + +-- `entries t' returns the list of entries in t, sorted by key. Inefficient +-- unless tree-optimised version of ++ is used. + +entries Empty = [] +entries (Fork left e right) = entries left ++ [e] ++ entries right diff --git a/demos/Expert/animals b/demos/Expert/animals new file mode 100644 index 0000000..c8cf4ca --- /dev/null +++ b/demos/Expert/animals @@ -0,0 +1,9 @@ +the animal is X +X is a zebra if X has stripes and X has hooves +X is a tiger if X has stripes and X has claws +X is a dog if mammal describes X and X can bark +X is a cat if mammal describes X and X can mieow +mammal describes X if X has hair or X has milk +X is a bird if X has feathers +X is a bird if X can fly and X has eggs +X is a fish if X can swim and X has fins diff --git a/demos/Expert/expert.prj b/demos/Expert/expert.prj new file mode 100755 index 0000000..d558fae --- /dev/null +++ b/demos/Expert/expert.prj @@ -0,0 +1 @@ +Result.hs Table.hs Knowledge.hs Match.hs Search.hs Main.hs diff --git a/demos/IO/ldfs.gs b/demos/IO/ldfs.gs new file mode 100644 index 0000000..1f1a3a2 --- /dev/null +++ b/demos/IO/ldfs.gs @@ -0,0 +1,256 @@ +------------------------------------------------------------------------------ +-- Here is a version of the graph algorithms described in: +-- +-- Lazy Depth-First Search and Linear Graph Algorithms in Haskell +-- David King and John Launchbury +-- +-- Together with some additional code for printing tree structures ... +-- +-- This program requires array.gs, iomonad.gs, and ioarray.gs to run. +-- For example, in the demos/IO directory, try: +-- +-- :load ../../array.gs ../../iomonad.gs ../../ioarray.gs ldfs.gs +-- +-- Of course, it would be sensible to put these things in a project file! +-- +------------------------------------------------------------------------------ + +type Vertex = Char + +-- Representing graphs: + +type Table a = Array Vertex a +type Graph = Table [Vertex] + +vertices :: Graph -> [Vertex] +vertices = indices + +type Edge = Assoc Vertex Vertex + +edges :: Graph -> [Edge] +edges g = [ v := w | v <- vertices g, w <- g!v ] + +mapT :: (Vertex -> a -> b) -> Table a -> Table b +mapT f t = array (bounds t) [ v := f v (t!v) | v <- indices t ] + +type Bounds = (Vertex, Vertex) + +outdegree :: Graph -> Table Int +outdegree = mapT numEdges + where numEdges v ws = length ws + +buildG :: Bounds -> [Edge] -> Graph +buildG = accumArray (flip (:)) [] + +graph = buildG ('a','j') + (reverse + [ 'a' := 'b', 'a' := 'f', 'b' := 'c', + 'b' := 'e', 'c' := 'a', 'c' := 'd', + 'e' := 'd', 'g' := 'h', 'g' := 'j', + 'h' := 'f', 'h' := 'i', 'h' := 'j' ] + ) + +transposeG :: Graph -> Graph +transposeG g = buildG (bounds g) (reverseE g) + +reverseE :: Graph -> [Edge] +reverseE g = [ w := v | (v := w) <- edges g ] + +indegree :: Graph -> Table Int +indegree = outdegree . transposeG + + +-- Depth-first search + +-- Specification and implementation of depth-first search: + +data Tree a = Node a (Forest a) +type Forest a = [Tree a] + +dff :: Graph -> Forest Vertex +dff g = dfs g (vertices g) + +dfs :: Graph -> [Vertex] -> Forest Vertex +dfs g vs = prune (bounds g) (map (generate g) vs) + +generate :: Graph -> Vertex -> Tree Vertex +generate g v = Node v (map (generate g) (g!v)) + +type Set s = MutArr s Vertex Bool + +mkEmpty :: Bounds -> ST s (Set s) +mkEmpty bnds = newArr bnds False + +contains :: Set s -> Vertex -> ST s Bool +contains m v = readArr m v + +include :: Set s -> Vertex -> ST s () +include m v = writeArr m v True + +prune :: Bounds -> Forest Vertex -> Forest Vertex +prune bnds ts = runST (mkEmpty bnds `thenST` \m -> + chop m ts) + +chop :: Set s -> Forest Vertex -> ST s (Forest Vertex) +chop m [] = returnST [] +chop m (Node v ts : us) + = contains m v `thenST` \visited -> + if visited then + chop m us + else + include m v `thenST` \_ -> + chop m ts `thenST` \as -> + chop m us `thenST` \bs -> + returnST (Node v as : bs) + +-- Depth-first search algorithms + +-- Algorithm 1: depth first search numbering + +preorder :: Tree a -> [a] +preorder (Node a ts) = [a] ++ preorderF ts + +preorderF :: Forest a -> [a] +preorderF ts = concat (map preorder ts) + +preOrd :: Graph -> [Vertex] +preOrd = preorderF . dff + +tabulate :: Bounds -> [Vertex] -> Table Int +tabulate bnds vs = array bnds (zipWith (:=) vs [1..]) + +preArr :: Bounds -> Forest Vertex -> Table Int +preArr bnds = tabulate bnds . preorderF + +-- Algorithm 2: topological sorting + +postorder :: Tree a -> [a] +postorder (Node a ts) = postorderF ts ++ [a] + +postorderF :: Forest a -> [a] +postorderF ts = concat (map postorder ts) + +postOrd :: Graph -> [Vertex] +postOrd = postorderF . dff + +topSort :: Graph -> [Vertex] +topSort = reverse . postOrd + +-- Algorithm 3: connected components + +components :: Graph -> Forest Vertex +components = dff . undirected + +undirected :: Graph -> Graph +undirected g = buildG (bounds g) (edges g ++ reverseE g) + +-- Algorithm 4: strongly connected components + +scc :: Graph -> Forest Vertex +scc g = dfs (transposeG g) (reverse (postOrd g)) + +scc' :: Graph -> Forest Vertex +scc' g = dfs g (reverse (postOrd (transposeG g))) + +-- Algorithm 5: Classifying edges + +tree :: Bounds -> Forest Vertex -> Graph +tree bnds ts = buildG bnds (concat (map flat ts)) + where flat (Node v rs) = [ v := w | Node w us <- ts ] ++ + concat (map flat ts) + +back :: Graph -> Table Int -> Graph +back g post = mapT select g + where select v ws = [ w | w <- ws, post!v < post!w ] + +cross :: Graph -> Table Int -> Table Int -> Graph +cross g pre post = mapT select g + where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ] + +forward :: Graph -> Graph -> Table Int -> Graph +forward g tree pre = mapT select g + where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v + +-- Algorithm 6: Finding reachable vertices + +reachable :: Graph -> Vertex -> [Vertex] +reachable g v = preorderF (dfs g [v]) + +path :: Graph -> Vertex -> Vertex -> Bool +path g v w = w `elem` (reachable g v) + +-- Algorithm 7: Biconnected components + +bcc :: Graph -> Forest [Vertex] +bcc g = (concat . map bicomps . map (label g dnum)) forest + where forest = dff g + dnum = preArr (bounds g) forest + +label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int) +label g dnum (Node v ts) = Node (v,dnum!v,lv) us + where us = map (label g dnum) ts + lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v] + ++ [lu | Node (u,du,lu) xs <- us]) + +bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex] +bicomps (Node (v,dv,lv) ts) + = [ Node (v:vs) us | (l,Node vs us) <- map collect ts] + +collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex]) +collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs) + where collected = map collect ts + vs = concat [ ws | (lw, Node ws us) <- collected, lw Tree a -> String +showTree = drawTree . mapTree show + +showForest :: Text a => Forest a -> String +showForest = unlines . map showTree + +mapTree :: (a -> b) -> (Tree a -> Tree b) +mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts) + +drawTree :: Tree String -> String +drawTree = unlines . draw + +draw (Node x ts) = grp this (space (length this)) (stLoop ts) + where this = s1 ++ x ++ " " + + stLoop [] = [""] + stLoop [t] = grp s2 " " (draw t) + stLoop (t:ts) = grp s3 s4 (draw t) ++ [s4] ++ rsLoop ts + + rsLoop [t] = grp s5 " " (draw t) + rsLoop (t:ts) = grp s6 s4 (draw t) ++ [s4] ++ rsLoop ts + + grp fst rst = zipWith (++) (fst:repeat rst) + + [s1,s2,s3,s4,s5,s6] = ["- ", "--", "-+", " |", " `", " +"] + +-- Instances of Eq and Text that are not included in the Gofer preludes: + +instance (Eq a, Eq b, Eq c) => Eq (a,b,c) where + (a,b,c)==(p,q,r) = a==p && b==q && c==r + +instance (Text a, Text b, Text c) => Text (a,b,c) where + showsPrec d (x,y,z) = showChar '(' . shows x . showChar ',' . + shows y . showChar ',' . + shows z . showChar ')' + +------------------------------------------------------------------------------ diff --git a/demos/IO/lfstint.gs b/demos/IO/lfstint.gs new file mode 100644 index 0000000..b2eb7d1 --- /dev/null +++ b/demos/IO/lfstint.gs @@ -0,0 +1,104 @@ +-- Here is a version of the interpreter with lazy stream output that +-- is described in the extended version of: +-- +-- `Lazy Functional State Threads' +-- John Launchbury and Simon Peyton Jones +-- (short version is in PLDI '94). +-- +-- This program requires array.gs, iomonad.gs, and ioarray.gs to run. +-- For example, in the demos/IO directory, try: +-- +-- :load ../../array.gs ../../iomonad.gs ../../ioarray.gs lfstint.gs +-- + +data Com = Assign Var Exp | Read Var | Write Exp | While Exp [Com] +type Var = Char +data Exp = Variable Var | Const Int | Plus Exp Exp | Eq Exp Exp | Le Exp Exp + +interpret :: [Com] -> [Int] -> [Int] +interpret cs input = runST (newArr ('a', 'z') 0 `thenST` \store -> + newVar input `thenST` \inp -> + command cs store inp) + +type Store s = MutArr s Var + +command :: [Com] -> Store s Int -> MutVar s [Int] -> ST s [Int] +command cs store inp = obey cs + where + -- obey :: [Com] -> ST s [Int] + obey [] = returnST [] + obey (Assign v e : cs) = eval e `thenST` \a -> + writeArr store v a `thenST_` + obey cs + obey (Read v : cs) = readVar inp `thenST` \(x:xs) -> + writeArr store v x `thenST_` + writeVar inp xs `thenST_` + obey cs + obey (Write e : cs) = eval e `thenST` \out -> + obey cs `thenST` \outs -> + returnST (out:outs) + obey (While e bs : cs) = eval e `thenST` \val -> + if val==0 then + obey cs + else + obey (bs ++ While e bs : cs) + + -- eval :: Exp -> ST s Int + eval (Variable v) = readArr store v + eval (Const n) = returnST n + eval (Plus l r) = binary (+) l r + eval (Eq l r) = binary (\x y -> if x==y then 1 else 0) l r + eval (Le l r) = binary (\x y -> if x<=y then 1 else 0) l r + + binary f l r = eval l `thenST` \l' -> + eval r `thenST` \r' -> + returnST (f l' r') + +-- Some sample programs: + +prog1 = [ Write (Const 1), + While (Const 1) [], + Write (Const 2) ] + +prog2 = [ Assign 'a' (Const 1), + While (Le (Variable 'a') (Const 10)) + [ Write (Variable 'a'), + Assign 'a' (Plus (Variable 'a') (Const 1)) + ] + ] + +prog3 = [ Assign 'a' (Const 0), + While (Const 1) + [ Write (Variable 'a'), + Assign 'a' (Plus (Variable 'a') (Const 1)) + ] + ] + +prog4 = [ While (Const 1) + [ Read 'a', + Write (Plus (Variable 'a') (Const 1)) + ] + ] + +prog5 = [ Read 'a', + While (Variable 'a') + [ Write (Plus (Variable 'a') (Const 1)), + Read 'a' + ] + ] + +prog6 = [ Assign 't' (Const 0), + Assign 'n' (Const 0), + Read 'a', + While (Variable 'a') + [ Assign 't' (Plus (Variable 't') (Variable 'a')), + Assign 'n' (Plus (Variable 'n') (Const 1)), + Read 'a' + ], + Write (Variable 't'), + Write (Variable 'n') + ] + +test = interpret prog6 ([1..10] ++ [0]) + +------------------------------------------------------------------------------ diff --git a/demos/Lamvar/lambdaNu b/demos/Lamvar/lambdaNu new file mode 100644 index 0000000..895c479 --- /dev/null +++ b/demos/Lamvar/lambdaNu @@ -0,0 +1,76 @@ +----------------------------------------------------------------------------- +-- Lambda Nu: January 25, 1993 +-- +-- The definitions in this file provide support for a simple implementation +-- of Lambda Nu -- a generalisation of Lambda Var as described by Odersky, +-- Rabin and Hudak in their POPL paper, January 1993. +-- +-- Of course, the implementation of the fuction `begin' is not sound. You must +-- ensure that you use this function correctly -- the responsibility is on you, +-- the programmer. +-- +-- Incidentally, the definitions in this file can only be used if the +-- version of Gofer that you are using has been compiled with the correct +-- set of primitives included. In addition, there is no support for these +-- primitives in gofc, the Gofer compiler. +-- +-- Operator precedence table: ----------------------------------------------- + +infixr 3 =: +infixr 2 >>, >>=, ? + +-- Lambda nu hacking: ------------------------------------------------------- + +primitive return "primLnReturn" :: a -> Cmd b a +primitive (>>=) "primLnBind" :: Cmd a b -> (b -> Cmd a c) -> Cmd a c +primitive primLnTagEq "primLnTagEq" :: Tag a -> Tag a -> Bool +primitive newvar "primLnNew" :: Cmd a (Tag b) +primitive assign "primLnAssign" :: Tag a -> a -> Cmd b () +primitive (?) "primLnRead" :: Tag a -> (a -> Cmd b c) -> Cmd b c +primitive io "primLnIo" :: ((a -> b) -> b) -> Cmd b a +primitive begin "primLnBegin" :: Cmd a b -> a + +instance Eq (Tag a) where + (==) = primLnTagEq + +(>>) :: Cmd c a -> Cmd c b -> Cmd c b +f >> g = f >>= const g + +seq :: [Cmd m a] -> Cmd m () +seq = foldr (>>) (return ()) + +new :: (Tag a -> Cmd b c) -> Cmd b c +new = (>>=) newvar + +(=:) :: a -> Tag a -> Cmd b () +value =: tag = assign tag value + +out :: (a -> a) -> Cmd a () +out a = io (\c -> a (c ())) + +outConst = out . const + +pure :: Cmd a a -> a +pure a = begin (a >>= outConst) + +deref :: Tag a -> Cmd b a +deref t = t ? return + +-- Very simple monadic I/O in the Glasgow style: ----------------------------- + +primitive getch "primLnGetch" :: Cmd a Char +primitive putchar "primLnPutchar" :: Char -> Cmd a () +primitive system "primLnSystem" :: String -> Cmd a Int + +getchar :: Cmd a Char +getchar = getch >>= \c -> + putchar c >> + return c + +puts :: String -> Cmd a () +puts = seq . map putchar + +-- an abuse of pure to implement hbc's debugging hack: +trace s a = pure (puts s >> return a) + +-- End of lambdaNu ----------------------------------------------------------- diff --git a/demos/Lamvar/lambdaVr b/demos/Lamvar/lambdaVr new file mode 100644 index 0000000..41dfbbe --- /dev/null +++ b/demos/Lamvar/lambdaVr @@ -0,0 +1,71 @@ +----------------------------------------------------------------------------- +-- Lambda Var: November 3, 1992 +-- +-- The definitions in this file provide support for a simple implementation +-- of Lambda Var -- as described by Odersky, Rabin and Hudak in their POPL +-- paper, January 1993. Note however, that the implementation of the +-- fuction `pure' is not sound. You must ensure that you use this function +-- correctly -- the responsibility is on you, the programmer. +-- +-- This file must be loaded with the constructor classes prelude, which is +-- usually called `cc.prelude'. +-- +-- Incidentally, the definitions in this file can only be used if the +-- version of Gofer that you are using has been compiled with the correct +-- set of primitives included. In addition, there is no support for these +-- primitives in gofc, the Gofer compiler. +-- +-- Operator precedence table: ----------------------------------------------- + +infixr 1 =: +infixr 0 >>, >>=, ? + +-- Lambda var hacking: ------------------------------------------------------ + +primitive pure "primLvPure" :: Proc a -> a +primitive (?) "primLvRead" :: Var a -> (a -> Proc b) -> Proc b +primitive primLvReturn "primLvReturn" :: a -> Proc a +primitive primLvBind "primLvBind" :: Proc a -> (a -> Proc b) -> Proc b +primitive (=:) "primLvAssign" :: a -> Var a -> Proc b +primitive var "primLvVar" :: (Var a -> Proc b) -> Proc b +primitive newvar "primLvNewvar" :: Proc (Var a) +primitive primLvVarEq "primLvVarEq" :: Var a -> Var a -> Bool + +type Prog = Proc () + +deref :: Var a -> Proc a +deref v = v ? result + +(>>=) :: Monad m => m a -> (a -> m b) -> m b +(>>=) = bind + +(>>) :: Monad m => m a -> m b -> m b +f >> g = f >>= const g + +seq :: Monad m => [m a] -> m () +seq = foldr (>>) (result ()) + +instance Eq (Var a) where (==) = primLvVarEq + +instance Functor Proc where map f x = [ f y | y <- x ] + +instance Monad Proc where result = primLvReturn + bind = primLvBind + +-- Very simple monadic I/O in the Glasgow style: ----------------------------- + +primitive getch "primLvGetch" :: Proc Char +primitive putchar "primLvPutchar" :: Char -> Proc () + +getchar :: Proc Char +getchar = getch >>= \c -> + putchar c >> + result c + +puts :: String -> Proc () +puts = seq . map putchar + +-- an abuse of pure to implement hbc's debugging hack: +trace s a = pure (puts s >> result a) + +-- End of lambdaVr ----------------------------------------------------------- diff --git a/demos/Lamvar/lnexamples b/demos/Lamvar/lnexamples new file mode 100644 index 0000000..141fc0a --- /dev/null +++ b/demos/Lamvar/lnexamples @@ -0,0 +1,62 @@ +-- +-- Examples for use with LambdaNu +-- + +imap f xs = begin + (new + (\t -> + assign t xs >> + let loop = deref t >>= \ys -> + case ys of + (y:ys') -> out (f y :) >> + assign t ys' >> + loop + [] -> outConst [] + in loop)) + +imap' f xs = newvar >>= \t -> + assign t xs >> + let loop = t ? \ys -> + case ys of (z:zs) -> out (f z :) >> + assign t zs >> + loop + [] -> outConst [] + in loop + + +ones = 1:ones + +test1 = imap (+1) [1,2,3] +test2 = imap (+1) ones + +funny x = begin (new (\t -> assign t x >> + deref t >>= \x' -> + outConst x')) + +funny' x y = begin (new (\t -> + (new (\s -> assign t x >> + assign s y >> + deref t >>= \x' -> + deref s >>= \y' -> + outConst (x',y'))))) + +double xs = begin + (new + (\t -> assign t xs >> + let loop = deref t >>= \zs -> + case zs of + (y:ys) -> out (\zs -> y:y:zs) >> + assign t ys >> + loop + [] -> out (const []) + in loop)) + + +double' xs = begin + (let loop (y:ys) = out (\zs -> y:y:zs) >> loop ys + loop [] = out (const []) + in loop xs) + + +double'' (y:ys) = y : y : double'' ys +double'' [] = [] diff --git a/demos/Lamvar/lvexamples b/demos/Lamvar/lvexamples new file mode 100644 index 0000000..41d9b79 --- /dev/null +++ b/demos/Lamvar/lvexamples @@ -0,0 +1,244 @@ +-- +-- Examples for use with LambdaVr +-- + +-- Simple functional version: ------------------------------------------------- + +data Tree a = Leaf a | Tree a :^: Tree a + +label :: Tree a -> Tree (a,Int) +label tree = fst (lab tree 0) + where lab (Leaf n) c = (Leaf (n,c), c+1) + lab (l :^: r) c = (l' :^: r', c'') + where (l',c') = lab l c + (r',c'') = lab r c' + +-- Lambda var version: -------------------------------------------------------- + +counter = var (\cnt -> 0 =: cnt >> + result (cnt ? \c -> + c+1 =: cnt >> + result c)) + +label0 tree = pure (counter >>= lab tree) + +lab (Leaf n) ctr = ctr >>= \c -> + result (Leaf (n,c)) +lab (l :^: r) ctr = lab l ctr >>= \l' -> + lab r ctr >>= \r' -> + result (l' :^: r') + +{- Here is an example where pure is not safe: + +label0 tree = pure (lab tree) + where ctr = pure counter + lab (Leaf n) = ctr >>= \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l >>= \l' -> + lab r >>= \r' -> + result (l' :^: r') + + gives label0 aTree = (Leaf (1,0) :^: Leaf (2,1)) :^: + (Leaf (3,2) :^: Leaf (4,3)) + +whereas: + +label0 tree = pure (lab tree) + where lab (Leaf n) = pure counter >>= \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l >>= \l' -> + lab r >>= \r' -> + result (l' :^: r') + + gives label0 aTree = (Leaf (1,0) :^: Leaf (2,0)) :^: + (Leaf (3,0) :^: Leaf (4,0)) +-} + +-- State monad version: ------------------------------------------------------- + +data State s a = ST (s -> (a,s)) + +instance Functor (State s) where + map f (ST st) = ST (\s -> let (x,s') = st s in (f x, s')) + +instance Monad (State s) where + result x = ST (\s -> (x,s)) + ST m `bind` f = ST (\s -> let (x,s') = m s + ST f' = f x + in f' s') + +startingWith :: State s a -> s -> a +ST m `startingWith` v = fst (m v) + +incr :: State Int Int +incr = ST (\s -> (s,s+1)) + +label1 :: Tree a -> Tree (a,Int) +label1 tree = lab tree `startingWith` 0 + where lab (Leaf n) = incr `bind` \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l `bind` \l' -> + lab r `bind` \r' -> + result (l' :^: r') + +label2 :: Tree a -> Tree (a,Int) +label2 tree = lab tree `startingWith` 0 + where lab (Leaf n) = [ Leaf (n,c) | c <- incr ] + lab (l :^: r) = [ l :^: r | l <- lab l, r <- lab r ] + + +-- sample data: --------------------------------------------------------------- + +aTree = balance [1..4] + +balance ns | len == 1 = Leaf (head ns) + | otherwise = balance (take h ns) :^: balance (drop h ns) + where len = length ns + h = len `div` 2 + +balance' ns = bal (length ns) ns + where bal l ns | l == 1 = Leaf (head ns) + | otherwise = let h = l `div` 2 + in bal h (take h ns) :^: bal (l-h) (drop h ns) + +------------------------------------------------------------------------------- +-- A swap function: + +swap :: Var a -> Var a -> Proc () +swap v w = v ? \x -> + w ? \y -> + x =: w >> + y =: v + +valOf v = v ? result + +-- usage: swap elements of arrays a and b in the range between 1 and n +-- +--seq [swap (a!i) (b!i) | i <- [1..n]] + + +increment v = v ? \val -> val+1 =: v + +anotherTest = var (\v -> 0 =: v >> + increment v >> + increment v >> + increment v >> + increment v >> + v ? + result) + +swapTest = var (\v -> + var (\w -> + "I'm v" =: v >> + "I'm w" =: w >> + swap v w >> + v ? \vValue -> + w ? \wValue -> + result (vValue,wValue))) + + +swapTest2 = var (\v -> + var (\w -> + 0 =: v >> + 10 =: w >> + v ? \vValue -> + vValue+1 =: v >> + swap v w >> + v ? \vValue -> + w ? \wValue -> + result (vValue,wValue))) + +-- A queue implementation + +-- First, its interface: + +type Queue a = ( a -> Proc (), -- put + Proc a, -- get + Proc Bool -- isempty + ) + +-- Procedures to take apart the method tuple: + +put (p, g, i) = p +get (p, g, i) = g +isempty (p, g, i) = i + +-- Now, the implementation in terms of a linked list: + +data Link a = Link a (Var (Link a)) + +mkqueue :: Proc (Queue Int) +mkqueue = + var (\v -> + var (\front -> v =: front >> + var (\rear -> v =: rear >> + result + ( \x -> -- put x + rear ? \r -> + var (\r' -> + Link x r' =: r >> + r' =: rear) + , + front ? \f -> -- get + f ? \ (Link x f') -> + f' =: front >> + result x + , + front ? \f -> -- isempty + rear ? \r -> + result (f == r) + ) + ))) + +-- Usage: + +qTest = pure (mkqueue >>= \q -> + put q 1 >> + get q >>= \first -> + isempty q >>= \empty -> + result (if first == 1 && empty then "so should it be" + else "something's wrong")) + +-- An alternative way to write the same thing: + +mkqueue1 :: Proc (Queue Int) +mkqueue1 = + newvar >>= \v -> + newvar >>= \front -> + v =: front >> + newvar >>= \rear -> + v =: rear >> + let + put x = rear? \r -> + newvar >>= \r' -> + Link x r' =: r >> + r' =: rear + + get = front? \f -> + f? \(Link x f') -> + f' =: front >> + result x + + isempty = front ? \f -> + rear ? \r -> + result (f==r) + in + result (put, get, isempty) + +-- Usage: + +qTest1 = pure (mkqueue1 >>= \q -> + put q 1 >> + get q >>= \first -> + isempty q >>= \empty -> + result (if first == 1 && empty then "so should it be" + else "something's wrong")) + +qTest2 = mkqueue1 >>= \q -> + put q 1 >> + get q >>= \first -> + isempty q >>= \empty -> + result (if first == 1 && empty then "so should it be" + else "something's wrong") + +------------------------------------------------------------------------------- diff --git a/demos/Lamvar/readme.lvr b/demos/Lamvar/readme.lvr new file mode 100644 index 0000000..104ffe3 --- /dev/null +++ b/demos/Lamvar/readme.lvr @@ -0,0 +1,245 @@ +------------------------------------------------------------------------------ +This document contains a brief introduction to the use of the current +experimental features for imperative programming in Gofer. These +features can only be used if the Gofer interpreter is compiled with +the LAMBDAVAR symbol #defined, for example, by adding a -DLAMBDAVAR +to the CFLAGS line in the Makefile. + +These notes were written by Martin Odersky ... I have made a couple +of changes to reflect the current syntax used in the Gofer version; +I believe that this document correctly reflects the current set of +features provided by Gofer. + +I should also emphasise that, as experimental features, these +extensions are subject to change in later releases. For example, +the Glasgow Haskell system uses the type constructor IO where we +have used Proc here. The first of these names seems to be gaining +a consensus and Gofer may well be modified to reflect this in some +future release. + +------------------------------------------------------------------------------ + +An introduction to Gofer's imperative constructs +================================================ + + +This short paper describes a library for imperative programming. +The library consists of functions that operate on an two abstract types + + Var a and Proc a + +"Var a" is the type of mutable variables that contain terms of type +"a". "Proc a" is the type of procedures that return a result of type +"a". Conceptually, a procedure is a function from states to pairs of +states and results. + + Proc a ~~ State -> (State, a) + +A state can be thought of as a function that maps a mutable variable +to its "current" value. States cannot be typed in Gofer, and they need +not be, since for the purposes of type checking "Proc a" is an opaque +type. In fact, the implementation of procedures does not use the above +type synonym for "Proc a". For efficiency reasons it uses a global +state that is updated destructively. + +Any expression with type Proc () will be executed as an imperative +program by the Gofer interpreter. + +The library contains the following functions. + +1. Mutable variables are created by the function + +> newvar :: Proc (Var a). + +Executing the term + + newvar + +has the effect that a fresh, uninitialized variable is allocated and returned +as a result. + + +2. Mutable variables are read and written using the functions: + +> (=:) :: a -> Var a -> Proc () +> +> deref :: Var a -> Proc a + +Executing the term + + A =: V + +has the effect of assigning A to variable V and returning the unit +value (). Note that A is not evaluated prior to the assignment. + +Executing the term + + deref V + +has no effects on the state and returns the term that was last +assigned to V. + + +3. Another primitive state transformer is + +> result :: a -> Proc a + +Executing the term + + result A + +has no effects on the state and returns A as result. + + +4. Procedures are composed using the functions: + +> (>>) :: Proc () -> Proc b -> Proc b +> (>>=) :: Proc a -> (a -> Proc b) -> Proc b +> (?) :: Var a -> (a -> Proc b) -> Proc b + +(>>) is sequential composition. Executing the term + + P >> Q + +first executes procedure P in the current state S, giving a new state +S'. It then executes Q in the new state S'. + +(>>=) is the "bind" operator of the state monad. Executing the term + + P >>= Q + +first executes procedure P in the current state S, giving a new +state S' and a returned result R. It then executes (Q R) in the +new state S'. + +(?) is a combination of (>>=) and (deref). Executing the term + + V ? Q + +passes to procedure Q the term that is currently assigned to variable V. + + +Note that + + P >> Q = P >>= \() -> Q. + V ? Q = deref V >>= Q + +Note also that (result) and (>>=) form a monad, since the following laws +hold: + + result A >>= B = B A + A >>= \x -> result x = A + (A >>= \x -> B) >>= C = A >>= ((\x -> B) >>= C) + if x not free in C + + +5. An imperative computation can be encapsulated using the function + + pure :: Proc a -> a + +Executing the term + + pure P + +executes procedure P in an empty initial state. It returns the final +result returned by P while discarding the final state. + +NOTE: (pure P) is referentially transparent only if two conditions +are met. + + 1. The body of P may only refer to variables allocated inside P. + 2. The result of P may not refer to variables allocated inside P. + +Currently, it is the programmer's obligation to verify that these +conditions hold. They are not checked by the compiler. This is an +implementation restriction, NOT a language feature. It is anticipated +that some future version of the compiler will enforce the conditions. + +6. Simple imperative I/O: + +> getchar :: Proc Char +> getch :: Proc Char +> putchar :: Char -> Proc () +> puts :: String -> Proc () + +The getchar and getch processes return a character typed on the standard +input stream, with or without echoing the character on the standard output +respectively. + +Executing the term + + putchar C + +causes the character given by the expression C to be printed on the standard +output. In a similar way, executing the term + + puts S + +causes the string S to be displated on the standard output. + + +Programming Examples: +===================== + +1. A swap procedure: + +> swap :: Var a -> Var a -> Proc () +> swap v w = +> v ? \x -> +> w ? \y -> +> x =: w >> +> y =: v + +2. Forming lists of mutable variables + +> newvars :: Int -> Proc [Var a] +> newvars 0 = result [] +> newvars (n+1) = newvar >>= \v -> +> newvars n >>= \rest -> +> result (v:rest) + +"newvars n" forms a list of "n" fresh mutable variables. + + +3. An iterator: + +> seq :: [Proc ()] -> Proc () +> seq = foldr (>>) (result ()) + +To exchange the contents of all variables in two lists: + +> swapall :: [Var a] -> [Var a] -> ([Var a], [Var a]) +> swapall xs ys = seq [swap v w | (v,w) <- zip xs ys] + + +4. Simple I/O: + +The getchar and puts functions are defined in terms of the getch and +putchar primitives: + +> getchar :: Proc Char +> getchar = getch >>= \c -> +> putchar c >> +> result c + +> puts :: String -> Proc () +> puts = seq . map putchar + + +More material about the semantics of these imperative constructs, and +the algebraic reasoning methods associated with them, is contained in +[1]. See also [2] for a similar approach. + + +[1] Martin Odersky, Dan Rabin and Paul Hudak: + "Call-by-name, Assignment, and the Lambda Calculus". + Proc. 20th ACM Symp. on Principles of Programming Languages, + pp 43-56, January 1993. + +[2] Simon Peyton Jones and Philip Wadler: + "Imperative Functional Programming". + Proc. 20th ACM Symp. on Principles of Programming Languages, + pp 71-84, January 1993. + + +------------------------------------------------------------------------------ diff --git a/demos/Lamvar/trace b/demos/Lamvar/trace new file mode 100644 index 0000000..e14e0f3 --- /dev/null +++ b/demos/Lamvar/trace @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- trace :: String -> a -> a Print the string and return the given value +-- +-- This file brings in just enough of the lambda var primitives to implement +-- a version of the impure hbc debugging function `trace'. Note that, this +-- can only be used in conjunction with a version of the Gofer interpreter +-- that has been compiled to include these primitives. See the file +-- lambdaVr for more details. +----------------------------------------------------------------------------- + +primitive primLvPure "primLvPure" :: Proc a -> a +primitive primLvReturn "primLvReturn" :: a -> Proc a +primitive primLvBind "primLvBind" :: Proc a -> (a -> Proc b) -> Proc b +primitive primLvPutch "primLvPutchar" :: Char -> Proc () + +trace :: String -> a -> a +trace s a = primLvPure (f s) + where f [] = primLvReturn a + f (x:xs) = primLvBind (primLvPutch x) (\_ -> f xs) + +-- End of trace -------------------------------------------------------------- diff --git a/demos/Luc/hanoi1.gs b/demos/Luc/hanoi1.gs new file mode 100644 index 0000000..616d98a --- /dev/null +++ b/demos/Luc/hanoi1.gs @@ -0,0 +1,103 @@ +-- Graphical Hanoi program : --------------------------------------------------- +-- +-- +-- author : Luc Duponcheel +-- + +-- +-- when typing +-- +-- ? hanoi n (n is any natural number) +-- +-- the program should produce a list of tower configurations. +-- + + +-- +-- On a Sun SPARC the program has to run in a shell tool +-- (I assume that any ANSI-compliant terminal is OK) +-- + +-- +-- PS: +-- +-- if you want to avoid that your boss can see that you are +-- playing silly games at work, then you can always type in +-- +-- ? clearscreen "" +-- + +-------------------------------------------------------------------------------- + +-- general purpose function `comp' composes a list of functions + +comp :: [a -> a] -> a -> a +comp [] = id +comp (f:fs) = f . comp fs + +-- some screen oriented functions + +escape = showChar '\ESC' . showChar '[' + +inverse = escape . showString "7m" +normal = escape . showString "m" + +clearscreen = showString "\ESC[2J" -- ANSI version +clearscreen = showChar '\^L' -- Sun window + +-- how to show one disk + +showSpace = showString . space + +showDisk x = showSpace (10-x) + . inverse . showSpace (2*x) -- shows the disk in black + . normal . showSpace (10-x) + +-- how to show one horizontal level (3, possibly dummy, disks) + +newlevel = showChar '\n' + +showLevel (0,0,0) = newlevel +showLevel (x,0,0) = showDisk x . newlevel +showLevel (x,y,0) = showDisk x . showDisk y . newlevel +showLevel (x,y,z) = showDisk x . showDisk y . showDisk z . newlevel + +-- padding the towers vertically with dummy disks + +pad xs len = [ 0 | x <- [0..(len - length xs)] ] ++ xs + +-- actual moves + +next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs) +next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs)) +next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs) +next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs)) +next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs) +next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs) + +-- how to show one tower configuration + +showConfiguration n (as,bs,cs) = + comp [ showLevel ts | ts <- zip3 (pad as n) (pad bs n) (pad cs n) ] + +-- how to show all tower configurations + +showConfigurations n cnf [] = showConfiguration n cnf +showConfigurations n cnf (x:xs) = showConfiguration n cnf + . showConfigurations n (next cnf x) xs + +-- how to start + +startconf n = ([1..n],[],[]) + +-- how to continue (main code : is surprisingly simple) + +cont 0 [a,b,c] = [] +cont n [a,b,c] = cont (n-1) [a,c,b] ++ [(a,b)] ++ cont (n-1) [c,b,a] + +-- hanoi + +hanoi n = showConfigurations n (startconf n) (cont n [0,2,1]) "" + +-------------------------------------------------------------------------------- + diff --git a/demos/Luc/hanoi2.gs b/demos/Luc/hanoi2.gs new file mode 100644 index 0000000..3b4a4ec --- /dev/null +++ b/demos/Luc/hanoi2.gs @@ -0,0 +1,104 @@ +-- Graphical Towers-Of-Hanoi program : ----------------------------------------- +-- +-- +-- author : Luc Duponcheel +-- + +-- +-- The program makes use of screen-oriented functions. +-- It is possible that you'll have to redefine them if +-- you do not work with an ANSI-compliant terminal. +-- + +-------------------------------------------------------------------------------- + + +-- general purpose function `comp' composes a list of functions + +comp :: [a -> a] -> a -> a +comp [] = id +comp (f:fs) = f . comp fs + + +-- screen oriented functions + +escape = showChar '\ESC' . showChar '[' + +inverse = escape . showString "7m" +normal = escape . showString "m" + +goto x y = escape . shows y . showChar ';' . shows x . showChar 'H' + +clearscreen = showString "\ESC[2J" -- ANSI version +clearscreen = showChar '\^L' -- Sun window + +start = clearscreen +stop = normal + + +-- how to put and get a disk + +showSpace = showString . space + +putDisk n x y = inverse . goto (n-x) y . showSpace (2*x) +getDisk n x y = normal . goto (n-x) y . showSpace (2*x) + + +-- next configuartion + +next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs) +next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs)) +next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs) +next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs)) +next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs) +next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs) + + +-- action to be performed + +action n ((a:as),bs,cs) (0,1) + = getDisk (2*n) a (2*n - length as) . putDisk (5*n) a (2*n - length bs) +action n ((a:as),bs,cs) (0,2) + = getDisk (2*n) a (2*n - length as) . putDisk (8*n) a (2*n - length cs) +action n (as,(b:bs),cs) (1,0) + = getDisk (5*n) b (2*n - length bs) . putDisk (2*n) b (2*n - length as) +action n (as,(b:bs),cs) (1,2) + = getDisk (5*n) b (2*n - length bs) . putDisk (8*n) b (2*n - length cs) +action n (as,bs,(c:cs)) (2,0) + = getDisk (8*n) c (2*n - length cs) . putDisk (2*n) c (2*n - length as) +action n (as,bs,(c:cs)) (2,1) + = getDisk (8*n) c (2*n - length cs) . putDisk (5*n) c (2*n - length bs) + + +-- how to show the initial configuration + +showInit n = comp [ putDisk (2*n) x (y+n) | (x,y) <- zip [1..n] [1..n] ] + + +-- the actual moves + +moves n cnfg [] = [] +moves n cnfg (x:xs) = move : moves n nextcnfg xs + where + nextcnfg = next cnfg x + move = action n cnfg x + + +-- how to show the moves + +showMoves n = comp (moves n ([1..n],[],[]) (hanoi n [0,2,1])) + + +-- main code (simple!) + +hanoi 0 [a,b,c] = [] +hanoi n [a,b,c] = hanoi (n-1) [a,c,b] ++ [(a,b)] ++ hanoi (n-1) [c,b,a] + + +-- how to show it all + +showHanoi n = start . showInit n . showMoves n . stop + + +-------------------------------------------------------------------------------- + diff --git a/demos/Luc/hanoi3.gs b/demos/Luc/hanoi3.gs new file mode 100644 index 0000000..58450b5 --- /dev/null +++ b/demos/Luc/hanoi3.gs @@ -0,0 +1,149 @@ +-- Graphical Towers-Of-Hanoi program : ----------------------------------------- +-- +-- +-- author : Luc Duponcheel +-- +-- the program is partly based on an earlier program which is +-- originally written in Miranda* by Johan Vanslembrouck. +-- +-- *Miranda is a trademark of Software Research Limited. +-- + +-- +-- The program makes use of screen-oriented functions. +-- It is possible that you'll have to redefine them if +-- you do not work with an ANSI-compliant terminal. +-- + +-------------------------------------------------------------------------------- + + +-- general purpose function `comp' composes a list of functions + +comp :: [a -> a] -> a -> a +comp [] = id +comp (f:fs) = f . comp fs + + +-- screen oriented functions + +escape = showChar '\ESC' . showChar '[' + +inverse = escape . showString "7m" +normal = escape . showString "m" + +goto x y = escape . shows y . showChar ';' . shows x . showChar 'H' + +clearscreen = showString "\ESC[2J" -- ANSI version +clearscreen = showChar '\^L' -- Sun window + +start = clearscreen +stop = normal + + +-- how to put and get a disk + +showSpace = showString . space + +putDisk n x y = inverse . goto (n-x) y . showSpace (2*x) +getDisk n x y = normal . goto (n-x) y . showSpace (2*x) + +-- next configuartion + +next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs) +next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs)) +next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs) +next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs)) +next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs) +next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs) + +-- action to be performed + +action n ((a:as),bs,cs) (0,1) + = let la = length as ; lb = length bs in + getDisk (2*n) a (2*n-la) . + comp [ putDisk (2*n) 1 (2*n-la-i) . getDisk (2*n) 1 (2*n-la-i) + | i <- [1..n-la+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [3,4] ] . + comp [ putDisk (5*n) 1 (n+i-2) . getDisk (5*n) 1 (n+i-2) + | i <- [1..n-lb+1] ] . + putDisk (5*n) a (2*n - lb) +action n ((a:as),bs,cs) (0,2) + = let la = length as ; lc = length cs in + getDisk (2*n) a (2*n - la) . + comp [ putDisk (2*n) 1 (2*n-la-i) . getDisk (2*n) 1 (2*n-la-i) + | i <- [1..n-la+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [3,4,5,6,7] ] . + comp [ putDisk (8*n) 1 (n+i-2) . getDisk (8*n) 1 (n+i-2) + | i <- [1..n-lc+1] ] . + putDisk (8*n) a (2*n - lc) +action n (as,(b:bs),cs) (1,0) + = let lb = length bs ; la = length as in + getDisk (5*n) b (2*n - lb) . + comp [ putDisk (5*n) 1 (2*n-lb-i) . getDisk (5*n) 1 (2*n-lb-i) + | i <- [1..n-lb+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [4,3] ] . + comp [ putDisk (2*n) 1 (n+i-2) . getDisk (2*n) 1 (n+i-2) + | i <- [1..n-la+1] ] . + putDisk (2*n) b (2*n - la) +action n (as,(b:bs),cs) (1,2) + = let lb = length bs ; lc = length cs in + getDisk (5*n) b (2*n - lb) . + comp [ putDisk (5*n) 1 (2*n-lb-i) . getDisk (5*n) 1 (2*n-lb-i) + | i <- [1..n-lb+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [6,7] ] . + comp [ putDisk (8*n) 1 (n+i-2) . getDisk (8*n) 1 (n+i-2) + | i <- [1..n-lc+1] ] . + putDisk (8*n) b (2*n - lc) +action n (as,bs,(c:cs)) (2,0) + = let lc = length cs ; la = length as in + getDisk (8*n) c (2*n - lc) . + comp [ putDisk (8*n) 1 (2*n-lc-i) . getDisk (8*n) 1 (2*n-lc-i) + | i <- [1..n-lc+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [7,6,5,4,3] ] . + comp [ putDisk (2*n) 1 (n+i-2) . getDisk (2*n) 1 (n+i-2) + | i <- [1..n-la+1] ] . + putDisk (2*n) c (2*n - la) +action n (as,bs,(c:cs)) (2,1) + = let lc = length cs ; lb = length bs in + getDisk (8*n) c (2*n - lc) . + comp [ putDisk (8*n) 1 (2*n-lc-i) . getDisk (8*n) 1 (2*n-lc-i) + | i <- [1..n-lc+1] ] . + comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [7,6] ] . + comp [ putDisk (5*n) 1 (n+i-2) . getDisk (5*n) 1 (n+i-2) + | i <- [1..n-lb+1] ] . + putDisk (5*n) c (2*n - lb) + + +-- how to show the initial configuration + +showInit n = comp [ putDisk (2*n) x (y+n) | (x,y) <- zip [1..n] [1..n] ] + + +-- the actual moves + +moves n cnfg [] = [] +moves n cnfg (x:xs) = move : moves n nextcnfg xs + where + nextcnfg = next cnfg x + move = action n cnfg x + + +-- how to show the moves + +showMoves n = comp (moves n ([1..n],[],[]) (hanoi n [0,2,1])) + + +-- main code (simple!) + +hanoi 0 [a,b,c] = [] +hanoi n [a,b,c] = hanoi (n-1) [a,c,b] ++ [(a,b)] ++ hanoi (n-1) [c,b,a] + + +-- how to show it all + +showHanoi n = start . showInit n . showMoves n . stop + + +-------------------------------------------------------------------------------- + diff --git a/demos/Luc/horse1.gs b/demos/Luc/horse1.gs new file mode 100644 index 0000000..da50ec0 --- /dev/null +++ b/demos/Luc/horse1.gs @@ -0,0 +1,187 @@ +-- Graphical Knights-Tour program : -------------------------------------------- +-- +-- +-- author : Luc Duponcheel +-- + +-- +-- when typing +-- +-- ? showHorses "" +-- +-- the program should produce on your terminal something like : +-- + + +-- 01 64 53 58 03 60 51 34 + +-- 54 57 02 61 52 35 04 49 + +-- 63 30 55 46 59 50 33 22 + +-- 56 43 62 31 36 21 48 05 + +-- 29 14 45 42 47 32 23 20 + +-- 44 41 28 15 18 37 06 09 + +-- 13 16 39 26 11 08 19 24 + +-- 40 27 12 17 38 25 10 07 + +-- (93975 reductions, 179126 cells) + + +-- +-- (with odd numbers in inverse-video) +-- + + +-- +-- On a Sun SPARC the program has to run in a shell tool +-- ^^^^^ + +-- +-- On my Amiga I can also experiment with colours ... +-- + +-- +-- The following well known strategy is used : +-- +-- choose a move is which is such that, +-- after having done the move, +-- a minimal number of next moves is possible. +-- +-- +-- If your computer is `slow enough' then you will notice that finding such a +-- move takes longer in the beginning than at the end of the move sequence. +-- + +-- +-- all attempts to find a faster solution are encouraged +-- ^^^^^^ + +-- +-- PS: +-- +-- if you want to avoid that your boss can see that you are +-- playing silly games at work, then you can always type in +-- +-- ? clearscreen "" +-- + +-------------------------------------------------------------------------------- + +-- +-- the general purpose function +-- revcomp +-- composes a list of functions in reverse order +-- + +revcomp :: [a -> a] -> a -> a +revcomp [] = id +revcomp (f:fs) = revcomp fs . f + + +-- +-- some screen oriented functions +-- it is possible that you'll have to +-- redefine them if you do not work with +-- an ANSI-compliant terminal. +-- + +escape = showChar '\ESC' . showChar '[' + +inverse = escape . showString "7m" +normal = escape . showString "m" + +goto x y = escape . shows y . showChar ';' . shows x . showChar 'H' + +clearscreen = showString "\ESC[2J" -- ANSI version +clearscreen = showChar '\^L' -- Sun window + +continue = normal . goto 0 20 + + +-- main types + +type Horse = (Int,Int) +type Horses = [Horse] + +type PartOfBoard = [(Int,Int)] + + +-- all possible moves from (u,v) to (x,y) + +(|-->) :: Horse -> Horse -> Bool +(u,v) |--> (x,y) = (x == u+1) && (y == v-2) || + (x == u-2) && (y == v-1) || + (x == u-2) && (y == v+1) || + (x == u+2) && (y == v-1) || + (x == u+2) && (y == v+1) || + (x == u+1) && (y == v+2) || + (x == u-1) && (y == v+2) + +{- + (x == u-1) && (y == v-2) -- NOT used! +-} + +horsesOn :: PartOfBoard -> Horse -> Horses +horsesOn pb h = [ h' | h' <- pb, h |--> h' ] + + +-- strategy + +(>>) :: [a] -> [b] -> Bool +_ >> [_] = True +[_] >> _ = False +(_:ms) >> (_:ns) = ms >> ns + +minimalize :: (a -> [b]) -> [a] -> (a,[b]) +minimalize f [h] = (h,f h) +minimalize f (h:hs) = let (k,ms) = minimalize f hs ; ns = f h in + if ns >> ms then (k,ms) else (h,ns) + + +-- how to find all horses ( -: stands for `minus` ) + +(-:) :: Eq a => [a] -> a -> [a] +(x:xs) -: y + | x == y = xs + | otherwise = x : (xs -: y) +[] -: x = [] + + +horses :: Horses +horses = fst (moves 64) + where + moves 1 = ([(1,1)],[ (i,j) | i <- [1..8], j <- [1..8] ] -: (1,1)) + moves (n+1) = let + (hs@(hn:_),b) = moves n + f = horsesOn b + (h,_) = minimalize f (f hn) + in + (h:hs,b-:h) + + + +-- How to show a move + +showMove (x,y) n = g (x,y) . f n + where g1 (x,y) = goto (2+4*x) (2+2*y) + g (x,y) + | even (x+y) = g1 (x,y) . inverse + | otherwise = g1 (x,y) . normal + f1 n + | n < 10 = showChar '0' + | otherwise = id + f n = let m = 65 - n in f1 m . shows m + +-- How to show all horses + +showHorses + = clearscreen . revcomp (zipWith showMove horses [1..]) . continue + + +-------------------------------------------------------------------------------- + diff --git a/demos/Modular/Demo b/demos/Modular/Demo new file mode 100644 index 0000000..8129dca --- /dev/null +++ b/demos/Modular/Demo @@ -0,0 +1,156 @@ +------------------------------------------------------------------------------ +--The files in this directory are based on the programs described in: +-- +-- A Modular fully-lazy lambda lifter in Haskell +-- Simon L. Peyton Jones and David Lester +-- Software -- Practice and Experience +-- Vol 21(5), pp.479-506 +-- MAY 1991 +-- +--See the Readme file for more details. +------------------------------------------------------------------------------ + +-- Instance of Text for printing expressions: + +instance Text Constant where + showsPrec p (CNum n) = shows n + showsPrec p (CFun n) = showString n + +instance Text (Expr [Char]) where + showsPrec p (EConst k) = shows k + showsPrec p (EVar v) = showString v + + showsPrec p e@(EAp _ _) = showChar '(' . showsAp e . showChar ')' + where showsAp (EAp l r) = showsAp l + . showChar ' ' + . shows r + showsAp e = shows e + + showsPrec p (ELet isRec defns body) + = showString (if isRec then "letrec" else "let") + . showChar ' ' + . showsDefns defns + . showString " in " + . shows body + + showsPrec p (ELam binders body) + = showString "(\\" + . foldr1 (\h t-> h . showChar ' ' . t) + (map showString binders) + . showChar '.' + . shows body + . showChar ')' + +showWithSep :: Text a => String -> [a] -> ShowS +showWithSep s [x] = shows x +showWithSep s (x:xs) = shows x . showString s . showWithSep s xs + +showsDefns :: [Defn Name] -> ShowS +showsDefns [] = showString "{}" +showsDefns [d] = showsDefn d +showsDefns defns = showChar '{' + . foldr1 (\h t-> h . showString "; " . t) + (map showsDefn defns) + . showChar '}' + +showsDefn :: Defn Name -> ShowS +showsDefn (x,e) = showString x . showString " = " . shows e + +-- display lists of supercombinators: + +showSCs :: [SCDefn] -> String +showSCs = layn . map showSc + where showSc (name,args,body) + = foldr1 (\n ns -> n ++ " " ++ ns) (name:args) + ++ " = " + ++ show body + +-- Parser for input of expressions: (sorry, this is rather a hack!) + +number :: Parser Int +number = sp (many1 (sat isDigit) `do` strToNum) + where strToNum = foldl (\n d->10*n+d) 0 . map (\c->ord c - ord '0') + +variable :: Parser String +variable = sp (sat isLower `seq` many (sat isAlpha) `do` (\(c,cs) -> c:cs)) + +constant :: Parser String +constant = sp (sat isUpper `seq` many (sat isAlpha) `do` (\(c,cs) -> c:cs)) + +expr :: Parser Expression +expr = sptok "letrec" `seq` variable `seq` sptok "=" `seq` expr + `seq` sptok "in" `seq` expr + `do` (\(lt,(v,(eq,(def,(inn,rhs)))))-> ELet True [(v,def)] rhs) + `orelse` + sptok "let" `seq` variable `seq` sptok "=" `seq` expr + `seq` sptok "in" `seq` expr + `do` (\(lt,(v,(eq,(def,(inn,rhs)))))-> ELet False [(v,def)] rhs) + `orelse` + sptok "\\" `seq` listOf variable (sp (okay ())) `seq` sptok "." + `seq` expr + `do` (\(l,(vs,(dot,e))) -> ELam vs e) + `orelse` + atomic + +atomic :: Parser Expression +atomic = sptok "(" `seq` many1 expr `seq` sptok ")" + `do` (\(o,(e,c))->foldl1 EAp e) + `orelse` + variable `do` EVar + `orelse` + constant `do` (EConst . CFun) + `orelse` + number `do` (EConst . CNum) + + +inp :: String -> Expression +inp s = case expr s of ((p,""):_) -> p + _ -> error "Cannot parse input" + +-- Examples: + +ll, fll :: Expression -> String +ll = showSCs . lambdaLift +fll = showSCs . fullyLazyLift + +example1 :: Expression +example1 = inp "let f = \\x. let g = \\y.(Plus (Times x x) y) in \ + \(Plus (g 3) (g 4)) \ + \in (f 6)" + +{- Results: + + ? ll example1 -- normal lambda lifting + 1) $main = let f = SC1 in (f 6) + 2) SC1 x = let g = (SC0 x) in (Plus (g 3) (g 4)) + 3) SC0 x y = (Plus (Times x x) y) + + ? fll example1 -- fully lazy version + + 1) $main = let f0 = SC1 in (f0 6) + 2) SC1 x1 = let v4 = (Plus (Times x1 x1)) in + let g2 = (SC0 v4) in (Plus (g2 3) (g2 4)) + 3) SC0 v4 y3 = (v4 y3) + +-} + +example2 :: Expression +example2 = inp "let \ + \ f = \\x. letrec g = \\y. (Cons (Times x x) (g y)) \ + \ in (g 3) \ + \in (f 6)" + +{- Results: + + ? ll example2 -- normal lambda lifting + 1) $main = let f = SC1 in (f 6) + 2) SC1 x = letrec g = (SC0 g x) in (g 3) + 3) SC0 g x y = (Cons (Times x x) (g y)) + + ? fll example2 -- fully lazy version + 1) $main = let f0 = SC1 in (f0 6) + 2) SC1 x1 = let v4 = (Cons (Times x1 x1)) in + letrec g2 = (SC0 g2 v4) in (g2 3) + 3) SC0 g2 v4 y3 = (v4 (g2 y3)) + +-} diff --git a/demos/Modular/LambdaLift b/demos/Modular/LambdaLift new file mode 100644 index 0000000..7fbf440 --- /dev/null +++ b/demos/Modular/LambdaLift @@ -0,0 +1,125 @@ +------------------------------------------------------------------------------ +--The files in this directory are based on the programs described in: +-- +-- A Modular fully-lazy lambda lifter in Haskell +-- Simon L. Peyton Jones and David Lester +-- Software -- Practice and Experience +-- Vol 21(5), pp.479-506 +-- MAY 1991 +-- +--See the Readme file for more details. +------------------------------------------------------------------------------ + +-- 3.3 A data type for compilation -- a happy ending: + +data Constant = CNum Int | CBool Bool | CFun Name +type Name = String + +data Expr binder = EVar Name | + EConst Constant | + EAp (Expr binder) (Expr binder) | + ELet IsRec [Defn binder] (Expr binder) | + ELam [binder] (Expr binder) + +type Defn binder = (binder, Expr binder) + +type Expression = Expr Name + +type IsRec = Bool +recursive = True +nonRecursive = False + +type AnnExpr binder a = (a, AnnExpr' binder a) +data AnnExpr' binder a = AVar Name | + AConst Constant | + AAp (AnnExpr binder a) (AnnExpr binder a) | + ALet IsRec [AnnDefn binder a] (AnnExpr binder a) | + ALam [binder] (AnnExpr binder a) + +type AnnDefn binder a = (binder, AnnExpr binder a) + +bindersOf :: [(binder,rhs)] -> [binder] +bindersOf defns = [ binder | (binder,rhs) <- defns ] + +rhssOf :: [(binder,rhs)] -> [rhs] +rhssOf defns = [ rhs | (binder, rhs) <- defns ] + +-- 4 Lambda lifting: + +lambdaLift :: Expression -> [SCDefn] +lambdaLift = collectSCs . abstract . freeVars + +type SCDefn = (Name, [Name], Expression) + +-- 4.2 Free variables: + +freeVars :: Expression -> AnnExpr Name (Set Name) + +freeVars (EConst k) = (setEmpty, AConst k) +freeVars (EVar v) = (setSingleton v, AVar v) +freeVars (EAp e1 e2) = (setUnion (freeVarsOf e1') (freeVarsOf e2'),AAp e1' e2') + where e1' = freeVars e1 + e2' = freeVars e2 + +freeVars (ELam args body) + = (setDifference (freeVarsOf body') (setFromList args), ALam args body') + where body' = freeVars body + +freeVars (ELet isRec defns body) + = (setUnion defnsFree bodyFree, ALet isRec defns' body') + where binders = bindersOf defns + binderSet = setFromList binders + values' = map freeVars (rhssOf defns) + defns' = zip binders values' + freeInValues = foldr setUnion setEmpty (map freeVarsOf values') + defnsFree + | isRec = setDifference freeInValues binderSet + | not isRec = freeInValues + body' = freeVars body + bodyFree = setDifference (freeVarsOf body') binderSet + +freeVarsOf :: AnnExpr Name (Set Name) -> Set Name +freeVarsOf (freeVars, expr) = freeVars + +-- 4.3 Generating supercombinators: + +abstract :: AnnExpr Name (Set Name) -> Expression +abstract (_, AVar v) = EVar v +abstract (_, AConst k) = EConst k +abstract (_, AAp e1 e2) = EAp (abstract e1) (abstract e2) +abstract (free, ALam args body) + = foldl EAp sc (map EVar fvList) + where fvList = setToList free + sc = ELam (fvList++args) (abstract body) +abstract (_,ALet isRec defns body) + = ELet isRec + [(name,abstract body) | (name,body) <- defns] + (abstract body) + +-- 4.4 Collecting supercombinators: + +collectSCs :: Expression -> [SCDefn] +collectSCs e = [("$main",[],e')] ++ bagToList scs + where (_, scs, e') = collectSCs_e initialNameSupply e + +collectSCs_e :: NameSupply -> Expression -> (NameSupply,Bag SCDefn,Expression) +collectSCs_e ns (EConst k) = (ns, bagEmpty, EConst k) +collectSCs_e ns (EVar v) = (ns, bagEmpty, EVar v) +collectSCs_e ns (EAp e1 e2) = (ns'', bagUnion scs1 scs2, EAp e1' e2') + where (ns', scs1, e1') = collectSCs_e ns e1 + (ns'', scs2, e2') = collectSCs_e ns' e2 + +collectSCs_e ns (ELam args body) + = (ns'', bagInsert (name,args,body') bodySCs, EConst (CFun name)) + where (ns', bodySCs,body') = collectSCs_e ns body + (ns'',name) = newName ns' "SC" + +collectSCs_e ns (ELet isRec defns body) + = (ns'', scs, ELet isRec defns' body') + where ((ns'',scs),defns') = mapAccuml collectSCs_d (ns',bodySCs) defns + (ns', bodySCs, body') = collectSCs_e ns body + + collectSCs_d (ns,scs) (name,value) + = ((ns',bagUnion scs scs'), (name, value')) + where (ns',scs',value') = collectSCs_e ns value + diff --git a/demos/Modular/Laziness b/demos/Modular/Laziness new file mode 100644 index 0000000..73fb1c0 --- /dev/null +++ b/demos/Modular/Laziness @@ -0,0 +1,176 @@ +------------------------------------------------------------------------------ +--The files in this directory are based on the programs described in: +-- +-- A Modular fully-lazy lambda lifter in Haskell +-- Simon L. Peyton Jones and David Lester +-- Software -- Practice and Experience +-- Vol 21(5), pp.479-506 +-- MAY 1991 +-- +--See the Readme file for more details. +------------------------------------------------------------------------------ + +-- 5.4 A fully lazy lambda lifter + +fullyLazyLift :: Expression -> [SCDefn] +fullyLazyLift = lambdaLift . float . rename + . identifyMFEs . addLevels . separateLams + +-- 5.5 Separating the lambdas + +separateLams :: Expression -> Expression +separateLams (EVar v) = EVar v +separateLams (EConst k) = EConst k +separateLams (EAp e1 e2) = EAp (separateLams e1) (separateLams e2) +separateLams (ELam args body) = foldr mkSingleLam body args + where mkSingleLam arg bod = ELam [arg] body +separateLams (ELet isRec defns body) + = ELet isRec + [(n,separateLams rhs)|(n,rhs)<-defns] + (separateLams body) + +-- 5.6 Adding level numbers + +type Level = Int + +addLevels :: Expression -> AnnExpr (Name,Level) Level +addLevels = freeToLevel . freeVars + +freeToLevel :: AnnExpr Name (Set Name) -> AnnExpr (Name,Level) Level +freeToLevel e = freeToLevel_e 0 [] e + +freeSetToLevel :: Set Name -> Assn Name Level -> Level +freeSetToLevel free env = maximum (0:map (assLookup env) (setToList free)) + +freeToLevel_e :: Level + -> Assn Name Level + -> AnnExpr Name (Set Name) + -> AnnExpr (Name,Level) Level + +freeToLevel_e lev env (_, AConst k) = (0, AConst k) +freeToLevel_e lev env (_, AVar v) = (assLookup env v, AVar v) +freeToLevel_e lev env (_, AAp e1 e2) = (max (levelOf e1') (levelOf e2'), + AAp e1' e2') + where e1' = freeToLevel_e lev env e1 + e2' = freeToLevel_e lev env e2 + +freeToLevel_e lev env (free, ALam args body) + = (freeSetToLevel free env, ALam args' body') + where body' = freeToLevel_e (lev+1) (args'++env) body + args' = zip args (repeat (lev+1)) + +freeToLevel_e lev env (free, ALet isRec defns body) + = (levelOf body', ALet isRec defns' body') + where binders = bindersOf defns + freeRhsVars = setUnionList [free | (free,_) <- rhssOf defns] + maxRhsLevel = freeSetToLevel freeRhsVars + ([(name,0) | name<-binders] ++ env) + defns' = map freeToLevel_d defns + body' = freeToLevel_e lev (bindersOf defns' ++ env) body + freeToLevel_d (name,rhs) + = ((name,levelOf rhs'),rhs') + where rhs' = freeToLevel_e lev envRhs rhs + envRhs | isRec = [(name,maxRhsLevel) | name<-binders] ++ env + | not isRec = env + +levelOf :: AnnExpr a Level -> Level +levelOf (level, _) = level + +-- 5.7 Identifying MFEs + +identifyMFEs :: AnnExpr (Name,Level) Level -> Expr (Name,Level) +identifyMFEs = identifyMFEs_e 0 + +notMFECandidate (AConst k) = True +notMFECandidate (AVar v) = True +notMFECandidate _ = False -- everything else is a candidate + +identifyMFEs_e :: Level -> AnnExpr (Name,Level) Level -> Expr (Name,Level) +identifyMFEs_e cxt (level,e) + | level==cxt || notMFECandidate e = e' + | otherwise = transformMFE level e' + where e' = identifyMFEs_e1 level e + +transformMFE level e = ELet nonRecursive [(("v",level),e)] (EVar "v") + +identifyMFEs_e1 level (AConst k) = EConst k +identifyMFEs_e1 level (AVar v) = EVar v +identifyMFEs_e1 level (AAp e1 e2) = EAp (identifyMFEs_e level e1) + (identifyMFEs_e level e2) +identifyMFEs_e1 level (ALam args body) + = ELam args (identifyMFEs_e argLevel body) + where ((_,argLevel):_) = args +identifyMFEs_e1 level (ALet isRec defns body) + = ELet isRec defns' body' + where body' = identifyMFEs_e level body + defns' = [(binder,identifyMFEs_e level rhs) | (binder,rhs) <- defns] + +-- 5.8 Renaming + +rename :: Expr (Name,a) -> Expr (Name,a) +rename e = e' where (_,e') = rename_e [] initialNameSupply e + +rename_e :: Assn Name Name -> NameSupply -> Expr (Name,a) + -> (NameSupply, Expr (Name, a)) +rename_e env ns (EVar v) = (ns,EVar (assLookup env v)) +rename_e env ns (EConst k) = (ns, EConst k) +rename_e env ns (EAp e1 e2) = (ns'', EAp e1' e2') + where (ns', e1') = rename_e env ns e1 + (ns'',e2') = rename_e env ns' e2 +rename_e env ns (ELam args body) + = (ns'', ELam args' body') -- BUG???? + where (ns', args') = mapAccuml newBinder ns args + (ns'',body') = rename_e (assocBinders args args' ++ env) ns' body +rename_e env ns (ELet isRec defns body) + = (ns''', ELet isRec (zip binders' values') body') + where (ns', body') = rename_e env' ns body + binders = bindersOf defns + (ns'', binders') = mapAccuml newBinder ns' binders + env' = assocBinders binders binders' ++ env + (ns''',values') = mapAccuml (rename_e rhsEnv) ns'' (rhssOf defns) + rhsEnv | isRec = env' + | not isRec = env + +newBinder ns (name,info) = (ns',(name',info)) + where (ns',name') = newName ns name + +assocBinders :: [(Name,a)] -> [(Name,a)] -> Assn Name Name +assocBinders binders binders' = zip (map fst binders) (map fst binders') + +-- 5.9 Floating + +float :: Expr (Name,Level) -> Expression +float e = install floatedDefns e' where (floatedDefns,e') = float_e e + +type FloatedDefns = [(Level, IsRec, [Defn Name])] + +install :: FloatedDefns -> Expression -> Expression +install defnGroups e = foldr installGroup e defnGroups + where installGroup (level,isRec,defns) e = ELet isRec defns e + +float_e :: Expr (Name,Level) -> (FloatedDefns, Expression) +float_e (EConst k) = ([], EConst k) +float_e (EVar v) = ([], EVar v) +float_e (EAp e1 e2) = (fd1++fd2, EAp e1' e2') + where (fd1, e1') = float_e e1 + (fd2, e2') = float_e e2 + +float_e (ELam args body) + = (outerLevelDefns, ELam args' (install thisLevelDefns body')) + where args' = [ arg | (arg,level) <- args ] + (_, thisLevel) = head args + (floatedDefns, body') = float_e body + thisLevelDefns = filter groupIsThisLevel floatedDefns + outerLevelDefns = filter (not.groupIsThisLevel) floatedDefns + groupIsThisLevel (level,_,_) = level >= thisLevel + +float_e (ELet isRec defns body) + = (rhsFloatDefns ++ [thisGroup] ++ bodyFloatDefns, body') + where (bodyFloatDefns, body') = float_e body + (rhsFloatDefns, defns') = mapAccuml float_defn [] defns + thisGroup = (thisLevel, isRec, defns') + (_, thisLevel) = head (bindersOf defns) + +float_defn floatedDefns ((name,level),rhs) + = (rhsFloatDefns ++ floatedDefns, (name, rhs')) + where (rhsFloatDefns, rhs') = float_e rhs diff --git a/demos/Modular/Readme b/demos/Modular/Readme new file mode 100644 index 0000000..f680723 --- /dev/null +++ b/demos/Modular/Readme @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +The files in this directory are based on the programs described in: + + A Modular fully-lazy lambda lifter in Haskell + Simon L. Peyton Jones and David Lester + Software -- Practice and Experience + Vol 21(5), pp.479-506 + MAY 1991 + +These files include: + + Readme -- this file. + + Utility -- implementation of various utility functions and + data types including sets, bags and name supplies. + The paper referred to above includes type signatures + for the operations defined in this file but does not + actually give definitions. I trust that my own + implementations of these functions will be satisfactory! + + LambdaLift -- simple lambda lifter. Contains code from the first + half of the above paper. + + Laziness -- transformations for fully-lazy lambda lifting. Contains + the remaining code from the above paper. + + Demo -- demonstration of lamda lifting (normal and fully-lazy + variants). This hastily-written file contains definitions + for a parser and input parser for the expressions used + in the preceeding two files. This file can only be loaded + if the Parse file from MiniProlog has already been loaded + into Gofer. As it stands, this code uses non-standard + features of Gofer and will not (i.e. should not!) be + accepted by a Haskell compiler. + +The modular fully-lazy lambda lifter and demonstration files can be loaded +into Gofer with the command: + + gofer Utility LambdaLift Laziness ../Prolog/Parse Demo + (or, using the project file supplied, gofer + mlamlift.gp) + +The kind of results that can be obtained are illustrated by: + +? show example1 +let f = (\x.let g = (\y.(Plus (Times x x) y)) in (Plus (g 3) (g 4))) in (f 6) + +? ll example1 + 1) $main = let f = SC1 in (f 6) + 2) SC1 x = let g = (SC0 x) in (Plus (g 3) (g 4)) + 3) SC0 x y = (Plus (Times x x) y) + +? fll example1 + 1) $main = let f0 = SC1 in (f0 6) + 2) SC1 x1 = let v4 = (Plus (Times x1 x1)) in + let g2 = (SC0 v4) in (Plus (g2 3) (g2 4)) + 3) SC0 v4 y3 = (v4 y3) + + +? show example2 +let f = (\x.letrec g = (\y.(Cons (Times x x) (g y))) in (g 3)) in (f 6) + +? ll example2 + 1) $main = let f = SC1 in (f 6) + 2) SC1 x = letrec g = (SC0 g x) in (g 3) + 3) SC0 g x y = (Cons (Times x x) (g y)) + +? fll example2 + 1) $main = let f0 = SC1 in (f0 6) + 2) SC1 x1 = let v4 = (Cons (Times x1 x1)) in + letrec g2 = (SC0 g2 v4) in (g2 3) + 3) SC0 g2 v4 y3 = (v4 (g2 y3)) + +------------------------------------------------------------------------------ diff --git a/demos/Modular/Utility b/demos/Modular/Utility new file mode 100644 index 0000000..3010442 --- /dev/null +++ b/demos/Modular/Utility @@ -0,0 +1,113 @@ +------------------------------------------------------------------------------ +--The files in this directory are based on the programs described in: +-- +-- A Modular fully-lazy lambda lifter in Haskell +-- Simon L. Peyton Jones and David Lester +-- Software -- Practice and Experience +-- Vol 21(5), pp.479-506 +-- MAY 1991 +-- +--See the Readme file for more details. +------------------------------------------------------------------------------ + +-- Utilities: +-- The following general purpose function is defined in the above paper: +mapAccuml :: (b -> a -> (b,c)) -> b -> [a] -> (b,[c]) +mapAccuml f b [] = (b,[]) +mapAccuml f b (a:as) = (b'',c:cs) where (b',c) = f b a + (b'',cs) = mapAccuml f b' as + +-- All subsequent definitions are my own implementations of functions +-- specified only by type signatures and informal descriptions in the +-- paper -- so blame me for any errors or misinterpretations! + +-- Sets: sets are implemented as ordered lists with no repetitions, as +-- suggested by the use of (Ord) in the given signatures. +-- Just for a change, we'll write these definitions out as +-- iterations... + +data Set a = Set [a] + +setDifference :: Ord a => Set a -> Set a -> Set a +setDifference (Set xs) (Set ys) = Set (differ xs ys) + where differ (x:xs) (y:ys) + | x==y = differ xs ys + | x Set a -> Set a -> Set a +setIntersect (Set xs) (Set ys) = Set (intersect xs ys) + where intersect (x:xs) (y:ys) + | x==y = x : intersect xs ys + | x Set a -> Set a -> Set a +setUnion (Set xs) (Set ys) = Set (union xs ys) + where union (x:xs) (y:ys) + | x==y = x : union xs ys + | x [Set a] -> Set a +setUnionList = foldr setUnion setEmpty + +setToList :: Set a -> [a] +setToList (Set xs) = xs + +setFromList :: Ord a => [a] -> Set a +setFromList = Set . sort . nub + +setSingleton :: a -> Set a +setSingleton a = Set [a] + +setEmpty :: Set a +setEmpty = Set [] + +-- Bags: the given interface doesn't impose any constraint on the types +-- that can be held in bags, so it doesn't seem that there is much +-- to do other than make a bag type out of lists... for the benefits +-- of type checking, I'll make a separate Bag data type constructor, +-- although a synonym would have been acceptable... + +data Bag a = Bag [a] + +bagUnion :: Bag a -> Bag a -> Bag a +bagUnion (Bag xs) (Bag ys) = Bag (xs++ys) + +bagInsert :: a -> Bag a -> Bag a +bagInsert x (Bag xs) = Bag (x:xs) + +bagToList :: Bag a -> [a] +bagToList (Bag bag) = bag + +bagFromList :: [a] -> Bag a +bagFromList = Bag + +bagSingleton :: a -> Bag a +bagSingleton x = Bag [x] + +bagEmpty :: Bag a +bagEmpty = Bag [] + +-- Association lists: + +type Assn a b = [(a,b)] + +assLookup :: Eq a => Assn a b -> a -> b +assLookup ps a = head [ b | (a',b) <- ps, a==a' ] + +-- Name supply: + +type NameSupply = Int + +initialNameSupply :: NameSupply +initialNameSupply = 0 + +newName :: NameSupply -> String -> (NameSupply,String) +newName ns prefix = (ns+1, prefix ++ show ns) + +-- That's it!!! diff --git a/demos/Modular/mlamlift.gp b/demos/Modular/mlamlift.gp new file mode 100644 index 0000000..634d145 --- /dev/null +++ b/demos/Modular/mlamlift.gp @@ -0,0 +1,12 @@ +-- A simple project file for the modular fully-lazy lambda lifter +-- +-- Load into Gofer interpreter using the command: :p mlamlift.gp +-- or from command line using: gofer + mlamlift.gp +-- +-- See Readme file for further details. + +Utility -- implementation of utility functions and datatypes +LambdaLift -- simple lambda lifter. +Laziness -- transformations for fully-lazy lambda lifting. +../Prolog/Parse -- the parser library from the mini Prolog system +Demo -- demonstration of lamda lifting diff --git a/demos/Prolog/AndorraEngine b/demos/Prolog/AndorraEngine new file mode 100644 index 0000000..6988779 --- /dev/null +++ b/demos/Prolog/AndorraEngine @@ -0,0 +1,96 @@ +---------------------------------------------------------------- + +version = "Andorra Principle Interpreter (select deterministic goals first)" + +{- +By Donald A. Smith, December 22, 1994, based on Mark Jones' PureEngine. + +This inference engine implements a variation of the Andorra Principle for +logic programming. (See references at the end of this file.) The basic +idea is that instead of always selecting the first goal in the current +list of goals, select a relatively deterministic goal. + +For each goal g in the list of goals, calculate the resolvents that would +result from selecting g. Then choose a g which results in the lowest +number of resolvents. If some g results in 0 resolvents then fail. +(This would occur for a goal like: ?- append(A,B,[1,2,3]),equals(1,2).) +Prolog would not perform this optimization and would instead search +and backtrack wastefully. If some g results in a single resolvent +(i.e., only a single clause matches) then that g will get selected; +by selecting and resolving g, bindings are propagated sooner, and useless +search can be avoided, since these bindings may prune away choices for +other clauses. For example: ?- append(A,B,[1,2,3]),B=[]. +-} + +solve :: Database -> Int -> Subst -> [Term] -> [Subst] +solve db = slv where + slv :: Int -> Subst -> [Term] -> [Subst] + slv n s [] = [s] + slv n s goals = + let allResolvents = resolve_selecting_each_goal goals db n in + let (gs,gres) = findMostDeterministic allResolvents in + concat [slv (n+1) (u**s) (map (app u) (tp++gs)) | (u,tp) <- gres] + +resolve_selecting_each_goal:: + [Term] -> Database -> Int -> [([Term],[(Subst,[Term])])] +-- For each pair in the list that we return, the first element of the +-- pair is the list of unresolved goals; the second element is the list +-- of resolvents of the selected goal, where a resolvent is a pair +-- consisting of a substitution and a list of new goals. +resolve_selecting_each_goal goals db n = [(gs, gResolvents) | + (g,gs) <- delete goals, gResolvents = resolve db g n] + +-- The unselected goals from above are not passed in. +resolve :: Database -> Term -> Int -> [(Subst,[Term])] +resolve db g n = [(u,tp) | (tm:-tp)<-renClauses db n g, u<-unify g tm] +-- u is not yet applied to tp, since it is possible that g won't be selected. +-- Note that unify could be nondeterministic. + +findMostDeterministic:: [([Term],[(Subst,[Term])])] -> ([Term],[(Subst,[Term])]) +findMostDeterministic allResolvents = minF comp allResolvents where + comp:: (a,[b]) -> (a,[b]) -> Bool + comp (_,gs1) (_,gs2) = (length gs1) < (length gs2) +-- It seems to me that there is an opportunity for a clever compiler to +-- optimize this code a lot. In particular, there should be no need to +-- determine the total length of a goal list if it is known that +-- there is a shorter goal list in allResolvents ... ? + +delete :: [a] -> [(a,[a])] +delete l = d l [] where + d :: [a] -> [a] -> [(a,[a])] + d [g] sofar = [ (g,sofar) ] + d (g:gs) sofar = (g,sofar++gs) : (d gs (g:sofar)) + +minF :: (a -> a -> Bool) -> [a] -> a +minF f (h:t) = m h t where +-- m :: a -> [a] -> a + m sofar [] = sofar + m sofar (h:t) = if (f h sofar) then m h t else m sofar t + +prove :: Database -> [Term] -> [Subst] +prove db = solve db 1 nullSubst + +{- An optimized, incremental version of the above interpreter would use + a data representation in which for each goal in "goals" we carry around + the list of resolvents. After each resolution step we update the lists. +-} + +{- References + + Seif Haridi & Per Brand, "Andorra Prolog, an integration of Prolog + and committed choice languages" in Proceedings of FGCS 1988, ICOT, + Tokyo, 1988. + + Vitor Santos Costa, David H. D. Warren, and Rong Yang, "Two papers on + the Andorra-I engine and preprocessor", in Proceedings of the 8th + ICLP. MIT Press, 1991. + + Steve Gregory and Rong Yang, "Parallel Constraint Solving in + Andorra-I", in Proceedings of FGCS'92. ICOT, Tokyo, 1992. + + Sverker Janson and Seif Haridi, "Programming Paradigms of the Andorra + Kernel Language", in Proceedings of ILPS'91. MIT Press, 1991. + + Torkel Franzen, Seif Haridi, and Sverker Janson, "An Overview of the + Andorra Kernel Language", In LNAI (LNCS) 596, Springer-Verlag, 1992. +-} diff --git a/demos/Prolog/Interact b/demos/Prolog/Interact new file mode 100644 index 0000000..fe93460 --- /dev/null +++ b/demos/Prolog/Interact @@ -0,0 +1,75 @@ +-- +-- Interactive utility functions +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +-- The functions defined in this module provide basic facilities for +-- writing line-oriented interactive programs (i.e. a function mapping +-- an input string to an appropriate output string). These definitions +-- are an enhancement of thos in B+W 7.8 +-- +-- skip p is an interactive program which consumes no input, produces +-- no output and then behaves like the interactive program p. +-- end is an interactive program which ignores the input and +-- produces no output. +-- writeln txt p is an interactive program which outputs the message txt +-- and then behaves like the interactive program p +-- readch act def is an interactive program which reads the first character c +-- from the input stream and behaves like the interactive +-- program act c. If the input character stream is empty, +-- readch act def prints the default string def and terminates. +-- +-- readln p g is an interactive program which prints the prompt p and +-- reads a line (upto the first carriage return, or end of +-- input) from the input stream. It then behaves like g line. +-- Backspace characters included in the input stream are +-- interpretted in the usual way. + +type Interactive = String -> String + +--- Interactive program combining forms: + +skip :: Interactive -> Interactive +skip p is = p is -- a dressed up identity function + +end :: Interactive +end is = "" + +writeln :: String -> Interactive -> Interactive +writeln txt p is = txt ++ p is + +readch :: (Char -> Interactive) -> String -> Interactive +readch act def "" = def +readch act def (c:cs) = act c cs + +readln :: String -> (String -> Interactive) -> Interactive +readln prompt g is = prompt ++ lineOut 0 line ++ "\n" + ++ g (noBackSpaces line) input' + where line = before '\n' is + input' = after '\n' is + after x = tail . dropWhile (x/=) + before x = takeWhile (x/=) + +--- Filter out backspaces etc: + +rubout :: Char -> Bool +rubout c = (c=='\DEL' || c=='\BS') + +lineOut :: Int -> String -> String +lineOut n "" = "" +lineOut n (c:cs) + | n>0 && rubout c = "\BS \BS" ++ lineOut (n-1) cs + | n==0 && rubout c = lineOut 0 cs + | otherwise = c:lineOut (n+1) cs + +noBackSpaces :: String -> String +noBackSpaces = reverse . delete 0 . reverse + where delete n "" = "" + delete n (c:cs) + | rubout c = delete (n+1) cs + | n>0 = delete (n-1) cs + | otherwise = c:delete 0 cs + +--- End of Interact.hs diff --git a/demos/Prolog/Main b/demos/Prolog/Main new file mode 100644 index 0000000..19d65a3 --- /dev/null +++ b/demos/Prolog/Main @@ -0,0 +1,82 @@ +-- +-- Prolog interpreter top level module +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +--- Command structure and parsing: + +data Command = Fact Clause | Query [Term] | Show | Error | Quit | NoChange + +command :: Parser Command +command = just (sptok "bye" `orelse` sptok "quit") `do` (\quit->Quit) + `orelse` + just (okay NoChange) + `orelse` + just (sptok "??") `do` (\show->Show) + `orelse` + just clause `do` Fact + `orelse` + just (sptok "?-" `seq` termlist) `do` (\(q,ts)->Query ts) + `orelse` + okay Error + +--- Main program read-solve-print loop: + +signOn :: String +signOn = "Mini Prolog Version 1.5g (" ++ version ++ ")\n\n" + +main :: Dialogue +main = echo False abort + (appendChan stdout signOn abort + (appendChan stdout ("Reading " ++ stdlib) abort + (readFile stdlib + (\fail -> appendChan stdout "...not found\n" abort + (interpreter [])) + (\is -> let parse = map clause (lines is) + clauses = [ r | ((r,""):_) <- parse ] + reading = ['.'| c <- clauses] ++ "done\n" + in + appendChan stdout reading abort + (interpreter clauses)) + ))) + +stdlib :: String +stdlib = "stdlib" + +interpreter :: [Clause] -> Dialogue +interpreter lib = readChan stdin abort + (\is -> appendChan stdout (loop startDb is) abort done) + where startDb = foldl addClause emptyDb lib + +loop :: Database -> String -> String +loop db = readln "> " (exec db . fst . head . command) + +exec :: Database -> Command -> String -> String +exec db (Fact r) = skip (loop (addClause db r)) +exec db (Query q) = demonstrate db q +exec db Show = writeln (show db) (loop db) +exec db Error = writeln "I don't understand\n" (loop db) +exec db Quit = writeln "Thank you and goodbye\n" end +exec db NoChange = skip (loop db) + +--- Handle printing of solutions etc... + +solution :: [Id] -> Subst -> [String] +solution vs s = [ show (Var i) ++ " = " ++ show v + | (i,v) <- [ (i,s i) | i<-vs ], v /= Var i ] + +demonstrate :: Database -> [Term] -> Interactive +demonstrate db q = printOut (map (solution vs) (prove db q)) + where vs = (nub . concat . map varsIn) q + printOut [] = writeln "no.\n" (loop db) + printOut ([]:bs) = writeln "yes.\n" (loop db) + printOut (b:bs) = writeln (doLines b) (nextReqd bs) + doLines = foldr1 (\xs ys -> xs ++ "\n" ++ ys) + nextReqd bs = writeln " " + (readch (\c->if c==';' + then writeln ";\n" (printOut bs) + else writeln "\n" (loop db)) "") + +--- End of Main.hs diff --git a/demos/Prolog/Parse b/demos/Prolog/Parse new file mode 100644 index 0000000..a12550a --- /dev/null +++ b/demos/Prolog/Parse @@ -0,0 +1,104 @@ +-- +-- General parsing library, based on Richard Bird's parselib.orw for Orwell +-- (with a number of extensions) +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +infixr 6 `seq` +infixl 5 `do` +infixr 4 `orelse` + +--- Type definition: + +type Parser a = [Char] -> [(a,[Char])] + +-- A parser is a function which maps an input stream of characters into +-- a list of pairs each containing a parsed value and the remainder of the +-- unused input stream. This approach allows us to use the list of +-- successes technique to detect errors (i.e. empty list ==> syntax error). +-- it also permits the use of ambiguous grammars in which there may be more +-- than one valid parse of an input string. + +--- Primitive parsers: + +-- fail is a parser which always fails. +-- okay v is a parser which always succeeds without consuming any characters +-- from the input string, with parsed value v. +-- tok w is a parser which succeeds if the input stream begins with the +-- string (token) w, returning the matching string and the following +-- input. If the input does not begin with w then the parser fails. +-- sat p is a parser which succeeds with value c if c is the first input +-- character and c satisfies the predicate p. + +fail :: Parser a +fail is = [] + +okay :: a -> Parser a +okay v is = [(v,is)] + +tok :: [Char] -> Parser [Char] +tok w is = [(w, drop n is) | w == take n is] + where n = length w + +sat :: (Char -> Bool) -> Parser Char +sat p [] = [] +sat p (c:is) = [ (c,is) | p c ] + +--- Parser combinators: + +-- p1 `orelse` p2 is a parser which returns all possible parses of the input +-- string, first using the parser p1, then using parser p2. +-- p1 `seq` p2 is a parser which returns pairs of values (v1,v2) where +-- v1 is the result of parsing the input string using p1 and +-- v2 is the result of parsing the remaining input using p2. +-- p `do` f is a parser which behaves like the parser p, but returns +-- the value f v wherever p would have returned the value v. +-- +-- just p is a parser which behaves like the parser p, but rejects any +-- parses in which the remaining input string is not blank. +-- sp p behaves like the parser p, but ignores leading spaces. +-- sptok w behaves like the parser tok w, but ignores leading spaces. +-- +-- many p returns a list of values, each parsed using the parser p. +-- many1 p parses a non-empty list of values, each parsed using p. +-- listOf p s parses a list of input values using the parser p, with +-- separators parsed using the parser s. + +orelse :: Parser a -> Parser a -> Parser a +(p1 `orelse` p2) is = p1 is ++ p2 is + +seq :: Parser a -> Parser b -> Parser (a,b) +(p1 `seq` p2) is = [((v1,v2),is2) | (v1,is1) <- p1 is, (v2,is2) <- p2 is1] + +do :: Parser a -> (a -> b) -> Parser b +(p `do` f) is = [(f v, is1) | (v,is1) <- p is] + +just :: Parser a -> Parser a +just p is = [ (v,"") | (v,is')<- p is, dropWhile (' '==) is' == "" ] + +sp :: Parser a -> Parser a +sp p = p . dropWhile (' '==) + +sptok :: [Char] -> Parser [Char] +sptok = sp . tok + +many :: Parser a -> Parser [a] +many p = q + where q = ((p `seq` q) `do` makeList) `orelse` (okay []) + +many1 :: Parser a -> Parser [a] +many1 p = p `seq` many p `do` makeList + +listOf :: Parser a -> Parser b -> Parser [a] +listOf p s = p `seq` many (s `seq` p) `do` nonempty + `orelse` okay [] + where nonempty (x,xs) = x:(map snd xs) + +--- Internals: + +makeList :: (a,[a]) -> [a] +makeList (x,xs) = x:xs + +--- End of Parse.hs diff --git a/demos/Prolog/PrologData b/demos/Prolog/PrologData new file mode 100644 index 0000000..8ca7abb --- /dev/null +++ b/demos/Prolog/PrologData @@ -0,0 +1,120 @@ +-- +-- Representation of Prolog Terms, Clauses and Databases +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +infix 6 :- + +--- Prolog Terms: + +type Id = (Int,String) +type Atom = String +data Term = Var Id | Struct Atom [Term] +data Clause = Term :- [Term] +data Database = Db [(Atom,[Clause])] + +instance Eq Term where + Var v == Var w = v==w + Struct a ts == Struct b ss = a==b && ts==ss + _ == _ = False + +--- Determine the list of variables in a term: + +varsIn :: Term -> [Id] +varsIn (Var i) = [i] +varsIn (Struct i ts) = (nub . concat . map varsIn) ts + +renameVars :: Int -> Term -> Term +renameVars lev (Var (n,s)) = Var (lev,s) +renameVars lev (Struct s ts) = Struct s (map (renameVars lev) ts) + +--- Functions for manipulating databases (as an abstract datatype) + +emptyDb :: Database +emptyDb = Db [] + +renClauses :: Database -> Int -> Term -> [Clause] +renClauses db n (Var _) = [] +renClauses db n (Struct a _) = [ r tm:-map r tp | (tm:-tp)<-clausesFor a db ] + where r = renameVars n + +clausesFor :: Atom -> Database -> [Clause] +clausesFor a (Db rss) = case dropWhile (\(n,rs) -> n [] + ((n,rs):_) -> if a==n then rs else [] + +addClause :: Database -> Clause -> Database +addClause (Db rss) r@(Struct a _ :- _) + = Db (update rss) + where update [] = [(a,[r])] + update (h@(n,rs):rss') + | n==a = (n,rs++[r]) : rss' + | n u . showChar '\n' . v) + [ showWithTerm "\n" rs | (i,rs)<-rss ] + +--- Local functions for use in defining instances of Text: + +showWithSep :: Text a => String -> [a] -> ShowS +showWithSep s [x] = shows x +showWithSep s (x:xs) = shows x . showString s . showWithSep s xs + +showWithTerm :: Text a => String -> [a] -> ShowS +showWithTerm s xs = foldr1 (.) [shows x . showString s | x<-xs] + +--- String parsing functions for Terms and Clauses: +--- Local definitions: + +letter :: Parser Char +letter = sat (\c->isAlpha c || isDigit c || c `elem` ":;+=-*&%$#@?/.~!") + +variable :: Parser Term +variable = sat isUpper `seq` many letter `do` makeVar + where makeVar (initial,rest) = Var (0,(initial:rest)) + +struct :: Parser Term +struct = many letter `seq` (sptok "(" `seq` termlist `seq` sptok ")" + `do` (\(o,(ts,c))->ts) + `orelse` + okay []) + `do` (\(name,terms)->Struct name terms) + +--- Exports: + +term :: Parser Term +term = sp (variable `orelse` struct) + +termlist :: Parser [Term] +termlist = listOf term (sptok ",") + +clause :: Parser Clause +clause = sp struct `seq` (sptok ":-" `seq` listOf term (sptok ",") + `do` (\(from,body)->body) + `orelse` okay []) + `seq` sptok "." + `do` (\(head,(goals,dot))->head:-goals) + +--- End of PrologData.hs diff --git a/demos/Prolog/PureEngine b/demos/Prolog/PureEngine new file mode 100644 index 0000000..f520c63 --- /dev/null +++ b/demos/Prolog/PureEngine @@ -0,0 +1,39 @@ +-- +-- The Pure Prolog inference engine (using explicit prooftrees) +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +version = "tree based" + +--- Calculation of solutions: + +-- Each node in a prooftree corresponds to: +-- either: a solution to the current goal, represented by Done s, where s +-- is the required substitution +-- or: a choice between a number of subtrees ts, each corresponding to a +-- proof of a subgoal of the current goal, represented by Choice ts. +-- The proof tree corresponding to an unsolvable goal is Choice [] + +data Prooftree = Done Subst | Choice [Prooftree] + +-- prooftree uses the rules of Prolog to construct a suitable proof tree for +-- a specified goal +prooftree :: Database -> Int -> Subst -> [Term] -> Prooftree +prooftree db = pt + where pt :: Int -> Subst -> [Term] -> Prooftree + pt n s [] = Done s + pt n s (g:gs) = Choice [ pt (n+1) (u**s) (map (app u) (tp++gs)) + | (tm:-tp)<-renClauses db n g, u<-unify g tm ] + +-- search performs a depth-first search of a proof tree, producing the list +-- of solution substitutions as they are encountered. +search :: Prooftree -> [Subst] +search (Done s) = [s] +search (Choice pts) = [ s | pt <- pts, s <- search pt ] + +prove :: Database -> [Term] -> [Subst] +prove db = search . prooftree db 1 nullSubst + +--- End of PureEngine.hs diff --git a/demos/Prolog/Readme b/demos/Prolog/Readme new file mode 100644 index 0000000..354cd19 --- /dev/null +++ b/demos/Prolog/Readme @@ -0,0 +1,281 @@ +______________________________________________________________________________ +Mini Prolog Version 1.5g Mark P. Jones 23rd July 1991 + + A simple Prolog interpreter, for Gofer 2.28 + +______________________________________________________________________________ + + +This document gives a brief introduction to Mini Prolog Version 1.5g, a simple +Prolog interpreter that can be used with Gofer 2.28. The original version of +this program was written nearly two years ago as an Orwell program, running on +the interpreter used here in Oxford for teaching functional programming. More +recently I rewrote the interpreter for the Haskell B. compiler produced by the +people at Chalmers in Sweden, and took the opportunity to experiment with some +of the new features of Haskell, including type classes and I/O. Only a few +small changes to the Haskell B version have been necessary to make Mini Prolog +run under my own Haskell-like interpreter, Gofer, with most of these being +required to take account of changes in the definition of Haskell from version +1.0 to the latest version 1.1, due at the end of the month. + +This document isn't going to explain a lot about how Prolog programs are +written and work. But there are plenty of other references for that. Please +feel free to contact me with any questions or suggestions. I'd very much like +to receive any comments. + +jones-mark@cs.yale.edu +______________________________________________________________________________ + + GETTING STARTED + +The Mini Prolog interpreter takes the form of a small collection of Gofer +scripts. The most important part of any implementation of Prolog is the +inference engine which controls the search for goals to user supplied +queries. Mini Prolog comes with a choice of two different inference engines, +the `pure' engine uses lazy evaluation to construct and traverse potentially +infinite proof trees. The `stack' engine uses an explicit stack (implemented +using a list) to provide a more concrete description of backtracking. The +stack engine also implements the Prolog cut `!' predicate, used in the +examples below. Assuming that you've got everything set up properly to use +the Gofer interpreter, and that all of the Mini Prolog script files are in the +current working directory, you should start Gofer with the command `gofer': + + machine% gofer + Gofer Version 2.20 + + Reading script file "/users/mpj/research/Gofer/prelude": + Parsing................................................................... + Dependency analysis....................................................... + Type checking............................................................. + Compiling................................................................. + + Gofer session for: + /users/mpj/research/Gofer/prelude + Type :? for help + +and then specify the appropriate set of script to be loaded: + + ? :l Parse Interact PrologData Subst PureEngine Main + +for the `pure' version of the inference engine, or: + + ? :l Parse Interact PrologData Subst StackEngine Main + +for the stack version, which is the one needed for the rest of this document. +Once the script files have been loaded, start the Mini prolog interpreter by +typing the expression `main' and pressing return. + + ? main + Mini Prolog Version 1.5g (stack based) + + Reading stdlib........done + > + +The `>' prompt indicates that the interpreter is running and waiting for user +input. + + STANDARD PREDICATES + +Before the `>' prompt appears, Mini Prolog reads a set of standard predicate +definitions from the file `stdlib' in the current directory. You are free to +modify this file to suit your own needs. The only predicate that is built in +to Mini Prolog is the cut, written `!' whose use is demonstrated below. There +are no other extralogical predicates, no input/output predicates and no +arithmetic as found in full implementations of Prolog. Some of these features +could be added to the interpreter without too much difficulty, others would +require rather more work. + +At any time, you can ask the interpreter to display the list of rules that are +being held in the database by typing "??" and pressing the return key. Try +this after you've started the interpreter and you'll get a list of the +predicates defined in the file `stdlib'. For example: + + > ?? + append(nil,X,X). + append(cons(X,Y),Z,cons(X,W)):-append(Y,Z,W). + + equals(X,X). + + not(X):-X,!,false. + not(X). + + or(X,Y):-X. + or(X,Y):-Y. + + true. + > + + THE APPEND PREDICATE + +The Mini Prolog interpreter does not support the standard Prolog syntax for +lists. Instead, you have to write the list [1,2,3] as +"cons(1,cons(2,cons(3,nil)))". One of the first things I tried was appending +two simple lists: + + > ?- append(cons(1,nil),cons(2,nil),X) + X = cons(1,cons(2,nil)) ; + no. + > + +Given a query, Mini Prolog attempts to find values for each of the variables +(beginning with a capital letter) in the query. Here Mini Prolog has found +that X = cons(1,cons(2,nil)) is a solution to the query. When I press the +semicolon key, ";", it tries to find another solution, but fails and displays +the message "no.". + +What amazed me when I first started experimenting with Prolog was that I could +actually ask Mini Prolog to work through the problem in reverse, asking which +lists could be appended to get the list cons(1,cons(2,nil)): + + > ?- append(X,Y,cons(1,cons(2,nil))) + X = nil + Y = cons(1,cons(2,nil)) ; + X = cons(1,nil) + Y = cons(2,nil) ; + X = cons(1,cons(2,nil)) + Y = nil ; + no. + > + +Note that the interpreter pauses after displaying each solution and waits for +a key to be pressed. Pressing `;' tells Mini Prolog to continue looking for +another solution, displaying `no' if no more solutions can be found. Pressing +any other key stops the execution of the query. If there are no variables in +the original query, then the interpreter simply outputs `yes' if the query can +be proved and otherwise prints `no': + + > ?- append(cons(1,nil),cons(2,nil),cons(1,cons(2,nil))) + yes. + > ?- append(cons(1,nil),cons(2,nil),cons(1,cons(3,nil))) + no. + > + +Unfortunately, typing a control C to interrupt a query with an infinite loop +will exit the Prolog interpreter completely -- sorry, but I don't know a way +around this at the moment. + + + RUNNING IN THE FAMILY + +You don't have to stick with the standard predicates that are already included +in Mini Prolog. Additional rules can be typed in at the ">" prompt. Here are +a couple of examples based around the idea of family trees: + + > parent(Child,Parent):-father(Child,Parent). + > parent(Child,Parent):-mother(Child,Parent). + > grandparent(GChild,Gparent):-parent(GChild,Parent),parent(Parent,Gparent). + > + +Note that Mini Prolog expects a maximum of one rule per line, and will not +allow predicate definitions to be spread out over a number of lines. + +All you have to do now is enter some details about your family and then you +can ask who your grandparents are ... let's take a typical family: + + > father(charles,princePhilip). + > mother(charles,theQueen). + > father(anne,princePhilip). + > mother(anne,theQueen). + > father(andrew,princePhilip). + > mother(andrew,theQueen). + > father(edward,princePhilip). + > mother(edward,theQueen). + > mother(theQueen,theQueenMother). + > father(william,charles). + > mother(william,diana). + > father(harry,charles). + > mother(harry,diana). + > + +And now we can ask some questions; like who are the Queen mother's +grandchildren ? + + > ?- grandparent(X,theQueenMother) + X = charles ; + X = anne ; + X = andrew ; + X = edward ; + no. + > + +or, who are Harry's grandparents ? + + > ?- grandparent(harry,Who) + Who = princePhilip ; + Who = theQueen ; + no. + > + +Note that Mini Prolog can only use the facts it has been given. Tell it a +little more about Diana's parents and you'll find it knows more about Harry's +grandparents. + +Now suppose we define a sibling relation: + + > sibling(One,Tother) :- parent(One,X),parent(Tother,X). + > + +Fine. It all looks quite correct. But when you try to find Harry's siblings, +you get: + + > ?- sibling(harry,Who) + Who = william ; + Who = harry ; + Who = william ; + Who = harry ; + no. + > + +Each of William and Harry appears twice in the above. Once by putting +X=charles and once using X=diana in the definition of sibling above. We can +use the cut predicate to make sure that we look for at most one parent: + + > newsib(One,Tother) :- parent(One,X),!,parent(Tother,X). + > + > ?- newsib(harry,Who) + Who = william ; + Who = harry ; + no. + > + +Thats better, but we don't really want to list Harry as his own sibling, so +we'll add a further restriction: + + > newsib1(O,T):-parent(O,X),!,parent(T,X),not(equals(O,T)). + > + > ?- newsib1(harry,Who) + Who = william ; + no. + > + +Thats just about perfect. You might like to play with some other examples, +enlarge the family tree, work out suitable predicates for other relations (who +are Harry's aunts ?) etc. Initially, the answers that Mini Prolog gives will +all be pretty obvious to you. Try getting involved in a larger family tree +and more complicated relations and you'll find it's not so easy. + + GOODBYES + +I could go on with more examples, but I guess you've got the picture by now +... at least I hope so ! I suppose I should just tell you how to get out of +Mini Prolog (ok. ^C works but its not exactly elegant). Just type "bye" (or +"quit") and you're out. Be warned though: when you leave Mini Prolog, it will +not retain any new rules that you've entered, so you'll have to find some +other way to save them (I usually type "??" to list the rules that I've +entered and use the mouse to paste them into an editor in another window, but +that obviously requires you to be using a workstation at the time). + + > bye + Thank you and goodbye + + (12749 reductions, 1256 cells) + ? + +The `?' prompt tells you that you are now back in Gofer, and you can restart +Mini Prolog as before, carry on with some other work in Gofer, or use the :q +command to exit Gofer and return to the operating system. + +I hope you have fun with Mini Prolog; please tell me if you have any comments +you'd like to make. + +______________________________________________________________________________ diff --git a/demos/Prolog/StackEngine b/demos/Prolog/StackEngine new file mode 100644 index 0000000..d4b754f --- /dev/null +++ b/demos/Prolog/StackEngine @@ -0,0 +1,59 @@ +-- +-- Stack based Prolog inference engine +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +version = "stack based" + +--- Calculation of solutions: + +-- the stack based engine maintains a stack of triples (s,goal,alts) +-- corresponding to backtrack points, where s is the substitution at that +-- point, goal is the outstanding goal and alts is a list of possible ways +-- of extending the current proof to find a solution. Each member of alts +-- is a pair (tp,u) where tp is a new subgoal that must be proved and u is +-- a unifying substitution that must be combined with the substitution s. +-- +-- the list of relevant clauses at each step in the execution is produced +-- by attempting to unify the head of the current goal with a suitably +-- renamed clause from the database. + +type Stack = [ (Subst, [Term], [Alt]) ] +type Alt = ([Term], Subst) + +alts :: Database -> Int -> Term -> [Alt] +alts db n g = [ (tp,u) | (tm:-tp) <- renClauses db n g, u <- unify g tm ] + +-- The use of a stack enables backtracking to be described explicitly, +-- in the following `state-based' definition of prove: + +prove :: Database -> [Term] -> [Subst] +prove db gl = solve 1 nullSubst gl [] + where + solve :: Int -> Subst -> [Term] -> Stack -> [Subst] + solve n s [] ow = s : backtrack n ow + solve n s (g:gs) ow + | g==theCut = solve n s gs (cut ow) + | otherwise = choose n s gs (alts db n (app s g)) ow + + choose :: Int -> Subst -> [Term] -> [Alt] -> Stack -> [Subst] + choose n s gs [] ow = backtrack n ow + choose n s gs ((tp,u):rs) ow = solve (n+1) (u**s) (tp++gs) ((s,gs,rs):ow) + + backtrack :: Int -> Stack -> [Subst] + backtrack n [] = [] + backtrack n ((s,gs,rs):ow) = choose (n-1) s gs rs ow + + +--- Special definitions for the cut predicate: + +theCut :: Term +theCut = Struct "!" [] + +cut :: Stack -> Stack +cut (top:(s,gl,_):ss) = top:(s,gl,[]):ss +cut ss = ss + +--- End of Engine.hs diff --git a/demos/Prolog/Subst b/demos/Prolog/Subst new file mode 100644 index 0000000..e58df06 --- /dev/null +++ b/demos/Prolog/Subst @@ -0,0 +1,62 @@ +-- +-- Substitutions and Unification of Prolog Terms +-- Mark P. Jones November 1990, modified for Gofer 20th July 1991 +-- +-- uses Gofer version 2.28 +-- + +infixr 3 ** +infix 4 ->- + +--- Substitutions: + +type Subst = Id -> Term + +-- substitutions are represented by functions mapping identifiers to terms. +-- +-- app s extends the substitution s to a function mapping terms to terms +-- nullSubst is the empty substitution which maps every identifier to the +-- same identifier (as a term). +-- i ->- t is the substitution which maps the identifier i to the term t, +-- but otherwise behaves like nullSubst. +-- s1 ** s2 is the composition of substitutions s1 and s2 +-- N.B. app is a monoid homomorphism from (Subst,nullSubst,(**)) +-- to (Term -> Term, id, (.)) in the sense that: +-- app (s1 ** s2) = app s1 . app s2 +-- s ** nullSubst = s = nullSubst ** s + +app :: Subst -> Term -> Term +app s (Var i) = s i +app s (Struct a ts) = Struct a (map (app s) ts) + +nullSubst :: Subst +nullSubst i = Var i + +(->-) :: Id -> Term -> Subst +(i ->- t) j | j==i = t + | otherwise = Var j + +(**) :: Subst -> Subst -> Subst +s1 ** s2 = app s1 . s2 + +--- Unification: + +-- unify t1 t2 returns a list containing a single substitution s which is +-- the most general unifier of terms t1 t2. If no unifier +-- exists, the list returned is empty. + +unify :: Term -> Term -> [Subst] +unify (Var x) (Var y) = if x==y then [nullSubst] else [x->-Var y] +unify (Var x) t2 = [ x ->- t2 | x `notElem` varsIn t2 ] +unify t1 (Var y) = [ y ->- t1 | y `notElem` varsIn t1 ] +unify (Struct a ts) (Struct b ss) = [ u | a==b, u<-listUnify ts ss ] + +listUnify :: [Term] -> [Term] -> [Subst] +listUnify [] [] = [nullSubst] +listUnify [] (r:rs) = [] +listUnify (t:ts) [] = [] +listUnify (t:ts) (r:rs) = [ u2 ** u1 | u1<-unify t r, + u2<-listUnify (map (app u1) ts) + (map (app u1) rs) ] + +--- End of Subst.hs diff --git a/demos/Prolog/miniProlog.gp b/demos/Prolog/miniProlog.gp new file mode 100644 index 0000000..f3c4af6 --- /dev/null +++ b/demos/Prolog/miniProlog.gp @@ -0,0 +1,12 @@ +-- This is a project file suitable for loading the stack-based version +-- of the mini Prolog interpreter into Gofer 2.28 +-- +-- Load into Gofer interpreter using the command: :p miniProlog.gp +-- or from command line using: gofer + miniProlog.gp + +Parse -- general purpose parsing library +Interact -- general purpose library for interactive programs +PrologData -- definition of main data structures +Subst -- substitutions and unification +StackEngine -- inference engine +Main -- top level program diff --git a/demos/Prolog/stdlib b/demos/Prolog/stdlib new file mode 100644 index 0000000..758facc --- /dev/null +++ b/demos/Prolog/stdlib @@ -0,0 +1,20 @@ +This file contains a list of predicate definitions that will automatically +be read into Mini Prolog at the beginning of a session. Each clause in this +file must be entered on a single line and lines containing syntax errors are +always ignored. This includes the first few lines of this file and provides +a simple way to include comments. + +append(nil,X,X). +append(cons(X,Y),Z,cons(X,W)):-append(Y,Z,W). + +equals(X,X). + +not(X):-X,!,false. +not(X). + +or(X,Y):-X. +or(X,Y):-Y. + +true. + +End of stdlib diff --git a/demos/Say/say.gs b/demos/Say/say.gs new file mode 100644 index 0000000..8f332c7 --- /dev/null +++ b/demos/Say/say.gs @@ -0,0 +1,102 @@ +------------------------------------------------------------------------------ +-- A simple banner program: Mark P Jones, 1992 +-- +-- Many years ago, I was helping out on a stand at a computer show. +-- Or at least, I would have been if anyone had been interested in +-- what we had on the stand. So instead, I sat down to see if I +-- could write a banner program -- something to print messages out +-- in large letters. +-- +-- The original program was in Basic, but here is a version in Gofer. +-- The program itself is only two lines long and that is rather pleasing, +-- but the raw data for the letters (and the function mapping characters +-- to letters) take up rather more space. I don't have that Basic version +-- anymore. I wonder whether the complete Gofer code is that much shorter? +-- +-- One of the nice things about this program is that the main program is +-- completely independent of the size of characters. You could easily add +-- a new font, perhaps with higher resolution (bigger letters), or even +-- variable width characters, and the program would take it all in its +-- stride. +-- +-- If you have a wide screen (>80 cols), you might like to try evaluating: +-- +-- (concat . map say . lines . say) "Hi" +-- +-- and contemplating how easy it might have been to get my original +-- Basic version to perform this trick... +-- +-- Enjoy! +------------------------------------------------------------------------------ + +say = ('\n':) . unlines . map join . transpose . map picChar + where join = foldr1 (\xs ys -> xs ++ " " ++ ys) + +-- mapping characters to letters: -------------------------------------------- + +picChar c | isUpper c = alphas !! (ord c - ord 'A') + | isLower c = alphas !! (ord c - ord 'a') + | isSpace c = blank + | isDigit c = digits !! (ord c - ord '0') + | c=='/' = slant + | c=='\\' = reverse slant + | otherwise = head ([ letter | (c',letter) <- punct, c'==c ] + ++ [empty]) + +-- letters data: ------------------------------------------------------------- + +blank = [" ", " ", " ", " ", " "] + +slant = [" ", " ", " ", " ", "" ] + +empty = repeat "" + +punct = [('.', [" ", " ", " ", " .. ", " .. "]), + ('?', [" ??? ", "? ?", " ? ", " ? ", " . "]), + ('!', [" ! ", " ! ", " ! ", " ! ", " . "]), + ('-', [" ", " ", "-----", " ", " "]), + ('+', [" + ", " + ", "+++++", " + ", " + "]), + (':', [" ", " :: ", " ", " :: ", " "]), + (';', [" ", " ;; ", " ", " ;; ", " ;; "]) + ] + +digits = [[" 000 ", "0 00", "0 0 0", "00 0", " 000 "], + [" 1 ", " 11 ", " 1 ", " 1 ", "11111"], + [" 222 ", "2 2", " 2 ", " 2 ", "22222"], + ["3333 ", " 3", " 333 ", " 3", "3333 "], + [" 4 ", " 44 ", " 4 4 ", "44444", " 4 "], + ["55555", "5 ", "5555 ", " 5", "5555 "], + [" 66", " 6 ", " 666 ", "6 6", " 666 "], + ["77777", " 7", " 7 ", " 7 ", " 7 "], + [" 888 ", "8 8", " 888 ", "8 8", " 888 "], + [" 999 ", "9 9", " 999 ", " 9 ", "99 "]] + +alphas = [[" A ", " A A ", "AAAAA", "A A", "A A"], + ["BBBB ", "B B", "BBBB ", "B B", "BBBB "], + [" CCCC", "C ", "C ", "C ", " CCCC"], + ["DDDD ", "D D", "D D", "D D", "DDDD "], + ["EEEEE", "E ", "EEEEE", "E ", "EEEEE"], + ["FFFFF", "F ", "FFFF ", "F ", "F "], + [" GGGG", "G ", "G GG", "G G", " GGG "], + ["H H", "H H", "HHHHH", "H H", "H H"], + ["IIIII", " I ", " I ", " I ", "IIIII"], + ["JJJJJ", " J ", " J ", "J J ", " JJ "], + ["K K", "K K ", "KKK ", "K K ", "K K"], + ["L ", "L ", "L ", "L ", "LLLLL"], + ["M M", "MM MM", "M M M", "M M", "M M"], + ["N N", "NN N", "N N N", "N NN", "N N"], + [" OOO ", "O O", "O O", "O O", " OOO "], + ["PPPP ", "P P", "PPPP ", "P ", "P "], + [" QQQ ", "Q Q", "Q Q Q", "Q Q ", " QQ Q"], + ["RRRR ", "R R", "RRRR ", "R R ", "R R"], + [" SSSS", "S ", " SSS ", " S", "SSSS "], + ["TTTTT", " T ", " T ", " T ", " T "], + ["U U", "U U", "U U", "U U", " UUU "], + ["V V", "V V", "V V", " V V ", " V "], + ["W W", "W W", "W W", "W W W", " W W "], + ["X X", " X X ", " X ", " X X ", "X X"], + ["Y Y", " Y Y ", " Y ", " Y ", " Y "], + ["ZZZZZ", " Z ", " Z ", " Z ", "ZZZZZ"] + ] + +-- end of banner program ----------------------------------------------------- diff --git a/demos/Utils/array.gs b/demos/Utils/array.gs new file mode 100644 index 0000000..c1fe158 --- /dev/null +++ b/demos/Utils/array.gs @@ -0,0 +1,73 @@ +-- An inefficient implementation of Haskell arrays based on the +-- functional specification in the Haskell report version 1.2 +-- +-- To save you some typing, just in case you wanted to use this +-- stuff ... but don't expect constant time lookup! + +infixl 9 ! +infixl 9 // +infix 1 := + +data Assoc a b = a := b +data Array a b = MkArray (a,a) (a -> b) + +array :: (Ix a) => (a,a) -> [Assoc a b] -> Array a b +listArray :: (Ix a) => (a,a) -> [b] -> Array a b +(!) :: (Ix a) => Array a b -> a -> b +bounds :: (Ix a) => Array a b -> (a,a) +indices :: (Ix a) => Array a b -> [a] +elems :: (Ix a) => Array a b -> [b] +assocs :: (Ix a) => Array a b -> [Assoc a b] +accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b +(//) :: (Ix a) => Array a b -> [Assoc a b] -> Array a b +accum :: (Ix a) => (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b +amap :: (Ix a) => (b -> c) -> Array a b -> Array a c +ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c + +array b ivs = MkArray b + (\j -> case [v | (i := v) <- ivs, i == j] of + [v] -> v + [] -> error "(!){PreludeArray}: \ + \undefined array element" + _ -> error "(!){PreludeArray}: \ + \multiply defined array element") +listArray b vs = array b (zipWith (:=) (range b) vs) + +(!) (MkArray _ f) = f +bounds (MkArray b _) = b +indices = range . bounds +elems a = [a!i | i <- indices a] +assocs a = [i := a!i | i <- indices a] +a // us = array (bounds a) + ([i := a!i | i <- indices a \\ [i | i:=_ <- us]] + ++ us) + +accum f = foldl (\a (i := v) -> a // [i := f (a!i) v]) + +accumArray f z b = accum f (array b [i := z | i <- range b]) +amap f a = array b [i := f (a!i) | i <- range b] + where b = bounds a +ixmap b f a = array b [i := a ! f i | i <- range b] + +instance (Ix a, Text a, Text b) => Text (Assoc a b) where + showsPrec _ (a := b) = shows a . showString " := " . shows b + +instance (Ix a) => Ix (a,a) where + range ((ma,mb),(na,nb)) = [(a,b) | a <- range (ma,na), b <- range (mb,nb)] + +-- Some applications, taken from the Gentle Introduction ... + +fibs n = a where a = array (0,n) ([ 0 := 1, 1 := 1 ] ++ + [ i := a!(i-2) + a!(i-1) | i <- [2..n] ]) + +fibs10 = fibs 10 + +wavefront n = a where a = array ((1,1),(n,n)) + ([ (1,j) := 1 | j <- [1..n] ] ++ + [ (i,1) := 1 | i <- [2..n] ] ++ + [ (i,j) := a!(i,j-1) + a!(i-1,j-1) + a!(i-1,j) + | i <- [2..n], j <- [2..n] ]) + +listwave n = [ [wf!(i,j) | j <- [1..n]] | i <- [1..n] ] + where wf = wavefront n + diff --git a/demos/Utils/lexer.gs b/demos/Utils/lexer.gs new file mode 100644 index 0000000..4b53931 --- /dev/null +++ b/demos/Utils/lexer.gs @@ -0,0 +1,209 @@ +-- A simple attempt to provide the facilities of the Haskell Text +-- class for reading values. If you really want to use this, I +-- would suggest combining it with the Text class in a modified +-- version of the prelude. +-- +-- Based, not surprisingly, on the definitions in the Haskell report +-- version 1.2: + +type ReadS a = String -> [(a,String)] + +class Read a where + readsPrec :: Int -> ReadS a + readList :: ReadS [a] + readList = readParen False (\r -> [pr | ("[",s) <- lex r, + pr <- readl s]) + where readl s = [([],t) | ("]",t) <- lex s] ++ + [(x:xs,u) | (x,t) <- reads s, + (xs,u) <- readl' t] + readl' s = [([],t) | ("]",t) <- lex s] ++ + [(x:xs,v) | (",",t) <- lex s, + (x,u) <- reads t, + (xs,v) <- readl' u] +instance Read () where + readsPrec p = readParen False + (\r -> [((),t) | ("(",s) <- lex r, + (")",t) <- lex s ] ) + +instance Read Char where + readsPrec p = readParen False + (\r -> [(c,t) | ('\'':s,t)<- lex r, + (c,_) <- readLitChar s]) + + readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r, + (l,_) <- readl s ]) + where readl ('"':s) = [("",s)] + readl ('\\':'&':s) = readl s + readl s = [(c:cs,u) | (c ,t) <- readLitChar s, + (cs,u) <- readl t ] +instance Read Int where + readsPrec p = readSigned readDec + +instance (Read a) => Read [a] where + readsPrec p = readList + +instance (Read a, Read b) => Read (a,b) where + readsPrec p = readParen False + (\r -> [((x,y), w) | ("(",s) <- lex r, + (x,t) <- reads s, + (",",u) <- lex t, + (y,v) <- reads u, + (")",w) <- lex v ] ) + +reads :: (Read a) => ReadS a +reads = readsPrec 0 + +read :: (Read a) => String -> a +read s = case [x | (x,t) <- reads s, ("","") <- lex t] of + [x] -> x + [] -> error "read{PreludeRead}: no parse" + _ -> error "read{PreludeRead}: ambiguous parse" + +readParen :: Bool -> ReadS a -> ReadS a +readParen b g = if b then mandatory else optional + where optional r = g r ++ mandatory r + mandatory r = [(x,u) | ("(",s) <- lex r, + (x,t) <- optional s, + (")",u) <- lex t ] + +lex :: ReadS String +lex "" = [("","")] +lex (c:s) | isSpace c = lex (dropWhile isSpace s) +lex ('-':'-':s) = case dropWhile (/= '\n') s of + '\n':t -> lex t + _ -> [] -- unterminated end-of-line + -- comment + +lex ('{':'-':s) = lexNest lex s + where + lexNest f ('-':'}':s) = f s + lexNest f ('{':'-':s) = lexNest (lexNest f) s + lexNest f (c:s) = lexNest f s + lexNest _ "" = [] -- unterminated + -- nested comment + +lex ('<':'-':s) = [("<-",s)] +lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s, + ch /= "'" ] +lex ('"':s) = [('"':str, t) | (str,t) <- lexString s] + where + lexString ('"':s) = [("\"",s)] + lexString s = [(ch++str, u) + | (ch,t) <- lexStrItem s, + (str,u) <- lexString t ] + + lexStrItem ('\\':'&':s) = [("\\&",s)] + lexStrItem ('\\':c:s) | isSpace c + = [("\\&",t) | '\\':t <- [dropWhile isSpace s]] + lexStrItem s = lexLitChar s + +lex (c:s) | isSingle c = [([c],s)] + | isSym1 c = [(c:sym,t) | (sym,t) <- [span isSym s]] + | isAlpha c = [(c:nam,t) | (nam,t) <- [span isIdChar s]] + | isDigit c = [(c:ds++fe,t) | (ds,s) <- [span isDigit s], + (fe,t) <- lexFracExp s ] + | otherwise = [] -- bad character + where + isSingle c = c `elem` ",;()[]{}_" + isSym1 c = c `elem` "-~" || isSym c + isSym c = c `elem` "!@#$%&*+./<=>?\\^|:" + isIdChar c = isAlphanum c || c `elem` "_'" + + lexFracExp ('.':s) = [('.':ds++e,u) | (ds,t) <- lexDigits s, + (e,u) <- lexExp t ] + lexFracExp s = [("",s)] + + lexExp (e:s) | e `elem` "eE" + = [(e:c:ds,u) | (c:t) <- [s], c `elem` "+-", + (ds,u) <- lexDigits t] ++ + [(e:ds,t) | (ds,t) <- lexDigits s] + lexExp s = [("",s)] + +lexDigits :: ReadS String +lexDigits = nonnull isDigit + +nonnull :: (Char -> Bool) -> ReadS String +nonnull p s = [(cs,t) | (cs@(_:_),t) <- [span p s]] + +lexLitChar :: ReadS String +lexLitChar ('\\':s) = [('\\':esc, t) | (esc,t) <- lexEsc s] + where + lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = [([c],s)] + lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] + lexEsc s@(d:_) | isDigit d = lexDigits s + lexEsc ('o':s) = [('o':os, t) | (os,t) <- nonnull isOctDigit s] + lexEsc ('x':s) = [('x':xs, t) | (xs,t) <- nonnull isHexDigit s] + lexEsc s@(c:_) | isUpper c + = case [(mne,s') | mne <- "DEL" : asciiTab, + ([],s') <- [match mne s] ] + of (pr:_) -> [pr] + [] -> [] + lexEsc _ = [] +lexLitChar (c:s) = [([c],s)] +lexLitChar "" = [] + +isOctDigit c = c >= '0' && c <= '7' +isHexDigit c = isDigit c || c >= 'A' && c <= 'F' + || c >= 'a' && c <= 'f' + +match :: (Eq a) => [a] -> [a] -> ([a],[a]) +match (x:xs) (y:ys) | x == y = match xs ys +match xs ys = (xs,ys) + +asciiTab = ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", + "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", + "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", + "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", + "SP"] + + + +readLitChar :: ReadS Char +readLitChar ('\\':s) = readEsc s + where + readEsc ('a':s) = [('\a',s)] + readEsc ('b':s) = [('\b',s)] + readEsc ('f':s) = [('\f',s)] + readEsc ('n':s) = [('\n',s)] + readEsc ('r':s) = [('\r',s)] + readEsc ('t':s) = [('\t',s)] + readEsc ('v':s) = [('\v',s)] + readEsc ('\\':s) = [('\\',s)] + readEsc ('"':s) = [('"',s)] + readEsc ('\'':s) = [('\'',s)] + readEsc ('^':c:s) | c >= '@' && c <= '_' + = [(chr (ord c - ord '@'), s)] + readEsc s@(d:_) | isDigit d + = [(chr n, t) | (n,t) <- readDec s] + readEsc ('o':s) = [(chr n, t) | (n,t) <- readOct s] + readEsc ('x':s) = [(chr n, t) | (n,t) <- readHex s] + readEsc s@(c:_) | isUpper c + = let table = ('\DEL',"DEL") : zip ['\NUL'..] asciiTab + in case [(c,s') | (c,mne) <- table, + ([],s') <- [match mne s]] + of (pr:_) -> [pr] + [] -> [] + readEsc _ = [] +readLitChar (c:s) = [(c,s)] + +readDec, readOct, readHex :: ReadS Int +readDec = readInt 10 isDigit (\d -> ord d - ord '0') +readOct = readInt 8 isOctDigit (\d -> ord d - ord '0') +readHex = readInt 16 isHexDigit hex + where hex d = ord d - (if isDigit d then ord '0' + else ord (if isUpper d then 'A' else 'a') + - 10) + +readInt :: Int -> (Char -> Bool) -> (Char -> Int) -> ReadS Int +readInt radix isDig digToInt s = + [(foldl1 (\n d -> n * radix + d) (map (fromInteger . digToInt) ds), r) + | (ds,r) <- nonnull isDig s ] + +readSigned:: ReadS Int -> ReadS Int +readSigned readPos = readParen False read' + where read' r = read'' r ++ + [(-x,t) | ("-",s) <- lex r, + (x,t) <- read'' s] + read'' r = [(n,s) | (str,s) <- lex r, + (n,"") <- readPos str] + diff --git a/demos/ansi.gs b/demos/ansi.gs new file mode 100644 index 0000000..4563939 --- /dev/null +++ b/demos/ansi.gs @@ -0,0 +1,118 @@ +-- This is a simple program using ANSI escape sequences to create a program +-- which uses direct cursor addressing and input/output. +-- +-- People are often quite surprised the first time they see a program like +-- this written in a functional language. + + +-- Basic screen control codes: + +-- Choose whichever of the following lines is suitable for your system: +cls = "\ESC[2J" -- for PC with ANSI.SYS +cls = "\^L" -- for Sun window + +goto x y = '\ESC':'[':(show y ++(';':show x ++ "H")) +at (x,y) s = goto x y ++ s +home = goto 1 1 +highlight s = "\ESC[7m"++s++"\ESC[0m" + + +-- Some general purpose functions for interactive programs: + +type Interact = String -> String + +end :: Interact +end cs = "" + +readChar, peekChar :: Interact -> (Char -> Interact) -> Interact +readChar eof use [] = eof [] +readChar eof use (c:cs) = use c cs + +peekChar eof use [] = eof [] -- like readChar, but character is +peekChar eof use cs@(c:_) = use c cs -- not removed from input stream + +pressAnyKey :: Interact -> Interact +pressAnyKey prog = readChar prog (\c -> prog) + +unreadChar :: Char -> Interact -> Interact +unreadChar c prog cs = prog (c:cs) + +writeChar :: Char -> Interact -> Interact +writeChar c prog cs = c : prog cs + +writeString :: String -> Interact -> Interact +writeString s prog cs = s ++ prog cs + +writes :: [String] -> Interact -> Interact +writes ss = writeString (concat ss) + +ringBell :: Interact -> Interact +ringBell = writeChar '\BEL' + + +-- Screen oriented input/output functions: + +type Pos = (Int,Int) + +clearScreen = writeString cls +writeAt (x,y) s = writeString (goto x y ++ s) +moveTo (x,y) = writeString (goto x y) + + +readAt :: Pos -> -- Start coordinates + Int -> -- Maximum input length + (String -> Interact) -> -- How to use entered string + Interact + +readAt (x,y) l use = writeAt (x,y) (copy l '_') (moveTo (x,y) (loop 0 "")) + where loop n s = readChar (return s) (\c -> + case c of '\BS' -> delete n s + '\DEL' -> delete n s + '\n' -> return s + c | n < l -> writeChar c (loop (n+1) (c:s)) + | otherwise -> ringBell (loop n s)) + delete n s = if n>0 then writeString "\BS_\BS" (loop (n-1) (tail s)) + else ringBell (loop 0 "") + return s = use (reverse s) + + +defReadAt :: Pos -> -- Start coordinates + Int -> -- Maximum input length + String -> -- Default string value + (String -> Interact) -> -- How to use entered string + Interact +defReadAt (x,y) l def use + = writeAt (x,y) (take l (def++repeat '_')) ( + readChar (use def) (\c -> + if c=='\n' then use def + else unreadChar c (readAt (x,y) l use))) + +promptReadAt (x,y) l prompt use + = writeAt (x,y) prompt (readAt (x+length prompt,y) l use) + +defPromptReadAt (x,y) l prompt def use + = writeAt (x,y) prompt ( + defReadAt (x+length prompt,y) l def use) + + +-- A sample program: +-- Enter the expression `run program' in Gofer to try this program out + +program = writes [ cls, + at (17,5) (highlight "Demonstration program"), + at (48,5) "Version 1.0", + at (17,7) "This program illustrates a simple approach", + at (17,8) "to screen-based interactive programs using", + at (17,9) "the Gofer functional programming system.", + at (17,11) "Please press any key to continue ..." + ] + (pressAnyKey + (promptReadAt (17,15) 18 "Please enter your name: " (\name -> + (let reply = "Hello " ++ name ++ "!" in + writeAt (40-(length reply/2),18) reply + (moveTo (1,23) + (writeString "I'm waiting...\n" + (pressAnyKey + end))))))) + +-- End of file diff --git a/demos/arrayEx.gs b/demos/arrayEx.gs new file mode 100644 index 0000000..ce5a1ef --- /dev/null +++ b/demos/arrayEx.gs @@ -0,0 +1,30 @@ +-- Some simple examples using arrays. Requires array.gs. + +-- Some applications, most taken from the Gentle Introduction ... ------------- + +timesTable = array ((1,1),(10,10)) [ (i,j) := i*j | i<-[1..10], j<-[1..10] ] + +fibs n = a where a = array (0,n) ([ 0 := 1, 1 := 1 ] ++ + [ i := a!(i-2) + a!(i-1) | i <- [2..n] ]) +fibs10 = fibs 10 + +wavefront n = a where a = array ((1,1),(n,n)) + ([ (1,j) := 1 | j <- [1..n] ] ++ + [ (i,1) := 1 | i <- [2..n] ] ++ + [ (i,j) := a!(i,j-1) + a!(i-1,j-1) + a!(i-1,j) + | i <- [2..n], j <- [2..n] ]) + +wave10 = wavefront 10 + +listwave n = [ [wf!(i,j) | j <- [1..n]] | i <- [1..n] ] + where wf = wavefront n + +eg1 = array (1,100) ((1 := 1) : [ i := i * eg1!(i-1) | i <- [2..100] ]) + +------------------------------------------------------------------------------- + +a1 = array (-5,5) [] +a2 = a1 // [ 1 := True ] +a3 = a1 // [ 0 := a1 ] +a4 = array (-5,5) [ i := i*i | i <- [-5..0] ] + diff --git a/demos/cat.gs b/demos/cat.gs new file mode 100644 index 0000000..fbfa07e --- /dev/null +++ b/demos/cat.gs @@ -0,0 +1,20 @@ +-- A version of the Unix utility cat coded up using the I/O facilities of +-- Gofer, with a dash of Gofer overloading to enable the use of different +-- argument forms: +-- + +-- Here is a simple version, not using any overloading: +-- (this version should work in Haskell) + +unixCat :: [String] -> Dialogue +unixCat = foldr showFile done + where showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) + +-- Now we get a little ambitious and write some Gofer-only code: + +class Cat a where cat :: a -> Dialogue +instance Cat String where cat n = showFile n done +instance Cat [String] where cat = foldr showFile done + +showFile name cont = readFile name abort (\s->appendChan stdout s abort cont) diff --git a/demos/commaint.lgs b/demos/commaint.lgs new file mode 100644 index 0000000..27b599f --- /dev/null +++ b/demos/commaint.lgs @@ -0,0 +1,47 @@ +This file contains the definition of commaint, a function which takes a +single string argument containing a sequence of digits, and outputs the +same sequence with commas inserted after every group of three digits, +reading from the right hand end of the string. + +> commaint = reverse . foldr1 (\x y->x++","++y) . group 3 . reverse +> where group n = takeWhile (not.null) . map (take n) . iterate (drop n) + +This definition uses the following library functions: + + reverse, (.), foldr1, (++), takeWhile, not, null, map, take, iterate, drop. + +Example: evaluation of commaint "1234567" + + "1234567" + | + | reverse + V + "7654321" _______________________________ + | \ + | iterate (drop 3) | + V | + ["7654321", "4321", "1", "", "", ...] | + | | + | map (take 3) V group 3 + V | + ["765", "432", "1", "", "", ...] | + | | + | takeWhile (not.null) | + V _______________________________/ + ["765", "432", "1"] + | + | foldr1 (\x y->x++","++y) + V + "765,432,1" + | + | reverse + V + "1,234,567" + +In a Gofer session: + + ? commaint "1234567" + 1,234,567 + (105 reductions, 203 cells) + ? + diff --git a/demos/demoproj.gp b/demos/demoproj.gp new file mode 100644 index 0000000..1abaf0e --- /dev/null +++ b/demos/demoproj.gp @@ -0,0 +1,23 @@ +-- This is a project file which can be used to load (nearly) all of the +-- demonstration programs in this directory into Gofer 2.22. +-- +-- Load into Gofer interpreter using the command: :p demoproj.gp +-- or from command line using: gofer + demoproj.gp + +ansi.gs +cat.gs +commaint.lgs +evalred.gs +examples.gs +iosynch.gs +lattice.gs +match.gs +matrix.gs +minsrand.gs +queens.gs +random.gs +squigol.gs +stack.gs +temps.gs +tree.gs + diff --git a/demos/evalred.gs b/demos/evalred.gs new file mode 100644 index 0000000..d00f5c9 --- /dev/null +++ b/demos/evalred.gs @@ -0,0 +1,95 @@ +-- This program can be used to solve exercise 1.2.1 in Bird & Wadler's +-- ``Introduction to functional programming'' .... +-- +-- Write down the ways to reduce sqr (sqr (3+7)) to normal form +-- (without assuming shared evaluation of function arguments). + +data Term = Square Term -- The square of a term + | Plus Term Term -- The sum of two terms + | Times Term Term -- The product of two terms + | Num Int -- A numeric constant + +instance Text Term where + showsPrec p (Square t) = showString "sqr " . shows t + showsPrec p (Plus n m) = showChar '(' . shows n . showChar '+' + . shows m . showChar ')' + showsPrec p (Times n m) = showChar '(' . shows m . showChar '*' + . shows n . showChar ')' + showsPrec p (Num i) = shows i + + +-- What are the subterms of a given term? + +type Subterm = (Term, -- The subterm expression + Term->Term) -- A function which embeds + -- it back in the original + -- term + +rebuild :: Subterm -> Term +rebuild (t, embed) = embed t + +subterms :: Term -> [Subterm] +subterms t = [ (t,id) ] ++ properSubterms t + +properSubterms :: Term -> [Subterm] +properSubterms (Square t) = down Square (subterms t) +properSubterms (Plus t1 t2) = down (flip Plus t2) (subterms t1) ++ + down (Plus t1) (subterms t2) +properSubterms (Times t1 t2) = down (flip Times t2) (subterms t1) ++ + down (Times t1) (subterms t2) +properSubterms (Num n) = [] + +down :: (Term -> Term) -> [Subterm] -> [Subterm] +down f = map (\(t, e) -> (t, f.e)) + + +-- Some (semi-)general variations on standard themes: + +filter' :: (a -> Bool) -> [(a, b)] -> [(a, b)] +filter' p = filter (p.fst) + +map' :: (a -> b) -> [(a, c)] -> [(b, c)] +map' f = map (\(a, c) -> (f a, c)) + + +-- Reductions: + +isRedex :: Term -> Bool +isRedex (Square _) = True +isRedex (Plus (Num _) (Num _)) = True +isRedex (Times (Num _) (Num _)) = True +isRedex _ = False + +contract :: Term -> Term +contract (Square t) = Times t t +contract (Plus (Num n) (Num m)) = Num (n+m) +contract (Times (Num n) (Num m)) = Num (n*m) +contract _ = error "Not a redex!" + +singleStep :: Term -> [Term] +singleStep = map rebuild . map' contract . filter' isRedex . subterms + +normalForms :: Term -> [Term] +normalForms t = [ t ], if null ts + = [ n | t'<-ts, n<-normalForms t' ], otherwise + where ts = singleStep t + +redSequences :: Term -> [[Term]] +redSequences t = [ [t] ], if null ts + = [ t:rs | t'<-ts, rs<-redSequences t' ], otherwise + where ts = singleStep t + + +-- Particular example: + +term0 = Square (Square (Plus (Num 3) (Num 7))) +nfs0 = normalForms term0 +rsq0 = redSequences term0 + +-- Using Gofer: +-- +-- ? length nfs0 +-- 547 +-- (188076 reductions, 340335 cells, 4 garbage collections) +-- ? +-- diff --git a/demos/examples.gs b/demos/examples.gs new file mode 100644 index 0000000..867e9fd --- /dev/null +++ b/demos/examples.gs @@ -0,0 +1,85 @@ +-- Some examples of functional programming for Gofer + +-- Factorials: + +fact n = product [1..n] -- a simple definition + +fac n = if n==0 then 1 else n * fac (n-1) -- a recursive definition + +fac' 0 = 1 -- using two equations +fac' n = n * fac (n-1) + +facts = scanl (*) 1 [1..] -- the infinite list of factorials + +facts' = 1 : zipWith (*) facts' [1..] -- another way of doing it + +facFix = fixedPt f -- using a fixed point combinator + where f g 0 = 1 -- overlapping patterns + f g n = n * g (n-1) + fixedPt f = g where g = f g -- fixed point combinator + +facCase = \n -> case n of + 0 -> 1 + (m+1) -> (m+1) * facCase m + +-- Fibonacci numbers: + +fib 0 = 0 -- using pattern matching: +fib 1 = 1 -- base cases... +fib (n+2) = fib n + fib (n+1) -- recursive case + +fastFib n = fibs !! n -- using an infinite stream + where fibs = 0 : 1 : zipWith (+) fibs (tail fibs) + +cnkfib 1 = 1 -- using cnk patterns, in a form +cnkfib 2 = 1 -- suggested by Tony Davie +cnkfib (2*n) = (cnkfib(n+1))^^2 - (cnkfib(n-1))^^2 +cnkfib (2*n+1) = (cnkfib(n+1))^^2 + (cnkfib n )^^2 + +x^^0 = 1 -- A fast implementation of +x^^(2*n) = xn*xn where xn = x^^n -- exponentiation +x^^(2*n+1) = x * x^^(2*n) + +-- Perfect numbers: + +factors n = [ i | i<-[1..n-1], n `mod` i == 0 ] +perfect n = sum (factors n) == n +firstperfect = head perfects +perfects = filter perfect [1..] + +-- Prime numbers: + +primes = map head (iterate sieve [2..]) +sieve (p:xs) = [ x | x<-xs, x `rem` p /= 0 ] + +-- Pythagorean triads: + +triads n = [ (x,y,z) | ns=[1..n], x<-ns, y<-ns, z<-ns, x*x+y*y==z*z ] + +-- The Hamming problem: + +hamming :: [Int] +hamming = 1 : (map (2*) hamming || map (3*) hamming || map (5*) hamming) + where (x:xs) || (y:ys) | x==y = x : (xs || ys) + | x zipWith (+) ([0]++row) (row++[0])) [1] + +showPascal = (layn . map show . take 14) pascal diff --git a/demos/expr.gs b/demos/expr.gs new file mode 100644 index 0000000..c16871c --- /dev/null +++ b/demos/expr.gs @@ -0,0 +1,89 @@ +----------------------------------------------------------------------------- +-- Parsing simple arithmetic expressions using combinators in Gofer +-- +-- Mark P. Jones, April 4, 1993 + +infixr 6 &&& +infixl 5 >>> +infixr 4 ||| + +type Parser a = String -> [(a,String)] + +result :: a -> Parser a +result x s = [(x,s)] + +(|||) :: Parser a -> Parser a -> Parser a +(p ||| q) s = p s ++ q s + +(&&&) :: Parser a -> Parser b -> Parser (a,b) +(p &&& q) s = [ ((x,y),s1) | (x,s0) <- p s, (y,s1) <- q s0 ] + +(>>>) :: Parser a -> (a -> b) -> Parser b +(p >>> f) s = [ (f x, s0) | (x,s0) <- p s ] + +many :: Parser a -> Parser [a] +many p = q where q = p &&& q >>> (\(x,xs) -> x:xs) + ||| + result [] + +many1 :: Parser a -> Parser [a] +many1 p = p &&& many p >>> (\(x,xs) -> x:xs) + +sat :: (Char -> Bool) -> Parser Char +sat p (c:cs) + | p c = [ (c,cs) ] +sat p cs = [] + +tok :: String -> Parser String +tok s cs = loop s cs + where loop "" cs = [(s,cs)] + loop (s:ss) (c:cs) | s==c = loop ss cs + loop _ _ = [] + +digit :: Parser Int +digit = sat isDigit >>> \d -> ord d - ord '0' + +number :: Parser Int +number = many1 digit >>> foldl (\a x -> 10*a+x) 0 + +-- Original version: +-- eval "1" (540 reductions, 933 cells) +-- eval "(1)" (5555 reductions, 8832 cells) +-- eval "((1))" (50587 reductions, 80354 cells, 1 garbage collection) +-- eval "(((1)))" (455907 reductions, 724061 cells, 7 garbage collections) +-- eval "1+2+3+4+5" (1296 reductions, 2185 cells) +-- eval "1+" (828 reductions, 1227 cells) + +{- +expr = term &&& tok "+" &&& expr >>> (\(x,(p,y)) -> x + y) ||| + term &&& tok "-" &&& expr >>> (\(x,(m,y)) -> x - y) ||| + term + +term = atom &&& tok "*" &&& term >>> (\(x,(t,y)) -> x * y) ||| + atom &&& tok "/" &&& term >>> (\(x,(d,y)) -> x / y) ||| + atom +-} + +atom = tok "-" &&& number >>> (\(u,n) -> -n) ||| + number ||| + tok "(" &&& expr &&& tok ")" >>> (\(o,(n,c)) -> n) + +-- Putting the initial prefix parser first: +-- eval "1" (96 reductions, 168 cells) +-- eval "(1)" (191 reductions, 335 cells) +-- eval "((1))" (283 reductions, 498 cells) +-- eval "(((1)))" (375 reductions, 661 cells) +-- eval "1+2+3+4+5" (472 reductions, 905 cells) +-- eval "1+" (124 reductions, 251 cells) + +expr = term &&& (tok "+" &&& expr >>> (\(p,y) -> (+y)) ||| + tok "-" &&& expr >>> (\(m,y) -> subtract y) ||| + result id) >>> \(n,f) -> f n + +term = atom &&& (tok "*" &&& term >>> (\(t,y) -> (*y)) ||| + tok "/" &&& term >>> (\(d,y) -> (/y)) ||| + result id) >>> \(n,f) -> f n + +eval s = case expr s of ((x,""):_) -> x + _ -> error "Syntax error in input" + diff --git a/demos/fastsort.gs b/demos/fastsort.gs new file mode 100644 index 0000000..3dc1fd1 --- /dev/null +++ b/demos/fastsort.gs @@ -0,0 +1,41 @@ +{- list sorting: see L.C.Paulson, ML for the working programmer, Cambidge, p100 +-- The list is split into ascending chunks which are then merged in pairs. + +samsort l = sorting [] 0 l + where sorting ls k [] = head(mergepairs ls 0) + sorting ls k (x:xs) = sorting (mergepairs (run:ls) kinc) kinc tl + where (run, tl) = nextrun [x] xs + kinc = k+1 + nextrun run [] = (reverse run, []) + nextrun rs@(r:_) xl@(x:xs) + | x readNums (lines userInput)) + +readNums :: [String] -> Dialogue +readNums inputLines = readInt "Enter first number: " inputLines + (\num1 inputLines1 -> + readInt "Enter second number: " inputLines1 + (\num2 _ -> reportResult num1 num2)) + +reportResult :: Int -> Int -> Dialogue +reportResult num1 num2 + = appendChan stdout ("Their sum is: "++ show (num1 + num2)) abort done + + +-- readInt prints a prompt and then reads a line of input. If the +-- line contains an integer, the value of the integer is passed to the +-- success continuation. If a line cannot be parsed as an integer, +-- an error message is printed and the user is asked to try again. +-- If EOF is detected, the program is aborted. + +readInt :: String -> [String] -> (Int -> [String] -> Dialogue) -> Dialogue +readInt prompt inputLines succ + = appendChan stdout prompt abort + (case inputLines of + (l1 : rest) -> case (intRead l1) of + [(n,"")] -> succ n rest + _ -> appendChan stdout + "Error - retype the number\n" abort + (readInt prompt rest succ) + _ -> appendChan stdout "Early EOF" abort done) + +-- Since the Gofer standard prelude does not include the reads function in +-- the Text class, we have explicitly specified intRead in the definition +-- above (rather than "reads" as used in the Haskell report). +-- A straightforward (if rather crude) definition of this function follows: + +intRead :: String -> [(Int,String)] +intRead "" = [] +intRead s = loop 0 s + where loop n [] = [(n,"")] + loop n s@(d:ds) + | isDigit d = loop (10*n+(ord d - ord '0')) ds + | otherwise = [(n,s)] diff --git a/demos/lattice.gs b/demos/lattice.gs new file mode 100644 index 0000000..2a5a7d2 --- /dev/null +++ b/demos/lattice.gs @@ -0,0 +1,135 @@ +-- This file contains a Gofer implementation of the programs described in: +-- +-- Computing with lattices: An application of type classes, +-- Mark P. Jones, +-- Technical report PRG-TR-11-90, +-- Programming Research Group, +-- Oxford University Computing Laboratory, June 1990. +-- +-- A substantially revised version of this paper has now been published +-- in the Journal of Functional Programming, Volume 2, Number 4, Oct 1992. +-- + +class Eq a => Lattice a where -- A type class representing lattices + bottom, top :: a + meet, join :: a -> a -> a + lt :: a -> a -> Bool + x `lt` y = (x `join` y) == y + +instance Lattice Bool where -- Simple instances of Lattice + bottom = False + top = True + meet = (&&) + join = (||) + +instance (Lattice a, Lattice b) => Lattice (a,b) where + bottom = (bottom,bottom) + top = (top,top) + (x,y) `meet` (u,v) = (x `meet` u, y `meet` v) + (x,y) `join` (u,v) = (x `join` u, y `join` v) + + +-- Defining the least fixed point operator: + +fix f = firstRepeat (iterate f bottom) +firstRepeat xs = head [ x | (x,y) <- zip xs (tail xs), x==y ] + + +-- Maximum and minimum frontiers: + +data Minf a = Minf [a] +data Maxf a = Maxf [a] + +instance Eq a => Eq (Minf a) where -- Equality on Frontiers + (Minf xs) == (Minf ys) = setEquals xs ys + +instance Eq a => Eq (Maxf a) where + (Maxf xs) == (Maxf ys) = setEquals xs ys + +xs `subset` ys = all (`elem` ys) xs +setEquals xs ys = xs `subset` ys && ys `subset` xs + +instance Lattice a => Lattice (Minf a) where -- Lattice structure + bottom = Minf [] + top = Minf [bottom] + (Minf xs) `meet` (Minf ys) = minimal [ x`join`y | x<-xs, y<-ys ] + (Minf xs) `join` (Minf ys) = minimal (xs++ys) + +instance Lattice a => Lattice (Maxf a) where + bottom = Maxf [] + top = Maxf [top] + (Maxf xs) `meet` (Maxf ys) = maximal [ x`meet`y | x<-xs, y<-ys ] + (Maxf xs) `join` (Maxf ys) = maximal (xs++ys) + +-- Find maximal elements of a list xs with respect to partial order po: + +maximalWrt po = loop [] + where loop xs [] = xs + loop xs (y:ys) + | any (po y) (xs++ys) = loop xs ys + | otherwise = loop (y:xs) ys + +minimal :: Lattice a => [a] -> Minf a -- list to minimum frontier +minimal = Minf . maximalWrt (flip lt) +maximal :: Lattice a => [a] -> Maxf a -- list to maximum frontier +maximal = Maxf . maximalWrt lt + +-- A representation for functions of type Lattice a => a -> Bool: + +data Fn a = Fn (Minf a) (Maxf a) + +instance (Eq (Minf a), Eq (Maxf a)) => Eq (Fn a) where + Fn f1 f0 == Fn g1 g0 = f1==g1 -- && f0==g0 + +instance (Lattice (Minf a), Lattice (Maxf a)) => Lattice (Fn a) where + bottom = Fn bottom top + top = Fn top bottom + Fn u l `meet` Fn v m = Fn (u `meet` v) (l `join` m) + Fn u l `join` Fn v m = Fn (u `join` v) (l `meet` m) + +-- Navigable lattices: + +class (Lattice (Minf a), Lattice (Maxf a)) => Navigable a where + succs :: a -> Minf a + preds :: a -> Maxf a + +maxComp :: Navigable a => [a] -> Maxf a -- implementation of complement +maxComp = foldr meet top . map preds +minComp :: Navigable a => [a] -> Minf a +minComp = foldr meet top . map succs + +instance Navigable Bool where -- instances of Navigable + succs False = Minf [True] + succs True = Minf [] + preds False = Maxf [] + preds True = Maxf [False] + +instance (Navigable a, Navigable b) => Navigable (a,b) where + succs (x,y) = Minf ([(sx,bottom) | Minf xs = succs x, sx<-xs] ++ + [(bottom,sy) | Minf ys = succs y, sy<-ys]) + preds (x,y) = Maxf ([(px,top) | Maxf xs = preds x, px<-xs] ++ + [(top,py) | Maxf ys = preds y, py<-ys]) + +instance Navigable a => Navigable (Fn a) where + succs (Fn f1 f0) = Minf [Fn (Minf [y]) (preds y) | Maxf ys = f0, y<-ys] + preds (Fn f1 f0) = Maxf [Fn (succs x) (Maxf [x]) | Minf xs = f1, x<-xs] + +-- Upwards and downwards closure operators: + +upwards (Minf []) = [] +upwards ts@(Minf (t:_)) = t : upwards (ts `meet` succs t) + +downwards (Maxf []) = [] +downwards ts@(Maxf (t:_)) = t : downwards (ts `meet` preds t) + +elements :: Navigable a => [a] -- enumerate all elements in lattice +elements = upwards top + +-- Dual lattices: + +class (Lattice a, Lattice b, Dual b a) => Dual a b where + comp :: a -> b + +instance Dual Bool Bool where + comp = not + diff --git a/demos/literate.lgs b/demos/literate.lgs new file mode 100644 index 0000000..738c2b8 --- /dev/null +++ b/demos/literate.lgs @@ -0,0 +1,101 @@ +Literate comments +----------------- + +[This file contains an executable version of the program for +processing literate scripts that appears in Appendix C of the Haskell +report, version 1.2.] + +Many Haskell implementations support the ``literate comment'' +convention, first developed by Richard Bird and Philip Wadler for +Orwell, and inspired in turn by Donald Knuth's ``literate programming''. +The convention is not part of the Haskell language, but it is +supported by the implementations known to us (Chalmers, Glasgow, +and Yale). + +The literate style encourages comments by making them the default. +A line in which ">" is the first character is treated as part of +the program; all other lines are comment. Within the program part, +the usual "--" and "{- -}" comment conventions may still be used. +To capture some cases where one omits an ">" by mistake, it is an +error for a program line to appear adjacent to a non-blank comment +line, where a line is taken as blank if it consists only of +whitespace. + +By convention, the style of comment is indicated by the file +extension, with ".hs" indicating a usual Haskell file, and ".lhs" +indicating a literate Haskell file. + +To make this precise, we present a literate Haskell program to +convert literate programs. The program expects a single name "file" +on the command line, reads "file.lhs", and either writes the +corresponding program to "file.hs" or prints error messages to +"stderr". + +Each of the lines in a literate script is a program line, a blank +line, or a comment line. In the first case, the text is kept with +the line. + +> data Classified = Program String | Blank | Comment + +In a literate program, program lines begins with a `>' character, +blank lines contain only whitespace, and all other lines are comment +lines. + +> classify :: String -> Classified +> classify ('>':s) = Program s +> classify s | all isSpace s = Blank +> classify s | otherwise = Comment + +In the corresponding program, program lines have the leading `>' +replaced by a leading space, to preserve tab alignments. + +> unclassify :: Classified -> String +> unclassify (Program s) = " " ++ s +> unclassify Blank = "" +> unclassify Comment = "" + +Process a literate program into error messages (if any) and the +corresponding non-literate program. + +> process :: String -> (String, String) +> process lhs = (es, hs) +> where cs = map classify (lines lhs) +> es = unlines (errors cs) +> hs = unlines (map unclassify cs) + +Check that each program line is not adjacent to a comment line. + +> errors :: [Classified] -> [String] +> errors cs = concat (zipWith3 adjacent [1..] cs (tail cs)) + +Given a line number and a pair of adjacent lines, generate a list +of error messages, which will contain either one entry or none. + +> adjacent :: Int -> Classified -> Classified -> [String] +> adjacent n (Program _) Comment = [message n "program" "comment"] +> adjacent n Comment (Program _) = [message n "comment" "program"] +> adjacent n this next = [] + +> message n p c = "Line "++show n++": "++p++" line before "++c++" line." + +Get one argument from the command line; complain if too many or +too few. + +> getArg :: FailCont -> StrCont -> Dialogue +> getArg fail succ +> = getArgs fail (\strs -> +> case strs of +> [str] -> succ str +> _ -> fail (OtherError "Too many or too few args")) + +The main program gets name "file", reads "file.lhs", and either +writes the corresponding program to "file.hs" or appends error +messages to "stderr". + +> main :: Dialogue +> main = getArg exit (\file -> +> readFile (file ++ ".lhs") exit (\lhs -> +> case (process lhs) of +> ([],hs) -> writeFile (file ++ ".hs") hs exit done +> (es,_) -> appendChan stderr es exit done)) + diff --git a/demos/lucqs.gs b/demos/lucqs.gs new file mode 100644 index 0000000..bfd65a1 --- /dev/null +++ b/demos/lucqs.gs @@ -0,0 +1,72 @@ +-- A `prettier' version of the 8 queens program that displays the +-- solutions to the 8 queens problems on chess boards ... you need +-- a terminal that uses standard ANSI (I think) control sequences +-- to switch between normal and inverse video to use this program. +-- +-- Written by Luc Duponcheel, March 1993 + +-- this is standard + +row n = [(n,m) | m <- [1..8]] + +qss 0 = [[]] +qss n = [ q:qs | qs <- qss (n-1) , q <- row n, all (ok q) qs] + +ok (m,n) (i,j) = j/=n && (i+j/=m+n) && (i-j/=m-n) + +-- fold is (among others) useful for showing lists WITHOUT '[' , ',' , ']' +-- BTW the definition of fold is similar to the one of map +-- fold and map can easily be generalised + +fold :: (a -> b -> b) -> [a] -> b -> b +fold f [] = id +fold f (x:xs) = f x . fold f xs + +-- For inverse video + +inv = [chr 27] ++ "[7m" +res = [chr 27] ++ "[m" + +-- how to show Blanks and Queens + +data Mode = Md (Int,Int) + +data Queen = Qn (Int,Int) +data Blank = Blnk (Int,Int) + +instance Text Mode where + showsPrec p (Md (n,m)) | even s = showString inv + | odd s = showString res + where s = (n+m) + +instance Text Queen where + showsPrec p (Qn (n,m)) = shows (Md (n,m)) . showString "++" + + +instance Text Blank where + showsPrec p (Blnk (n,m)) = shows (Md (n,m)) . showString " " + showList = fold shows + +blanksBefore (n,m) = [Blnk (n,i) | i <- [1..(m-1)]] +blanksAfter (n,m) = [Blnk (n,i) | i <- [(m+1)..8]] + +-- how to show Rows and Boards + +data Row = Rw (Int,Int) +data Board = Brd [Row] + + +instance Text Row where + showsPrec p (Rw q) + = showChar '\t' . shows (blanksBefore q) + . shows (Qn q) . + shows (blanksAfter q) . showString res . showChar '\n' + +instance Text Board where + showsPrec p (Brd qs) = showChar '\n' . fold shows qs . showChar '\n' + showList = fold shows + +main :: Dialogue +main = appendChan stdout solutions exit done + where solutions = show ([Brd [Rw q | q <- qs] | qs <- (qss 8)]) + diff --git a/demos/match.gs b/demos/match.gs new file mode 100644 index 0000000..481a3a1 --- /dev/null +++ b/demos/match.gs @@ -0,0 +1,27 @@ + +match [] ys = null ys +match ('*':ps) xs = or (map (match ps) (tails xs)) +match (p:ps) [] = False +match (p:ps) (c:cs) + | p==c = match ps cs + | otherwise = False + +-- Some combinatorial problems: + +tails [] = [[]] +tails xs'@(x:xs) = xs' : tails xs + +inits [] = [[]] +inits (x:xs) = [] : map (x:) (inits xs) + +perms [] = [[]] +perms (x:xs) = concat (map (inter x) (perms xs)) + where inter x [] = [[x]] + inter x ys'@(y:ys) = (x:ys') : map (y:) (inter x ys) + +subs [] = [[]] +subs (x:xs) = subs xs ++ map (x:) (subs xs) + +segs = concat . map tails' . reverse . inits + where tails' [] = [] + tails' xs'@(_:xs) = xs' : tails' xs diff --git a/demos/matrix.gs b/demos/matrix.gs new file mode 100644 index 0000000..bafd623 --- /dev/null +++ b/demos/matrix.gs @@ -0,0 +1,92 @@ +-- Some simple Gofer programs for manipulating matrices. +-- + +type Matrix k = [Row k] -- matrix represented by a list of its rows +type Row k = [k] -- a row represented by a list of literals + +-- General utility functions: + +shapeMat :: Matrix k -> (Int, Int) +shapeMat mat = (rows mat, cols mat) + +rows :: Matrix k -> Int +rows mat = length mat + +cols :: Matrix k -> Int +cols mat = length (head mat) + +idMat :: Int -> Matrix Int +idMat 0 = [] +idMat (n+1) = [1:copy n 0] ++ map (0:) (idMat n) + +-- Matrix multiplication: + +multiplyMat :: Matrix Int -> Matrix Int -> Matrix Int +multiplyMat a b | cols a==rows b = [[row `dot` col | col<-b'] | row<-a] + | otherwise = error "incompatible matrices" + where v `dot` w = sum (zipWith (*) v w) + b' = transpose b + +-- An attempt to implement the standard algorithm for converting a matrix +-- to echelon form... + +echelon :: Matrix Int -> Matrix Int +echelon rs = rs, if null rs || null (head rs) + = map (0:) (echelon (map tail rs)), if null rs2 + = piv : map (0:) (echelon rs'), otherwise + where rs' = map (adjust piv) (rs1++rs3) + (rs1,rs2) = span leadZero rs + leadZero (n:_) = n==0 + (piv:rs3) = rs2 + +-- To find the echelon form of a matrix represented by a list of rows rs: +-- +-- {first line in definition of echelon}: +-- If either the number of rows or the number of columns in the matrix +-- is zero (i.e. if null rs || null (head rs)), then the matrix is +-- already in echelon form. +-- +-- {definition of rs1, rs2, leadZero in where clause}: +-- Otherwise, split the matrix into two submatrices rs1 and rs2 such that +-- rs1 ++ rs2 == rs and all of the rows in rs1 begin with a zero. +-- +-- {second line in definition of echelon}: +-- If rs2 is empty (i.e. if null rs2) then every row begins with a zero +-- and the echelon form of rs can be found by adding a zero on to the +-- front of each row in the echelon form of (map tail rs). +-- +-- {Third line in definition of echelon, and definition of piv, rs3}: +-- Otherwise, the first row of rs2 (denoted piv) contains a non-zero +-- leading coefficient. After moving this row to the top of the matrix +-- the original matrix becomes piv:(rs1++rs3). +-- By subtracting suitable multiples of piv from (suitable multiples of) +-- each row in (rs1++rs3) {see definition of adjust below}, we obtain a +-- matrix of the form: +-- +-- <----- piv ------> +-- __________________ +-- 0 | +-- . | +-- . | rs' where rs' = map (adjust piv) (rs1++rs3) +-- . | +-- 0 | +-- +-- whose echelon form is piv : map (0:) (echelon rs'). +-- + +adjust :: Num a => Row a -> Row a -> Row a +adjust (m:ms) (n:ns) = zipWith (-) (map (n*) ms) (map (m*) ns) + +-- A more specialised version of this, for matrices of integers, uses the +-- greatest common divisor function gcd in an attempt to try and avoid +-- result matrices with very large coefficients: +-- +-- (I'm not sure this is really worth the trouble!) + +adjust' :: Row Int -> Row Int -> Row Int +adjust' (m:ms) (n:ns) = ns, if g==0 + = zipWith (\x y -> b*y - a*x) ms ns, otherwise + where g = gcd m n + a = n/g + b = m/g +-- end!! diff --git a/demos/minsrand.gs b/demos/minsrand.gs new file mode 100644 index 0000000..5400b0a --- /dev/null +++ b/demos/minsrand.gs @@ -0,0 +1,125 @@ +------------------------------------------------------------------------------- +-- The following random number generator is an implementation of the +-- Minimum Standard generator recommended in +-- +-- Random Number Generators: Good ones are hard to find +-- Stephen K Park & Keith W Miller +-- Communications of the ACM, Oct 88, Vol 31 No 10 1192 - 1201 +-- +-- Seeds must be in the range 1..2147483646, that is (1..(2**31)-2) +-- Output will also be in that range. The generator is full period so that +-- all 2147483646 values will be generated before the initial seed repeats. +-- Dividing by 2147483647 (real) as in the Pascal code below will map it +-- into the range (0..1) if required. +-- +-- [This program assumes that you are working on a machine with (at least) +-- 32 bit integers. Folks using Gofer on a PC will have to stick with the +-- less sophisticated random number generator in the file `randoms'.] +------------------------------------------------------------------------------- + +min_stand_test :: Int -> Int +min_stand_test n = if test > 0 then test else test + 2147483647 + where test = 16807 * lo - 2836 * hi + hi = n `div` 127773 + lo = n `rem` 127773 + +min_stand_randoms :: Int -> [Int] +min_stand_randoms = iterate min_stand_test + +-- The article produced below also gives a test to check that the +-- random number generator is working. We can duplicate this test +-- as follows: +-- +-- ? strictIterate min_stand_test 1 !! 10000 +-- 1043618065 +-- (149758 reductions, 240096 cells, 2 garbage collections) +-- +-- Happily, this is the result that we expect to obtain. +-- +-- The function strictIterate is defined below. It is similar to the +-- standard iterate function except that it forces the evaluation of +-- each element in the list produced (except possibly the first). +-- Had we instead tried to evaluate: +-- +-- iterate min_stand_test 1 !! 10000 +-- +-- Gofer would have first constructed the expression graph: +-- +-- min_stand_test (min_stand_test (... (min_stand_test 1) ...)) +-- +-- in which the min_stand_test function is applied 10000 times to 1 +-- and then attempted to evaluate this. In either case, you'd need a +-- large heap to represent the complete expression and a large stack so +-- that you could handle 10000 levels of function calling. Most standard +-- configurations of Gofer aren't set up with sufficiently large defaults +-- to make this possible, so the most likely outcome would be a runtime +-- error of one kind or another! + +strictIterate :: (a -> a) -> a -> [a] +strictIterate f x = x : strict (strictIterate f) (f x) + +------------------------------------------------------------------------------- +-- Some comments and code from: +-- +-- Random Number Generators: Good ones are hard to find +-- Stephen K Park & Keith W Miller +-- Communications of the ACM, Oct 88, Vol 31 No 10 1192 - 1201 +-- +-- Minimum standard random number generator implementations +-- +-- This version of Random will be correct if reals are represented +-- with a 46-bit or larger mantissa (excluding the sign bit). +-- For example, this version will be correct on all systems that support +-- the IEEE 64-bit real arithmetic standard since the mantissa in that case +-- is 53-bits. +-- ... from page 1195 upper right quadrant +-- +-- var seed : real; +-- ... +-- function Random : real; +-- (* Real Version 1 *) +-- const +-- a = 16807.0; +-- m = 2147483647.0; +-- var +-- temp : real; +-- begin +-- temp := a * seed; +-- seed := +-- temp - m * Trunc(temp / m); +-- Random := seed / m; +-- end; +-- +-- ... from page 1195 lower right quadrant, variant by L. Schrage, 1979, 1983 +-- +-- var seed : integer; +-- ... +-- function Random : real; +-- (* Integer Version 2 *) +-- const +-- a = 16807; +-- m = 2147483647; +-- q = 127773; (* m div a *) +-- r = 2836; (* m mod a *) +-- var +-- lo, hi, test : integer; +-- begin +-- hi := seed div q; +-- lo := seed mod q; +-- test := a * lo - r * hi; +-- if test > 0 then +-- seed := test +-- else +-- seed := test + m; +-- +-- Random := seed / m; +-- end; +-- +-- From page 1195 lower left quadrant +-- +-- seed := 1; +-- for n := 1 to 10000 do +-- u := Random; +-- Writeln('The current value of seed is : ', seed); +-- (* Expect 1043618065 *) +------------------------------------------------------------------------------- diff --git a/demos/queens.gs b/demos/queens.gs new file mode 100644 index 0000000..cd0e83d --- /dev/null +++ b/demos/queens.gs @@ -0,0 +1,20 @@ +-- This N-Queens program is based on a small variation of the 8-queens +-- program from Bird and Wadler's book. +-- +-- Be warned: printing out the complete list of solutions (all 92 of them) +-- by evaluating "q 8" takes well over 1 million reductions and uses nearly +-- 2.5 million cells... it may take some time to execute on slower systems! :-) + +queens number_of_queens = qu number_of_queens where + qu 0 = [[]] + qu (m+1) = [ p++[n] | p<-qu m, n<-[1..number_of_queens], safe p n ] + +safe p n = all not [ check (i,j) (m,n) | (i,j) <- zip [1..] p ] + where m = 1 + length p + +check (i,j) (m,n) = j==n || (i+j==m+n) || (i-j==m-n) + +-- Use q 5 to see the list of solutions for 5 queens. +-- Use q 8 to see the list of solutions for 8 queens .... +q n = layn (map show' (queens n)) + diff --git a/demos/random.gs b/demos/random.gs new file mode 100644 index 0000000..99e6839 --- /dev/null +++ b/demos/random.gs @@ -0,0 +1,11 @@ +-- Generate a list of random numbers of length n + +randoms :: Int -> [Int] +randoms = iterate (\seed-> (77*seed+1) `rem` 1024) + +rand100 = sort (take 100 (randoms 1000)) -- a sample distribution + +adjs [] = [] -- a list of pairs of adjacent +adjs xs = zip xs (tail xs) -- elements in a list + + diff --git a/demos/squigol.gs b/demos/squigol.gs new file mode 100644 index 0000000..228f821 --- /dev/null +++ b/demos/squigol.gs @@ -0,0 +1,30 @@ +-- A couple of examples defining an ascii form of squigol notation for Gofer: +-- All of these are of course just different syntax for standard prelude +-- functions: + +infixr 5 **, <|, <-/-, -/->, -//-> + +f ** xs = [ f x | x<-xs ] -- map +p <| xs = [ x | x<-xs, p x ] -- filter + +(a <-/- f) [] = a -- foldr +(a <-/- f) (x:xs) = f x ((a <-/- f) xs) + +(f -/-> a) [] = a -- foldl +(f -/-> a) (x:xs) = (f -/-> f a x) xs + +(f -//-> a) xs = a : (case xs of -- scanl + [] -> [] + (x:xs) -> (f -//-> f a x) xs) + +-- Here's another piece of notation -- not squigol, but of a similar flavour +-- which would enable us to do away with the zipWith family of functions: +-- +-- map f xs1 << xs2 << ... << xsn = zipWithn f xs1 xs2 ... xsn +-- +-- in terms of the old notation, (<<) = zipWith (\f x->f x) + +infixl 0 << + +f:fs << x:xs = f x : (fs << xs) +_ << _ = [] diff --git a/demos/stack.gs b/demos/stack.gs new file mode 100644 index 0000000..4316877 --- /dev/null +++ b/demos/stack.gs @@ -0,0 +1,52 @@ +-- Stacks: using restricted type synonyms + +type Stack a = [a] in emptyStack, push, pop, topOf, isEmpty + +emptyStack :: Stack a +emptyStack = [] + +push :: a -> Stack a -> Stack a +push = (:) + +pop :: Stack a -> Stack a +pop [] = error "pop: empty stack" +pop (_:xs) = xs + +topOf :: Stack a -> a +topOf [] = error "topOf: empty stack" +topOf (x:_) = x + +isEmpty :: Stack a -> Bool +isEmpty = null + +instance Eq a => Eq (Stack a) where + s1 == s2 | isEmpty s1 = isEmpty s2 + | isEmpty s2 = isEmpty s1 + | otherwise = topOf s1 == topOf s2 && pop s1 == pop s2 + +-- A slightly different presentation: + +type Stack' a = [a] in + emptyStack' :: Stack' a, + push' :: a -> Stack' a -> Stack' a, + pop' :: Stack' a -> Stack' a, + topOf' :: Stack' a -> a, + isEmpty' :: Stack' a -> Bool + +emptyStack' = [] + +push' = (:) + +pop' [] = error "pop': empty stack" +pop' (_:xs) = xs + +topOf' [] = error "topOf': empty stack" +topOf' (x:_) = x + +isEmpty' = null + +instance Eq a => Eq (Stack' a) where + s1 == s2 | isEmpty' s1 = isEmpty' s2 + | isEmpty' s2 = isEmpty' s1 + | otherwise = topOf' s1 == topOf' s2 && pop' s1 == pop' s2 + diff --git a/demos/temps.gs b/demos/temps.gs new file mode 100644 index 0000000..5282927 --- /dev/null +++ b/demos/temps.gs @@ -0,0 +1,15 @@ +-- Representation of temperatures on both Fahrenheit and Celsius scales +-- +-- This program cannot be used on any machine without support for floating +-- point numbers within Gofer (e.g. PCs). + +data Temp = Celsius Float | Fahrenheit Float + +fahrToCent f = (f-32.0)/1.8 + +instance Eq Temp where + Celsius c1 == Celsius c2 = c1==c2 + Celsius c1 == Fahrenheit f2 = c1==fahrToCent f2 + Fahrenheit f1 == Celsius c2 = fahrToCent f1==c2 + Fahrenheit f1 == Fahrenheit f2 = f1==f2 + diff --git a/demos/tree.gs b/demos/tree.gs new file mode 100644 index 0000000..8b109e6 --- /dev/null +++ b/demos/tree.gs @@ -0,0 +1,52 @@ +-- Here are a collection of fairly standard functions for manipulating +-- one form of binary trees + +data Tree a = Lf a | Tree a :^: Tree a + +reflect t@(Lf x) = t +reflect (l:^:r) = r :^: l + +mapTree f (Lf x) = Lf (f x) +mapTree f (l:^:r) = mapTree f l :^: mapTree f r + +-- Functions to calculate the list of leaves on a tree: + +leaves, leaves' :: Tree a -> [a] + +leaves (Lf l) = [l] -- direct version +leaves (l:^:r) = leaves l ++ leaves r + +leaves' t = leavesAcc t [] -- using an accumulating parameter + where leavesAcc (Lf l) = (l:) + leavesAcc (l:^:r) = leavesAcc l . leavesAcc r + +-- Picturing a tree: + +drawTree :: Text a => Tree a -> String +drawTree = unlines . thd3 . pic + where pic (Lf a) = (1,1,["-- "++show a]) + pic (l:^:r) = (hl+hr+1, hl+1, top pl ++ mid ++ bot pr) + where (hl,bl,pl) = pic l + (hr,br,pr) = pic r + top = zipWith (++) (copy (bl-1) " " ++ + [" ,-"] ++ + copy (hl-bl) " | ") + mid = ["-| "] + bot = zipWith (++) (copy (br-1) " | " ++ + [" `-"] ++ + copy (hr-br) " ") + +-- Finally, here is an example due to Richard Bird, which uses lazy evaluation +-- and recursion to create a `cyclic' program which avoids multiple traversals +-- over a data structure: + +replaceAndMin m (Lf n) = (Lf m, n) +replaceAndMin m (l:^:r) = (rl :^: rr, ml `min` mr) + where (rl,ml) = replaceAndMin m l + (rr,mr) = replaceAndMin m r + +replaceWithMin t = mt where (mt,m) = replaceAndMin m t + +sample = (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10 +sample2 = sample :^: sample +sample4 = sample2 :^: sample2 diff --git a/docs/Readme b/docs/Readme new file mode 100644 index 0000000..d3df3c1 --- /dev/null +++ b/docs/Readme @@ -0,0 +1,81 @@ +------------------------------------------------------------------------------ + +This directory contains a draft of the user documentation for Gofer. +More precisely, the files in this directory are as follows: + + Readme this file + hype a summary of the main features of Gofer + ch*, appx_* individual chapters and appendices for the + main Gofer user manual (Gofer version 2.20) + (126 pages) + release.221 release notes for Gofer 2.21 (21 pages) + release.228 release notes for Gofer 2.28 (49 pages) + release.230 release notes for Gofer 2.30a (11 pages) + goferdoc.tex Jeroen Fokker's LaTeX version of the main + Gofer user manual. + +Several people have contributed man pages for Gofer: + + gofer.1 by Gary Leavens + bowen.1 by Jonathan Bowen + jeroen.1 by Jeroen Fokker + +Feel free to use which ever one you prefer! + +Some of the information in the earlier documentation is rather out +of date. You have been warned!!! + +Given the number of pages involved, you will probably want to be +selective about what you read and, in the interests of all of those +poor trees, selective about what you print -- particularly bearing in +mind the fact that this is only a draft and likely to change! Another +point worth mentioning is that the files are just plain ASCII text +files -- they can be printed out without problem on a dot matrix +printer ... + +Those of you with fancy printers and document preparation software may +be dissappointed that I haven't used anything more than ASCII text to +produce these documents. The simple reason for this is that ASCII is +the only format that I can reasonably guarantee will be available on +all of the machines on which Gofer is used. + +Entries marked with a `+' in the list below are likely to be of most +interest to those who are already familiar with Orwell. + +These files may contain many errors; I would be grateful for any +corrections or suggestions! + + ch00 Title and contents pages + + ch01 INTRODUCTION + ch02 BACKGROUND AND ACKNOWLEDGEMENTS + + ch03 STARTING GOFER + ch04 USING GOFER - A BASIC INTRODUCTION + ch05 STANDARD AND USER-DEFINED FUNCTIONS + ch06 FUNCTION NAMES - IDENTIFIERS AND OPERATORS + ch07 BUILT-IN TYPES + ch08 ERRORS + ch09 MORE ABOUT VALUE DECLARATIONS + + ch10 INCREASING YOUR POWER OF EXPRESSION + ch11 USER-DEFINED DATATYPES AND TYPE SYNONYMS + + ch12 DIALOGUES: INPUT AND OUTPUT + ch13 LAYOUT + + ch14 OVERLOADING IN GOFER + + + appx_a SUMMARY OF GRAMMAR + + appx_b CONTENTS OF STANDARD PRELUDE + + appx_c RELATIONSHIP WITH HASKELL 1.1 + + appx_d USING GOFER WITH BIRD+WADLER + appx_e PRIMITIVES + + appx_f INTERPRETER COMMAND SUMMARY + appx_g BIBLIOGRAPHY + +Each file contains one or more pages of plain ASCII text. +Each page is exactly 66 lines long. + +If the format of these files is unsuitable for your printer, you may +like to get hold of a copy of the source code and page formatter from +which these documents were produced. These should be available from +the same place that you obtained the files in this directory. + +------------------------------------------------------------------------------ diff --git a/docs/appx_a b/docs/appx_a new file mode 100644 index 0000000..723f9ef --- /dev/null +++ b/docs/appx_a @@ -0,0 +1,264 @@ + + +Introduction to Gofer APPENDIX A: SUMMARY OF GRAMMAR + + +APPENDIX A: SUMMARY OF GRAMMAR + +This section gives a summary of the grammar for the language used by +Gofer. The non-terminals and describe the syntax of +expressions that can be entered into the Gofer interpreter and that of +files of definitions that can be loaded into Gofer respectively. + +The following notational conventions are used in the Grammar which is +specified using a variant of BNF: + + o are used to distinguish names of nonterminals from + keywords. + + o vertical | bars are used to separate alternatives. + + o {braces} enclose items which may be repeated zero or more times. + + o [brackets] are used for optional items. + + o (parentheses) are used for grouping. + + o "quotes" surround characters which might otherwise be confused with + the notations introduced above. + +The following terminal symbols are used but not defined by the grammar: + + VARID identifier beginning with lower case letter as described in + section 6. + CONID like VARID, but beginning with upper case letter. + VAROP operator symbol not beginning with a colon, as described in + section 6. + CONOP constructor function operator, like VAROP, but beginning + with a colon character. + INTEGER integer constant, as described in section 7.3. + FLOAT floating point constant, as described in section 7.4. + CHAR character constant, as described in section 7.5. + STRING string constant, as described in section 7.7. + + +Top-level grammar +----------------- + + ::= "{" "}" module + + ::= [] top-level expression + + ::= ; multiple declarations + | data = datatype declaration + | type = synonym declaration + | infixl [] {, } fixity declarations + | infixr [] {, } + | infix [] {, } + | primitive :: primitive bindings + | class declaration + | instance declaration + | value declarations + + + 93 + + + + +Introduction to Gofer APPENDIX A: SUMMARY OF GRAMMAR + + + ::= CONID {VARID} type declaration lhs + + ::= "|" multiple constructors + | CONOP infix constructor + | CONID {} constructor, n>=0 + + ::= , multiple bindings + | primitive binding + +Type expressions +---------------- + + ::= [ => ] [qualified] type + + ::= "(" [ {, }] ")" general form + | singleton context + ::= CONID {} predicate + + ::= [ -> ] function type + ::= CONID {} datatype or synonym + | + ::= VARID type variable + | "(" ")" unit type + | "(" ")" parenthesised type + | "(" , {,} ")" tuple type + | "[" "]" list type + +Class and instance declarations +------------------------------- + + ::= class [ =>] [] + ::= where "{" "}" class body + ::= ; multiple declarations + | {, } :: member functions + | [] default bindings + + ::= instance [ =>] [] + ::= where "{" "}" instance body + ::= ; multiple declarations + | [] member definition + +Value declarations +------------------ + + ::= ; multiple declarations + | {, } :: type declaration + | [] function binding + | [] pattern binding + + ::= = simple right hand side + | {} guarded right hand sides + + ::= "|" = guarded right hand side + + ::= where "{" "}" local definitions + + + + 94 + + + + +Introduction to Gofer APPENDIX A: SUMMARY OF GRAMMAR + + + ::= function of arity 0 + | infix operator + | "(" ")" section-like notation + | "(" ")" + | function with argument + | "(" ")" parenthesised lhs + +Expressions +----------- + + ::= \ {} -> lambda expression + | let "{" "}" in local definition + | if then else conditional expression + | case of "{" "}" case expression + | :: typed expression + | + ::= operator application + | + ::= - negation + | + ::= function application + | + ::= variable + | constructor + | INTEGER integer literal + | FLOAT floating point literal + | CHAR character literal + | STRING string literal + | "(" ")" unit element + | "(" ")" parenthesised expr. + | ( ) sections + | ( ) + | "[" "]" list expression + | "(" , {, } ")" tuple + + ::= [ {, } ] enumerated list + | "|" list comprehension + | .. arithmetic sequence + | , .. + | .. + | , .. + ::= , multiple qualifiers + | <- generator + | = local definition + | boolean guard + + ::= ; multiple alternatives + | [] alternative + ::= -> single alternative + | {} guarded alternatives + ::= "|" -> guarded alternative + +Patterns +-------- + + ::= operator application + + + 95 + + + + +Introduction to Gofer APPENDIX A: SUMMARY OF GRAMMAR + + + | + (n+k) pattern + | + ::= application + | + ::= variable + | @ as pattern + | ~ irrefutable pattern + | _ wildcard + | constructor + | INTEGER integer literal + | CHAR character literal + | STRING string literal + | "(" ")" unit element + | "(" ")" parenthesised expr. + | ( ) sections + | ( ) + | "[" [ {, } ] "]" list + | "(" , {, } ")" tuple + +Variables and operators +----------------------- + + ::= | "(" - ")" variable + ::= | | - operator + + ::= VARID | "(" VAROP ")" variable identifier + ::= VAROP | ` VARID ` variable operator + + ::= CONID | "(" CONOP ")" constructor identifier + ::= CONOP | ` CONID ` constructor operator + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 96 + + diff --git a/docs/appx_b b/docs/appx_b new file mode 100644 index 0000000..11ab969 --- /dev/null +++ b/docs/appx_b @@ -0,0 +1,1056 @@ + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +APPENDIX B: CONTENTS OF STANDARD PRELUDE + +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.30 +-- Copyright Mark P Jones 1991-1994. +-- +-- Standard prelude for use of overloaded values using type classes. +-- Based on the Haskell standard prelude version 1.2. + +help = "press :? for a list of commands" + +-- Operator precedence table: ----------------------------------------------- + +infixl 9 !! +infixr 9 . +infixr 8 ^ +infixl 7 * +infix 7 /, `div`, `quot`, `rem`, `mod` +infixl 6 +, - +infix 5 \\ +infixr 5 ++, : +infix 4 ==, /=, <, <=, >=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +infixr 0 $ + +-- Standard combinators: ---------------------------------------------------- + +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a + + + 97 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b -- pronounced as `apply' elsewhere +f $ x = f x + +-- Boolean functions: ------------------------------------------------------- + +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True + +-- Character functions: ----------------------------------------------------- + +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + + + 98 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' + +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c + +minChar, maxChar :: Char +minChar = chr 0 +maxChar = chr 255 + +-- Standard type classes: --------------------------------------------------- + +class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +class Ord a => Ix a where + range :: (a,a) -> [a] + index :: (a,a) -> a -> Int + inRange :: (a,a) -> a -> Bool + +class Ord a => Enum a where + enumFrom :: a -> [a] -- [n..] + enumFromThen :: a -> a -> [a] -- [n,m..] + enumFromTo :: a -> a -> [a] -- [n..m] + enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] + + enumFromTo n m = takeWhile (m>=) (enumFrom n) + enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m) + (enumFromThen n n') + + + + 99 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +class (Eq a, Text a) => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +-- Type class instances: ---------------------------------------------------- + +primitive primEqInt "primEqInt", + primLeInt "primLeInt" :: Int -> Int -> Bool +primitive primPlusInt "primPlusInt", + primMinusInt "primMinusInt", + primDivInt "primDivInt", + primMulInt "primMulInt" :: Int -> Int -> Int +primitive primNegInt "primNegInt" :: Int -> Int + +instance Eq () where () == () = True +instance Ord () where () <= () = True + +instance Eq Int where (==) = primEqInt + +instance Ord Int where (<=) = primLeInt + +instance Ix Int where + range (m,n) = [m..n] + index b@(m,n) i + | inRange b i = i - m + | otherwise = error "index out of range" + inRange (m,n) i = m <= i && i <= n + +instance Enum Int where + enumFrom n = iterate (1+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + +{- PC version off -} +primitive primEqFloat "primEqFloat", + primLeFloat "primLeFloat" :: Float -> Float -> Bool +primitive primPlusFloat "primPlusFloat", + primMinusFloat "primMinusFloat", + primDivFloat "primDivFloat", + primMulFloat "primMulFloat" :: Float -> Float -> Float +primitive primNegFloat "primNegFloat" :: Float -> Float +primitive primIntToFloat "primIntToFloat" :: Int -> Float + +instance Eq Float where (==) = primEqFloat + +instance Ord Float where (<=) = primLeFloat + +instance Enum Float where + + + 100 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + + enumFrom n = iterate (1.0+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +primitive sin "primSinFloat", asin "primAsinFloat", + cos "primCosFloat", acos "primAcosFloat", + tan "primTanFloat", atan "primAtanFloat", + log "primLogFloat", log10 "primLog10Float", + exp "primExpFloat", sqrt "primSqrtFloat" :: Float -> Float +primitive atan2 "primAtan2Float" :: Float -> Float -> Float +primitive truncate "primFloatToInt" :: Float -> Int + +pi :: Float +pi = 3.1415926535 + +{- PC version on -} + +primitive primEqChar "primEqChar", + primLeChar "primLeChar" :: Char -> Char -> Bool + +instance Eq Char where (==) = primEqChar -- c == d = ord c == ord d + +instance Ord Char where (<=) = primLeChar -- c <= d = ord c <= ord d + +instance Ix Char where + range (c,c') = [c..c'] + index b@(m,n) i + | inRange b i = ord i - ord m + | otherwise = error "index out of range" + inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci + +instance Enum Char where + enumFrom c = map chr [ord c .. ord maxChar] + enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar] + where lastChar = if c' < c then minChar else maxChar + +instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +instance Ord a => Ord [a] where + [] <= _ = True + (_:_) <= [] = False + (x:xs) <= (y:ys) = x Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + + + 101 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +instance (Ord a, Ord b) => Ord (a,b) where + (x,y) <= (u,v) = x Int -> Int + +subtract :: Num a => a -> a -> a +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Num a => a -> Int -> a +x ^ 0 = fromInteger 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`quot`2) + | otherwise = f x (n-1) (x*y) + +abs :: (Num a, Ord a) => a -> a +abs x | x>=fromInteger 0 = x + | otherwise = -x + +signum :: (Num a, Ord a) => a -> Int +signum x + | x==fromInteger 0 = 0 + | x> fromInteger 0 = 1 + | otherwise = -1 + +sum, product :: Num a => [a] -> a +sum = foldl' (+) (fromInteger 0) + + + 102 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +product = foldl' (*) (fromInteger 1) + +sums, products :: Num a => [a] -> [a] +sums = scanl (+) (fromInteger 0) +products = scanl (*) (fromInteger 1) + +-- Standard list processing functions: -------------------------------------- + +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [] +init (x:xs) = x : init xs + +(++) :: [a] -> [a] -> [a] -- append lists. Associative with +[] ++ ys = ys -- left and right identity []. +(x:xs) ++ ys = x:(xs++ys) + +genericLength :: Num a => [b] -> a +genericLength = foldl' (\n _ -> n + fromInteger 1) (fromInteger 0) + +length :: [a] -> Int -- calculate length of list +length = foldl' (\n _ -> n+1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: Eq a => [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: Eq a => a -> [a] -> Bool + + + 103 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: Ord a => [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +concat :: [[a]] -> [a] -- concatenate list of lists +concat = foldr (++) [] + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a]. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + + +-- map f xs applies the function f to each element of the list xs returning +-- the corresponding list of results. filter p xs returns the sublist of xs +-- containing those elements which satisfy the predicate p. + +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter _ [] = [] +filter p (x:xs) + | p x = x : xs' + | otherwise = xs' + where xs' = filter p xs + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn + + + 104 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs + +-- List breaking functions: +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p + + + 105 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] + + + 106 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws + +-- Merging and sorting lists: + +merge :: Ord a => [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: Ord a => [a] -> [a] +sort = foldr insert [] + +insert :: Ord a => a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: Ord a => [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] + +-- zip and zipWith families of functions: + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + + + 107 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) + +-- Formatted output: -------------------------------------------------------- + +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show' :: a -> String +show' x = primPrint 0 x [] + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + + + + 108 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs + +-- Miscellaneous: ----------------------------------------------------------- + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +primitive error "primError" :: String -> a + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x + +-- A trimmed down version of the Haskell Text class: ------------------------ + +type ShowS = String -> String + +class Text a where + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + + showsPrec = primPrint + showList [] = showString "[]" + showList (x:xs) = showChar '[' . shows x . showl xs + where showl [] = showChar ']' + showl (x:xs) = showChar ',' . shows x . showl xs + +shows :: Text a => a -> ShowS +shows = showsPrec 0 + +show :: Text a => a -> String +show x = shows x "" + +showChar :: Char -> ShowS +showChar = (:) + +showString :: String -> ShowS +showString = (++) + +instance Text () where + showsPrec d () = showString "()" + +instance Text Bool where + showsPrec d True = showString "True" + showsPrec d False = showString "False" + +primitive primShowsInt "primShowsInt" :: Int -> Int -> String -> String + + + 109 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +instance Text Int where showsPrec = primShowsInt + +{- PC version off -} +primitive primShowsFloat "primShowsFloat" :: Int -> Float -> String -> String +instance Text Float where showsPrec = primShowsFloat +{- PC version on -} + +instance Text Char where + showsPrec p c = showString [q, c, q] where q = '\'' + showList cs = showChar '"' . showl cs + where showl "" = showChar '"' + showl ('"':cs) = showString "\\\"" . showl cs + showl (c:cs) = showChar c . showl cs + -- Haskell has showLitChar c . showl cs + +instance Text a => Text [a] where + showsPrec p = showList + +instance (Text a, Text b) => Text (a,b) where + showsPrec p (x,y) = showChar '(' . shows x . showChar ',' . + shows y . showChar ')' + +-- I/O functions and definitions: ------------------------------------------- + +stdin = "stdin" +stdout = "stdout" +stderr = "stderr" +stdecho = "stdecho" + +{- The Dialogue, Request, Response and IOError datatypes are now builtin: +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + | GetArgs + | GetProgName + | GetEnv String + +data Response = Success + | Str String + | Failure IOError + | StrList [String] + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +type Dialogue = [Response] -> [Request] +-} + + + 110 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + +type SuccCont = Dialogue +type StrCont = String -> Dialogue +type StrListCont = [String] -> Dialogue +type FailCont = IOError -> Dialogue + +done :: Dialogue +readFile :: String -> FailCont -> StrCont -> Dialogue +writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue +appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue +readChan :: String -> FailCont -> StrCont -> Dialogue +appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue +echo :: Bool -> FailCont -> SuccCont -> Dialogue +getArgs :: FailCont -> StrListCont -> Dialogue +getProgName :: FailCont -> StrCont -> Dialogue +getEnv :: String -> FailCont -> StrCont -> Dialogue + +done resps = [] +readFile name fail succ resps = + (ReadFile name) : strDispatch fail succ resps +writeFile name contents fail succ resps = + (WriteFile name contents) : succDispatch fail succ resps +appendFile name contents fail succ resps = + (AppendFile name contents) : succDispatch fail succ resps +readChan name fail succ resps = + (ReadChan name) : strDispatch fail succ resps +appendChan name contents fail succ resps = + (AppendChan name contents) : succDispatch fail succ resps +echo bool fail succ resps = + (Echo bool) : succDispatch fail succ resps +getArgs fail succ resps = + GetArgs : strListDispatch fail succ resps +getProgName fail succ resps = + GetProgName : strDispatch fail succ resps +getEnv name fail succ resps = + (GetEnv name) : strDispatch fail succ resps + +strDispatch fail succ (resp:resps) = + case resp of Str val -> succ val resps + Failure msg -> fail msg resps + +succDispatch fail succ (resp:resps) = + case resp of Success -> succ resps + Failure msg -> fail msg resps + +strListDispatch fail succ (resp:resps) = + case resp of StrList val -> succ val resps + Failure msg -> fail msg resps + +abort :: FailCont +abort err = done + +exit :: FailCont +exit err = appendChan stderr msg abort done + where msg = case err of ReadError s -> s + WriteError s -> s + SearchError s -> s + + + 111 + + + + +Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE + + + FormatError s -> s + OtherError s -> s + +print :: Text a => a -> Dialogue +print x = appendChan stdout (show x) exit done + +prints :: Text a => a -> String -> Dialogue +prints x s = appendChan stdout (shows x s) exit done + +interact :: (String -> String) -> Dialogue +interact f = readChan stdin exit + (\x -> appendChan stdout (f x) exit done) + +run :: (String -> String) -> Dialogue +run f = echo False exit (interact f) + +primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a + +openfile :: String -> String +openfile f = primFopen f (error ("can't open file "++f)) id + +-- End of Gofer standard prelude: -------------------------------------------- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 112 + + diff --git a/docs/appx_c b/docs/appx_c new file mode 100644 index 0000000..86440ad --- /dev/null +++ b/docs/appx_c @@ -0,0 +1,264 @@ + + +Introduction to Gofer APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + + +APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell as +defined in the report for Haskell version 1.1 [5]. This section +details the differences between the two languages, outlined briefly in +section 2. + +Haskell features not included in Gofer: +--------------------------------------- + o Modules + + o Arrays + + o Derived instances for standard classes -- the ability to construct + instances of particular classes automatically. + + o Default mechanism for eliminating unresolved overloading involving + numeric and standard classes. Since Gofer is an experimental + system, it can be used with a range of completely different + prelude files; there is no concept of `standard classes'. + + o Overloaded numeric constants. In the absence of a defaulting + mechanism as mentioned in the previous item, problems with + unresolved overloading make implicitly typed programming involving + numeric constants impractical in an interpreter based system. + + o Full range of numeric types and classes. Gofer has only two + primitive numeric types Int and Float (the second of which is not + supported in the PC version). Although is would be possible to + modify the standard prelude so that Gofer uses the same class + hierarchy as Haskell, this is unnecessarily sophisticated for the + intended uses of Gofer. + + o Datatype definitions in Haskell may involve class constraints such + as: + + data Ord a => Set a = Set [a] + + It is not clear how such constraints should be interpreted + (particularly in the light of the extended form of constraints + used by Gofer) in such a way to make them useful whilst avoiding + unwanted ambiguity problems. + + +Gofer features not supported in Haskell: +---------------------------------------- + o Type classes may have multiple parameters. + + o Predicates in type expressions may involve arbitrary type + expressions, not just type variables as used in Haskell. + + o Instances of type classes can be defined at non-overlapping, but + otherwise arbitrary types, as described in section 14.2.5. + + o List comprehensions may include local definitions, specified by + + + 113 + + + + +Introduction to Gofer APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + + + qualifiers of the form = as described in section 10.2. + + o No restrictions are placed on the form of predicates that appear + in the context for a class or instance declaration. This has a + number of consequences, including the possibility of using + (mutually) recursive groups of dictionaries, but means that + decidability of the predicate entailment relation may be lost. + This is not a great problem in practice, since all dictionary + construction is performed before evaluation and supposedly + non-terminating dictionary constructions will actually generate an + error due to the limited amount of space available for holding + dictionaries (see section 14.4.2). + + +Other differences: +------------------ + o Whilst superficially similar the approach to type classes in Gofer + is quite different from that used in Haskell. In particular, the + approach used in Gofer ensures that all necessary dictionaries are + constructed before the evaluation of an expression begins, rather + than being built (possibly several times) during the evaluation as + is the case with Haskell. See section 14 and reference [11] for + further details. + + o Input/Output facilities - Gofer supports only a subset of the + requests available in Haskell. In principle, it should not be too + difficult to add most of the remaining forms of request (with the + exception of those associated with binary files) to Gofer. The + principal motivation for including the I/O facilities in Gofer was + to make it possible to experiment with simple interactive + programs. + + o In Gofer, unary minus has greater precedence than any operator + symbol, but lower than that of function application. In Haskell, + the precedence of unary minus is the same as that of the infix + (subtraction) operator of the same name. + + o In Haskell, the character `-' can only be used as the first + character of an operator symbol. In Gofer, this character may + appear in any position in an operator (except for symbols + beginning with "--", which indicates the start of a comment). The + only problems that I am aware of with this is that a lambda + expression such as "\-2->2" will be parsed as such by a Haskell + system, but cause a syntax error in Gofer. This form of lambda + expression is sufficiently unusual that I do not believe this will + cause any problems in practice; in any case, the parsing problem + can be solved by inserting a space: "\ -2->2". + + o Pattern bindings are not currently permitted in either instance or + class declarations. This restriction has been made simply for + ease of implementation, is not an inherent problem with the type + class system and is likely to be relaxed in later versions of + Gofer if appropriate. I have yet to see any examples in which the + lack of pattern bindings in class and instance declarations causes + any kind of deficiency. + + + + 114 + + + + +Introduction to Gofer APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + + + o Qualified type signatures are not permitted for the member + functions in Gofer class declarations. Once again, this + restriction was made for ease of implementation rather than any + pressing technical issues. It is likely that this restriction + will be relaxed in future versions of Gofer, although I am not + convinced that proper use can be made of such member functions + without some form of nested instance declarations (yuk!). + + o The definition of the class Text given in the standard prelude + does not include the Haskell functions for reading/parsing values + from strings; the only reason for omitting these functions was to + try to avoid unnecessary complexity in the standard prelude. The + standard prelude can be modified to include the appropriate + additional definitions if these are required. + + +Known problems in Gofer: +------------------------ + o The null escape sequence "\&" is not generated in the printable + representations of strings produced by both the primitive function + primPrint (used to implement the show' function) and the version + of show defined in the standard prelude. This means that certain + strings values are not printed correctly e.g. show' "\245\&123" + produces the string "\245123". This is unlikely to cause too many + problems in practice. + + o Unification of a type variable a with a type expression of the + form T a where T is a synonym name whose expansion does not + involve a will fail. It is not entirely clear whether this + behaviour is correct or not. + + o Formfeeds '\f' and vertical tabs '\v' are not treated as valid + whitespace characters in the way suggested by the Haskell report. + + o Inability to recover from program stack overlow errors in some + situations. This problem only affects the PC implementation of + Gofer. + + o Implementation of ReadFile may lose referential transparency; the + response to a particular ReadFile request may be affected by a + later WriteFile or AppendFile request for the same file. Whilst + this problem can be solved for UNIX based implementations, I have + not yet found a portable solution suitable for all of the systems + on which Gofer can be used. + + +Areas for possible future improvement: +-------------------------------------- + o Relaxing the restriction on type synonyms in predicates. + + o General purpose automatic default mechanism for eliminating + certain forms of unresolved overloading. + + o Improved checking and use of superclass and instance constraints + during static analysis and type checking. + + + + 115 + + + + +Introduction to Gofer APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + + + o Simple facility to force dictionary construction at load-time. + + o Provision for shell escapes :! etc within the Gofer interpreter. + + o Debugging facilities, including breakpoints and tracing from + within interpreter. + + o Separate interpreter and compiler programs for creating standalone + applications using Gofer. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 116 + + diff --git a/docs/appx_d b/docs/appx_d new file mode 100644 index 0000000..f9048ae --- /dev/null +++ b/docs/appx_d @@ -0,0 +1,132 @@ + + +Introduction to Gofer APPENDIX D: USING GOFER WITH BIRD+WADLER + + +APPENDIX D: USING GOFER WITH BIRD+WADLER + +Bird and Wadler's textbook [1] gives an excellent introduction to +functional programming, providing an insight into both basic techniques +and matters of programming style as well as describing the underlying +mathematics and its use for program development and derivation. Most +of the programs in that book can be used with Gofer although there are +a number of differences between the two notations. Fortunately, it is +not difficult to translate from one notation to the other. The +following points are particularly useful for this: + + o Type constructors in Gofer begin with capital letters (e.g. Bool, + Char etc..) where lower case is used in [1] (e.g. bool, char, + etc..). Note that Gofer has no general numeric type "num" as used + in [1]; Use either Int, Float, or overloading in Gofer as + appropriate. + + o Datatype definitions in [1] are written in the form lhs::=constrs. + The equivalent definition in Gofer is: data lhs = constrs. + + Similarly, a type synonym definition in [1] of the form lhs == rhs + can be written in Gofer as: type lhs = rhs. + + o The differences between the syntax used for guarded equations in + Gofer compared with the notation used in [1] have already been + discussed in section 9.2. For example: + + Using the notation of [1]: Using Gofer: + + filter p (x:xs) filter p (x:xs) + = x : filter p xs, if p x | p x = x : filter p xs + = filter p xs, otherwise | otherwise = filter p xs + + o In Gofer, list comprehension qualifiers are separated by commas + rather than semicolons as used in [1]. + + o A number of the function names and types in the standard prelude + are different: + + [1] Gofer [1] Gofer + --- ----- --- ---- + (#) length takewhile takeWhile + (~) not dropwhile dropWhile + (/\) (&&) zipwith zipWith + (\/) (||) swap flip + (!) (!!) in elem + (--) (\\) scan scanl + hd head some any + tl tail listmin minimum + decode chr listmax maximum + code ord + + See appendix B for a complete list of standard functions in Gofer. + + The version of foldl using "strict" which appears in [1] is + available in Gofer as the function "foldl'". + + + 117 + + + + +Introduction to Gofer APPENDIX D: USING GOFER WITH BIRD+WADLER + + + The role of "zip" and "zipwith" in [1] is filled by the "zip" and + "zipWith" families of functions in Gofer. An expression of the + form "zip (xs,ys)" in [1] is equivalent to "zip xs ys" in Gofer + etc... + + o Gofer does not enforce the condition assumed in [1] that the left + hand sides of each of the equations defining a function must be + disjoint. + + o The equality operator in Gofer is written as "==" and the single + equality character "=" is a reserved symbol used to separate left + and right hand sides of equations. Many C programmers will be + familiar with this kind of notation (together with the kinds of + problems it can create!). + + o Some of the identifiers used in [1] are reserved words in Gofer. + Examples that are particularly likely to occur include "in" and + "then". + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 118 + + diff --git a/docs/appx_e b/docs/appx_e new file mode 100644 index 0000000..6d5e578 --- /dev/null +++ b/docs/appx_e @@ -0,0 +1,132 @@ + + +Introduction to Gofer APPENDIX E: PRIMITIVES + + +APPENDIX E: PRIMITIVES + +[WARNING: The features described in this appendix are typically only +needed when alternative versions of the standard prelude are created. +These features should only be used by expert users; misuse may lead to +failure and runtime errors in the Gofer interpreter. It is not usually +a good idea to use primitive functions directly in your programs.] + +A number of primitive functions are builtin to the Gofer interpreter, +and may be bound to function symbols using a declaration of the form: + + primitive name1 code1, name2 code2, ...., namen coden :: type + +where each name is an identifier (or an operator symbol enclosed by +parentheses) and each code is a string literal taken from the table +below. The type specified to the right of the :: symbol must be a +valid type for the functions being defined -- WARNING: GOFER DOES NOT +ATTEMPT TO CHECK FOR SUITABILITY OF THE DECLARED TYPE. The following +definition, taken from the standard prelude, illustrates the use of +this feature to bind a function named primPrint to the primitive +function with code name string "primPrint" and type Int -> a -> String +-> String: + + primitive primPrint "primPrint" :: Int -> a -> String -> String + +The primitive functions currently available are: + +category code name string type +-------- ---------------- ---- + +integer primPlusInt Int -> Int -> Int +arithmetic primMinusInt Int -> Int -> Int + primMulInt Int -> Int -> Int + primDivInt Int -> Int -> Int + primModInt Int -> Int -> Int + primRemInt Int -> Int -> Int + primNegInt Int -> Int -> Int + + +floating primPlusFloat Float -> Float -> Float +point primMinusFloat Float -> Float -> Float +arithmetic primMulFloat Float -> Float -> Float + primDivFloat Float -> Float -> Float + primNegFloat Float -> Float -> Float + + +coercion primIntToChar Int -> Char -- chr in the standard prelude +functions primCharToInt Char -> Int -- ord in the standard prelude + primIntToFloat Int -> Float -- implements fromInteger + +equality primEqInt Int -> Int -> Bool +and <= primLeInt Int -> Int -> Bool +primitives primEqFloat Float -> Float -> Bool + primLeFloat Float -> Float -> Bool + + + + + 119 + + + + +Introduction to Gofer APPENDIX E: PRIMITIVES + + +generic primGenericEq a -> a -> Bool +ordering primGenericNe a -> a -> Bool +primitives primGenericGt a -> a -> Bool + primGenericLe a -> a -> Bool + primGenericGe a -> a -> Bool + primGenericLt a -> a -> Bool + + These functions implement the standard generic (i.e. non + overloaded) ordering primitives. They are not currently + used in the standard prelude. A simplified prelude may be + created by binding the standard operator symbols (==), + (/=), (>), (<=), (>=) and (<) to these functions + respectively. + +output primPrint Int -> a -> String -> String + + This function is used to implement the show' function in + the standard prelude and is not usually used directly. + + primPrint d e s produces a textual representation of the + value of the expression e as a string, followed by the + string s. The integer parameter d is used as an indicator + of the current precedence level. The primPrint function + is the standard method of printing the value of an + expression whose type is not equivalent to the type String + used by the top-level of the Gofer interpreter. + +sequencing primStrict (a -> b) -> a -> b + + The primStrict function (bound to the identifier "strict" + in the standard prelude) forces the evaluation of its + second argument before the function supplied as the first + argument is applied to it. See section 9.4 for an + illustration. + + + + + + + + + + + + + + + + + + + + + + + + + 120 + + diff --git a/docs/appx_f b/docs/appx_f new file mode 100644 index 0000000..d74cdfc --- /dev/null +++ b/docs/appx_f @@ -0,0 +1,132 @@ + + +Introduction to Gofer APPENDIX F: INTERPRETER COMMAND SUMMARY + + +APPENDIX F: INTERPRETER COMMAND SUMMARY + +Command Description +------- ----------- + Analyse expression for errors, typecheck and evaluate. If + the expression has type Dialogue, execute as a program + using the I/O facilities as described in section 12. If + the expression has type String, evaluate and print result + as a lazy list of characters. In any other case, the + standard prelude function show' is applied to the + expression and used to print the value of the result in + the form of a string, as in the previous case. + +:t Analyse expression for errors, typecheck and print the +:type translation and inferred type of the term. +:T + +:q Exit Gofer interpreter. +:quit +:Q + +:? Display summary of interpreter commands. +:h +:H + +:l f1 .. fn Removes any previously loaded files of definitions and + attempts to load the contents of the files f1 upto fn one + after the other. + +:L Remove any previously loaded files of definitions. Only + those functions and values defined in the standard prelude + will still be be available. + +:load Equivalent forms of the :l command. +:L + +:a f1 .. fn Load the contents of the files f1 upto fn in addition to + any previously loaded files. If any of the files of + definitions which have already been loaded have been + modified since they were last read then they are + automatically reloaded before any of the files f1 upto fn + are read. + + If successful, a command of the form ":l f1 ..fn" is + equivalent to the sequence of commands: + :l + :a f1 + . + . + :a fn + +:also Equivalent forms of the :a command. +:A + +:r Repeat the last load command, attempting to reload any + files which have subsequently been modified. Since later + + + 121 + + + + +Introduction to Gofer APPENDIX F: INTERPRETER COMMAND SUMMARY + + + files may depend on the definitions in earlier ones, once + one file has been reloaded, all subsequent files will also + need to be reloaded. + +:reload Equivalent forms of the :r command. +:R + +:e file Suspend current Gofer session and start an editor program + to modify or view the named file. The Gofer session will + be resumed when the editor program terminates, and any + script files that have been changed will be reloaded + automatically. + + Note that a separate editor program is required and that + Gofer must be properly installed to use this feature. The + default editor is usually vi (Calvin version 2.0 is a good + substitute for a PC), although this may have been changed + when your system was installed. In any case, you can + always substitute an editor of your choice by setting the + environment variable EDITOR to the name of your favourite + editor program. + + There are a number of factors which will affect your + choice of editor. On a slow machine, with only a limited + amount of memory, you will probably need to choose a + relatively small editor which can be loaded reasonably + quickly and does not require too much memory. On a more + powerful system, you may find it more convenient to use + Gofer from a window based environment, running your editor + in one window with Gofer in another. + +:e Using the :e command without specifying a particular file + to be edited starts up an editor program as described + above either for the file of definitions most recently + loaded into Gofer or, if an error occurred whilst loading + a file of definitions, for the file of definitions in + which the error was last detected. + + With many editor programs, it is even possible to start + the editor at the line where the error occurred. As + before, it is possible to change the default behaviour of + Gofer in this case by setting the environment variable + EDITLINE to a command string which can be used to start + the editor program with a given file at a specific line + number. The positions in the string at which the file + name and line number values should be inserted should be + indicated by the strings "%s" and "%d" respectively, and + may appear in either order. The default command string, + which is used if EDITLINE is not set is "vi +%d %s". + +:edit Equivalent forms of the :e command. +:E + + + + + + + 122 + + diff --git a/docs/appx_g b/docs/appx_g new file mode 100644 index 0000000..0868519 --- /dev/null +++ b/docs/appx_g @@ -0,0 +1,66 @@ + + +Introduction to Gofer APPENDIX G: BIBLIOGRAPHY + + +APPENDIX G: BIBLIOGRAPHY + +[1] Introduction to functional programming, Richard Bird and Philip + Wadler, Prentice Hall International, 1989. + +[2] The Implementation of functional programming languages, Simon L. + Peyton Jones, Prentice Hall International, 1987. + +[3] Lambda Lifting: Transforming Programs to Recursive Equations, + Thomas Johnsson, in Lecture Notes in Computer Science 201, + Springer Verlag, 1985. [but try to get a copy of the version of + this paper included in Johnsson's thesis which benefits from an + extended typeface and is a little easier to read!] + +[4] How to make ad-hoc polymorphism less ad-hoc, Philip Wadler and + Stephen Blott, University of Glasgow, in the proceedings of the + 16th ACM annual symposium on Principles of Programming Languages, + Austin, Texas, January 1989. + +[5] Report on the programming language Haskell, a non-strict purely + functional language (Version 1.1), Paul Hudak, Philip Wadler et + al. Technical report Yale University/Glasgow University. August, + 1991. + +[6] Introduction to Orwell 6.00, Philip Wadler and Quentin Miller, + University of Oxford, 1990. + +[7] Lazy ML user's manual, Lennart Augustsson and Thomas Johnsson, + 1990. + +[8] Computing with lattices: An application of type classes, Mark P. + Jones, Technical report PRG-TR-11-90, Programming Research Group, + Oxford University Computing Laboratory, June 1990. + +[9] Towards a theory of qualified types, Mark P. Jones, Technical + report PRG-TR-6-91, Programming Research Group, Oxford University + Computing Laboratory, April 1991. + +[10] Type inference for qualified types, Mark P. Jones, Technical + report PRG-TR-10-91, Programming Research Group, Oxford University + Computing Laboratory, June 1991. + +[11] A new approach to type classes, Mark P. Jones, distributed to + Haskell mailing list 1991. + +[12] Practical issues in the implementation of qualified types, Mark P. + Jones, Forthcoming 1991. + + + + + + + + + + + + 123 + + diff --git a/docs/bowen.1 b/docs/bowen.1 new file mode 100644 index 0000000..334bc85 --- /dev/null +++ b/docs/bowen.1 @@ -0,0 +1,134 @@ +.TH GOFER 1 "13 August 1993" "" "" +." location of Gofer files - site specific +.ds RT /usr/local/gofer +.ds LB \*(RT/lib +.ds BN \*(RT/bin +.ds DC \*(RT/doc* +.SH NAME +gofer \- Gofer functional language interpreter +.SH SYNOPSIS +.B gofer +[ \fIoptions\fP ] +.SH DESCRIPTION +.I Gofer +is a shell script that invokes a Gofer functional language +environment, based on Haskell. Help on the commands available +may be obtained by typing \fB:?\fP followed by the return key +within the interpreter. +.PP +The following commands are available: +.IP +.nf +.ta 2i +\fB:load \fI\fR load scripts from specified files +\fB:load\fP clear all files except prelude +\fB:also \fI\fR read additional script files +\fB:reload\fP repeat last load command +\fB:project \fI\fR use project file +\fB:edit \fI\fR edit file +\fB:edit\fP edit last file +\fI\fP evaluate expression +\fB:type \fI\fR print type of expression +\fB:?\fP display this list of commands +\fB:set \fI\fR set command line options +\fB:set\fP help on command line options +\fB:names \fI[pat]\fR list names currently in scope +\fB:info \fI\fR describe named objects +\fB:find \fI\fR edit file containing definition of name +\fB:!\fIcommand\fR shell escape +\fB:cd \fIdir\fR change directory +\fB:quit\fP exit Gofer interpreter +.fi +.PP +Any command may be abbreviated to \fB:\fIc\fR where +\fIc\fP is the first character in the full name. +.SH OPTIONS +Help concerning the command line options may be obtained by +typing \fB:s\fP followed by the return key within the +interpreter. +.LP +Many options are toggled with \fB+\fP or \fB\-\fP to turn them one or +off respectively. The following such options are available: +.IP +.nf +.ta 0.75i +\fBs\fP Print number of reductions/cells after eval +\fBt\fP Print type after evaluation +\fBd\fP Show dictionary values in output exprs +\fBf\fP Terminate evaluation on first error +\fBg\fP Print number of cells recovered after gc +\fBc\fP Test conformality for pattern bindings +\fBl\fP Literate scripts as default +\fBe\fP Warn about errors in literate scripts +\fBi\fP Apply fromInteger to integer literals +\fBo\fP Optimize use of (&&) and (\|\(or\|\(or\|) +\fBu\fP Catch ambiguously typed top-level vars +\fB\&.\fP Print dots to show progress +\fBw\fP Always show which files loaded +\fB1\fP Overload singleton list notation +\fBk\fP Show kind errors in full +.fi +.LP +Other options which may be preceded by \fB+\fP or \fB\-\fP +(making no difference) are: +.IP +.nf +.ta 0.75i +\fBh\fInum\fR Set heap size (cannot be changed within \fIGofer\fP) +\fBp\fIstr\fR Set prompt string to \fIstr\fP +\fBr\fIstr\fR Set repeat last expression string to \fIstr\fP +.fi +.LP +The default settings are: +\fB+sfceow1 \-tdgliu.k \-h100000 \-p? \-r$$\fP +.SH ENVIRONMENT +The following environment variables may be set in the user's +\fI.login\fP or \fI.profile\fP file: +.TP 20 +.BI GOFER= file +Set the standard prelude file to be used by \fIGofer\fP. +The default file is \fI\*(LB/standard.prelude\fP. +.TP 20 +.BI GOFERARGS= options +Set the default options to be used by \fIgofer\fP. +The default is none. +As an example, the following is a possibility: +\fB\-pGofer: \-rit \-s +k\fP +.TP 20 +.BI VISUAL= editor +Set the editor to be used by \fIgofer\fP. The default is +\fI/usr/ucb/vi\fP. +.TP 20 +.BI EDITOR= editor +As for \fBVISUAL\fP if \fBVISUAL\fP is not set. +.SH FILES +.PD 0 +.TP 30 +\*(BN/Gofer +executable binary +.TP 30 +\*(DC +documentation files +.TP 30 +\*(LB +support files +.TP 30 +\*(LB/standard.prelude +standard \fIgofer\fP prelude +.PD +.SH "SEE ALSO" +\fIAn Introduction to Gofer\fP by Mark Jones. +.br +emacs(1), +mira(1), +vi(1) +.SH AUTHOR +Executable and preludes (Version 2.28, 1993): Mark Jones. +.br +Manual page: Jonathan Bowen, Oxford University, UK +\fI\fP. +.br +Shell script: Mark Jones (modified by Jonathan Bowen). +.SH BUGS +The shell script and manual page may change without notice. + diff --git a/docs/ch00 b/docs/ch00 new file mode 100644 index 0000000..0fd5c3d --- /dev/null +++ b/docs/ch00 @@ -0,0 +1,198 @@ + + + + + + + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.20 + + Copyright Mark P Jones 1991. + + + + + + + A N I N T R O D U C T I O N T O G O F E R + + + draft version only --- please report any errors, suggestions for + improvements, extensions (or deletions!) to jones-mark@cs.yale.edu + + + This version includes a number of small corrections + made since the original release. + + -------------------------------------------------------------------- + Permission to use, copy, modify, and distribute this software and its + documentation for any personal or educational use without fee is hereby + granted, provided that: + a) This copyright notice is retained in both source code and + supporting documentation. + b) Modified versions of this software are redistributed only if + accompanied by a complete history (date, author, description) of + modifications made; the intention here is to give appropriate + credit to those involved, whilst simultaneously ensuring that any + recipient can determine the origin of the software. + c) The same conditions are also applied to any software system + derived either in full or in part from Gofer. + + The name "Gofer" is not a trademark, registered or otherwise, and + you are free to mention this name in published material, public and + private correspondence, or other documents without restriction or + obligation. + + Gofer is provided "as is" without express or implied warranty. + -------------------------------------------------------------------- + + + + + + + + + + + + + + + +Introduction to Gofer + + + T A B L E O F C O N T E N T S + + + 1. INTRODUCTION. . . . . . . . . . . . . . . . . . . . . . . . . . 1 + + 2. BACKGROUND AND ACKNOWLEDGEMENTS . . . . . . . . . . . . . . . . 2 + + 3. STARTING GOFER. . . . . . . . . . . . . . . . . . . . . . . . . 4 + + 4. USING GOFER - A BASIC INTRODUCTION. . . . . . . . . . . . . . . 5 + + 5. STANDARD AND USER-DEFINED FUNCTIONS . . . . . . . . . . . . . . 6 + + 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS. . . . . . . . . . . 8 + + 7. BUILT-IN TYPES. . . . . . . . . . . . . . . . . . . . . . . . . 12 + 7.1 Functions . . . . . . . . . . . . . . . . . . . . . . . . . . 12 + 7.2 Booleans. . . . . . . . . . . . . . . . . . . . . . . . . . . 13 + 7.3 Integers. . . . . . . . . . . . . . . . . . . . . . . . . . . 13 + 7.4 Floating point numbers. . . . . . . . . . . . . . . . . . . . 14 + 7.5 Characters. . . . . . . . . . . . . . . . . . . . . . . . . . 14 + 7.6 Lists . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15 + 7.7 Strings . . . . . . . . . . . . . . . . . . . . . . . . . . . 16 + 7.8 Tuples and the unit type. . . . . . . . . . . . . . . . . . . 18 + + 8. ERRORS. . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19 + 8.1 Errors detected on input. . . . . . . . . . . . . . . . . . . 19 + 8.2 Errors during evaluation. . . . . . . . . . . . . . . . . . . 19 + + 9. MORE ABOUT VALUE DECLARATIONS . . . . . . . . . . . . . . . . . 21 + 9.1 Simple pattern matching . . . . . . . . . . . . . . . . . . . 21 + 9.2 Guarded equations . . . . . . . . . . . . . . . . . . . . . . 23 + 9.3 Local definitions . . . . . . . . . . . . . . . . . . . . . . 24 + 9.4 Recursion with integers . . . . . . . . . . . . . . . . . . . 24 + 9.5 Recursion with lists. . . . . . . . . . . . . . . . . . . . . 26 + 9.6 Lazy evaluation . . . . . . . . . . . . . . . . . . . . . . . 27 + 9.7 Infinite data structures. . . . . . . . . . . . . . . . . . . 29 + 9.8 Polymorphism. . . . . . . . . . . . . . . . . . . . . . . . . 30 + 9.9 Higher-order functions. . . . . . . . . . . . . . . . . . . . 31 + 9.10 Variable declarations . . . . . . . . . . . . . . . . . . . . 32 + 9.11 Pattern bindings and irrefutable patterns . . . . . . . . . . 33 + 9.12 Type declarations . . . . . . . . . . . . . . . . . . . . . . 35 + + 10. INCREASING YOUR POWER OF EXPRESSION. . . . . . . . . . . . . . 37 + 10.1 Arithmetic sequences. . . . . . . . . . . . . . . . . . . . . 37 + 10.2 List comprehensions . . . . . . . . . . . . . . . . . . . . . 38 + 10.3 Lambda expressions. . . . . . . . . . . . . . . . . . . . . . 41 + 10.4 Case expressions. . . . . . . . . . . . . . . . . . . . . . . 42 + 10.5 Operator sections . . . . . . . . . . . . . . . . . . . . . . 43 + 10.6 Explicitly typed expressions. . . . . . . . . . . . . . . . . 44 + + 11. USER-DEFINED DATATYPES AND TYPE SYNONYMS . . . . . . . . . . . 46 + 11.1 Datatype definitions. . . . . . . . . . . . . . . . . . . . . 46 + 11.2 Type synonyms . . . . . . . . . . . . . . . . . . . . . . . . 47 + + + + + + + + + +Introduction to Gofer + + + 12. DIALOGUES: INPUT AND OUTPUT. . . . . . . . . . . . . . . . . . 49 + 12.1 Basic description . . . . . . . . . . . . . . . . . . . . . . 49 + 12.2 Continuation style I/O. . . . . . . . . . . . . . . . . . . . 52 + 12.3 Interactive programs. . . . . . . . . . . . . . . . . . . . . 55 + + 13. LAYOUT . . . . . . . . . . . . . . . . . . . . . . . . . . . . 57 + 13.1 Comments. . . . . . . . . . . . . . . . . . . . . . . . . . . 57 + 13.2 The layout rule . . . . . . . . . . . . . . . . . . . . . . . 57 + + 14. OVERLOADING IN GOFER . . . . . . . . . . . . . . . . . . . . . 61 + 14.1 Type classes and predicates . . . . . . . . . . . . . . . . . 61 + 14.2 The type class Eq . . . . . . . . . . . . . . . . . . . . . . 62 + 14.2.1 Implicit overloading. . . . . . . . . . . . . . . . . . . . 62 + 14.2.2 Instances of class Eq . . . . . . . . . . . . . . . . . . . 63 + 14.2.3 Testing equality of represented values. . . . . . . . . . . 65 + 14.2.4 Instance declarations without members . . . . . . . . . . . 66 + 14.2.5 Equality on function types. . . . . . . . . . . . . . . . . 66 + 14.2.6 Non-overlapping instances . . . . . . . . . . . . . . . . . 67 + 14.3 Dictionaries. . . . . . . . . . . . . . . . . . . . . . . . . 68 + 14.3.1 Superclasses. . . . . . . . . . . . . . . . . . . . . . . . 71 + 14.3.2 Combining classes . . . . . . . . . . . . . . . . . . . . . 73 + 14.3.3 Simplified contexts . . . . . . . . . . . . . . . . . . . . 74 + 14.4 Other issues. . . . . . . . . . . . . . . . . . . . . . . . . 76 + 14.4.1 Unresolved overloading. . . . . . . . . . . . . . . . . . . 76 + 14.4.2 `Recursive' dictionaries. . . . . . . . . . . . . . . . . . 79 + 14.4.3 Classes with multiple parameters. . . . . . . . . . . . . . 81 + 14.4.4 Overloading and numeric values. . . . . . . . . . . . . . . 83 + 14.4.5 Constants in dictionaries . . . . . . . . . . . . . . . . . 86 + 14.4.6 The monomorphism restriction. . . . . . . . . . . . . . . . 88 + + APPENDIX A: SUMMARY OF GRAMMAR . . . . . . . . . . . . . . . . . . 93 + + APPENDIX B: CONTENTS OF STANDARD PRELUDE . . . . . . . . . . . . . 97 + + APPENDIX C: RELATIONSHIP WITH HASKELL 1.1. . . . . . . . . . . . .113 + + APPENDIX D: USING GOFER WITH BIRD+WADLER . . . . . . . . . . . . .117 + + APPENDIX E: PRIMITIVES . . . . . . . . . . . . . . . . . . . . . .119 + + APPENDIX F: INTERPRETER COMMAND SUMMARY. . . . . . . . . . . . . .121 + + APPENDIX G: BIBLIOGRAPHY . . . . . . . . . . . . . . . . . . . . .123 + + + + + + + + + + + + + + + + + + diff --git a/docs/ch01 b/docs/ch01 new file mode 100644 index 0000000..3d07aaf --- /dev/null +++ b/docs/ch01 @@ -0,0 +1,66 @@ + + +Introduction to Gofer 1. INTRODUCTION + + +1. INTRODUCTION + +Gofer is a functional programming environment (in other words, an +interpreter) that I have implemented for my own personal use as part of +my research into `qualified types'. Nevertheless, the system is +sufficiently complete for me to believe that Gofer may be of interest +and use to others interested in the field of functional programming. + +These notes give a brief introduction to the Gofer system and include +some examples of Gofer programs. They are not the notes that I +originally intended to write, being somewhat longer and perhaps more +tutorial in nature. Nevertheless, you will not be able to learn +functional programming from this document alone. A number of useful +references are given in the reading list at the end of this document. +In particular, the book by Bird and Wadler [1] is particularly good as +a general introduction to the use, techniques and theory of functional +programming. Although their notation is a little different from the +language used by Gofer, it is a relatively straightforward task to +translate between the two, and some suggestions for this are given in a +appendix D. More importantly, the underlying semantics of Gofer do +correspond to those expected by the authors of [1]. + +Whereas the work involved in investigating and implementing the ideas +on which Gofer is based were motivated largely by my own program of +work, the writing of these notes has rather more to do with the hope +that Gofer will be useful to others. I would therefore be very +grateful for any feedback on any aspect of the these notes (or of the +Gofer system itself). Please let me know if you discover any errors, +or if you find particular sections of these notes rather hard to +follow. Suggestions for improvements or extensions are more than +welcome. + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1 + + diff --git a/docs/ch02 b/docs/ch02 new file mode 100644 index 0000000..a749a5f --- /dev/null +++ b/docs/ch02 @@ -0,0 +1,132 @@ + + +Introduction to Gofer 2. BACKGROUND AND ACKNOWLEDGEMENTS + + +2. BACKGROUND AND ACKNOWLEDGEMENTS + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell [5]. My +principal task in the implementation of Gofer has therefore been to +decide which features I should omit and then to implement what +remains. Features common to both include: + + o Non-strict semantics (lazy evaluation). + o Higher-order functions. + o Extended polymorphic type system with support for user-defined + overloading. + o User-defined algebraic datatypes. + o Pattern matching. + o List comprehensions. + o Facilities for I/O, whilst retaining referential transparency + within a program. + +For the benefit of readers familiar with Haskell, the following +features of Haskell are not supported in the standard version of Gofer: + + o Modules. + o Arrays. + o Defaults for unresolved overloading. + o Derived instances of standard classes. + o Contexts in datatype definitions. + o Full range of numeric types and classes. + +But Gofer is not just a partial implementation of Haskell; it also +includes a number of experimental features which extend the type system +in several ways: + + o An alternative approach to type classes which avoids the need for + construction of dictionaries during the evaluation of an + expression. + o Type classes may take multiple parameters. + o Instances of type classes may be defined at arbitrary + non-overlapping types. + o Contexts may include arbitrary type expressions. + +These extensions stem from my own research [8, 9, 10, 11, 12] and were +among the principal motivations for the development of Gofer. Full +details of the differences between Gofer and Haskell 1.1 are given in +appendix C. + +Gofer would not have been implemented without my original introduction +to functional programming using Orwell [6], and I am particularly +grateful to Quentin Miller for answering so many of my questions about +functional programming and about the Orwell system in particular. I +should also like to mention the influence of the Haskell B. compiler +from Lennart Augustsson and Thomas Johnsson and based on their earlier +LML compiler [7]. + +Right from the beginning, I wanted to be able to use Gofer on a range +of machines - and in particular, on the humble PC that I use at home. +With this in mind, Gofer was actually developed on that same PC using + + + 2 + + + + +Introduction to Gofer 2. BACKGROUND AND ACKNOWLEDGEMENTS + + +Borland's Turbo C 1.5 and a public domain version of the yacc parser +generator that I picked up some time ago. Gofer was also written with +some degree of portability in mind and has subsequently been compiled +to run on Sun workstations. I hope it will also be possible to port it +to other platforms. It is my intention that Gofer be distributed +complete with source code and I hope that this will be of interest to +some users. + +Many of the ideas used in the back-end of the Gofer system (i.e. the +compiler and abstract machine) originate from the chapters of Simon +Peyton Jones textbook [2]; I very much doubt whether Gofer would have +been completed without frequent reference to that book. The +lambda-lifter used in Gofer is based on Thomas Johnsson's algorithm +described in [3]. + +On the theoretical side, I'm grateful to Phil Wadler for the +encouragement that he has given me with my work on qualified types. +Many of the basic ideas that I have used were inspired by his original +paper motivating the use of type classes [4]. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 3 + + diff --git a/docs/ch03 b/docs/ch03 new file mode 100644 index 0000000..4be775e --- /dev/null +++ b/docs/ch03 @@ -0,0 +1,66 @@ + + +Introduction to Gofer 3. STARTING GOFER + + +3. STARTING GOFER + +The Gofer interpreter is usually entered by giving the command `gofer', +after which a display something like the following will normally be +produced: + + Gofer Version 2.20 + + Reading script file "/gofer/prelude": + Parsing........................................................ + Dependency analysis............................................ + Type checking.................................................. + Compiling...................................................... + + Gofer session for: + /gofer/prelude + Type :? for help + ? + +The file name "/gofer/prelude" mentioned in the output above is the +name of a file of standard definitions which are loaded into Gofer each +time that the interpreter is started. By default, Gofer reads these +definitions from a file called "prelude" in the current working +directory. Alternatively you can set the environment variable GOFER to +the name of the standard prelude file, which will then be used, +whatever the current working directory might be. + +Most commands in Gofer take the form of a colon followed by one or more +characters which distinguish one command from another. There are two +commands which are particularly worth remembering: + + o :q exits the Gofer interpreter. On most systems, you can also + exit from Gofer by typing the end of file character (^Z on an + MS-DOS machine, usually ^D on a unix based machine). + + o :? prints a list of all the commands, which can be useful if you + forget the name of the command that you want to use. + +The complete range of commands supported by the Gofer interpreter is +described in appendix F. + +Note that the interrupt key (^C on most systems) can be used at any +time whilst using Gofer to abandon the process of reading in a file of +function definitions or the evaluation of an expression. When the +interrupt key is detected, Gofer prints the string "{Interrupted!}" and +prints the "? " prompt so that further commands can be entered. + + + + + + + + + + + + + 4 + + diff --git a/docs/ch04 b/docs/ch04 new file mode 100644 index 0000000..d3738a4 --- /dev/null +++ b/docs/ch04 @@ -0,0 +1,66 @@ + + +Introduction to Gofer 4. USING GOFER - A BASIC INTRODUCTION + + +4. USING GOFER - A BASIC INTRODUCTION + +Using Gofer is rather like using a high-level programmable calculator; +Once the interpreter is loaded, the system prints a prompt "?" and +waits for you to enter an expression, and then press the enter (return) +key. Once the input is complete, Gofer evaluates the expression and +prints its value on the terminal, before returning to the original +prompt and waiting for the next expression. For example: + + ? (2+3)*8 + 40 + (5 reductions, 9 cells) + ? sum [1..10] + 55 + (91 reductions, 130 cells) + ? + +In the first example, the user entered the expression "(2+3)*8", which +was evaluated by Gofer and the result "40" printed on the terminal. At +the end of any calculation, Gofer displays the number of reductions (a +measure of the amount of work) and cells (a measure of the amount of +memory) that were used during the calculation. These figures can be +useful for comparing the performance of different ways of carrying out +the same calculation. + +In the second example, the user typed the expression "sum [1..10]". +The notation "[1..10]" represents the list of integers between 1 and 10 +inclusive, and "sum" is a standard function which can be used to +determine the sum of a list of integers. Thus the result obtained by +Gofer is: + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 = 55 + +We could have typed this sum into Gofer directly: + + ? 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 55 + (10 reductions, 23 cells) + ? + +and this calculation is certainly more efficient as it uses only 1/9th +of the number of reductions and 1/5th of the number of cells as the +original calculation. On the other hand, the original expression is +much shorter and you are much less likely to make a mistake typing in +the expression "sum [1..200]" than you would be if you tried to enter +the sum of the integers from 1 to 200 directly. + +You will learn more about the kind of expressions that can be entered +into Gofer in the rest of this document. + + + + + + + + + + 5 + + diff --git a/docs/ch05 b/docs/ch05 new file mode 100644 index 0000000..ae48fd8 --- /dev/null +++ b/docs/ch05 @@ -0,0 +1,132 @@ + + +Introduction to Gofer 5. STANDARD AND USER-DEFINED FUNCTIONS + + +5. STANDARD AND USER-DEFINED FUNCTIONS + +The function "sum" used in the examples above, and indeed the addition +and multiplication functions (+) and (*), are all standard functions +which are included as part of a large collection of functions called +the `standard prelude' which are loaded into the Gofer system each time +that you start the interpreter. Quite a number of useful calculations +can be carried out using these functions alone, but for more general +use you can also define your own functions and store the definitions in +a file so that these functions can be loaded and used by by the Gofer +system. For example, suppose that you create a file "fact" containing +the following definition: + + fact n = product [1..n] + +The "product" function is another standard function which can be used +to calculate the product of a list of integers, and so the line above +defines a function "fact" which calculates the factorial of its +argument. In standard mathematical notation, fact n = n! which is +usually defined informally by an equation of the form: + + n! = 1 * 2 * ... * (n-1) * n + +Once you become familiar with the notation used by Gofer, you will see +that the Gofer definition of the factorial function is really very +similar to this informal mathematical definition. + +In order to use this definition from the Gofer interpreter, we must +first load the definitions of the file into the interpreter. The +simplest way to do this uses the ":l" command: + + ? :l fact + Reading script file "fact": + Parsing...................................................... + Dependency analysis.......................................... + Type checking................................................ + Compiling.................................................... + + Gofer session for: + /gofer/prelude + fact + ? + +Notice the list of filenames displayed after "Gofer session for:"; this +tells you which files of definitions are currently being used by Gofer, +the first of which is the file containing the definitions for the +standard prelude. Since the file containing the definition of the +factorial function has now been loaded, we can make use of this +function in expressions entered to the interpreter: + + ? fact 6 + 720 + (57 reductions, 85 cells) + +For another example, recall the standard mathematical formula which +tells us that the number of ways of choosing r objects from a + + + 6 + + + + +Introduction to Gofer 5. STANDARD AND USER-DEFINED FUNCTIONS + + +collection of n objects is given by n! / (r! * (n-r)!). In Gofer, this +function can be defined by: + + comb n r = fact n /(fact r * fact (n-r)) + +In order to use this function, we can either edit the file "fact" which +contains the definition of the factorial function, adding the +definition of "comb" on a new line, or we can include the definition as +part of an expression entered whilst using Gofer: + + ? comb 5 2 where comb n r = fact n /(fact r * fact (n-r)) + 10 + (110 reductions, 161 cells) + ? + +The ability to define a function as part of an expression like this is +often quite useful. However, if the function "comb" were likely to be +wanted on a number of occasions, it would be more sensible to add its +definition to the contents of the file "fact", instead of having to +repeat the definition each time it is used. + +You will learn more about the functions defined in the standard prelude +and find out how to define your own functions in the following +sections. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 7 + + diff --git a/docs/ch06 b/docs/ch06 new file mode 100644 index 0000000..5519732 --- /dev/null +++ b/docs/ch06 @@ -0,0 +1,264 @@ + + +Introduction to Gofer 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + + +6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + +As the examples of the previous section show, there are two kinds of +name that can be used for a function; identifiers such as "sum" and +operator symbols such as "+" and "*". Choosing the appropriate kind of +name for a particular function can often help to make expressions +involving that function easier to read. If for example the addition +function was represented by the name "plus" rather than the operator +symbol "+" then the sum of the integers from 1 to 5 would have to be +written as: + + plus (plus (plus (plus 1 2) 3) 4) 5 + +In this particular case, another way of writing the same sum is: + + plus 1 (plus 2 (plus 3 (plus 4 5))) + +Not only does the use of the identifier "plus" make these expressions +larger and more difficult to read than the equivalent expressions using +"+"; it also makes it very much harder to see that these two +expressions do actually have the same value. + +Gofer distinguishes between the two types of name according to the way +that they are written: + + o An identifier begins with a letter of the alphabet optionally + followed by a sequence of characters, each of which is either a + letter, a digit, an apostrophe (') or an underbar (_). + Identifiers representing functions or variables must begin with a + lower case letter (identifiers beginning with an upper case letter + are used to denote a special kind of function called a + `constructor function' described in section 11.1). The following + identifiers are examples of Gofer variable and function names: + + sum f f'' integerSum african_queen do'until'zero + + The following identifiers are reserved words in Gofer and cannot + be used as the name of a function or variable: + + case of where let in if + then else data type infix infixl + infixr primitive class instance + + o An operator symbol is written using one or more of the following + symbol characters: + + : ! # $ % & * + . / < = > ? @ \ ^ | - + + In addition, the tilde character (~) is also permitted, although + only in the first position of an operator name. [N.B. Haskell + also makes the same restriction for the minus/dash character + (-)]. Operator names beginning with a colon are used for + constructor functions in the same way as identifiers beginning + with a capital letter as mentioned above. In addition, the + following operator symbols have special uses in Gofer: + + + + 8 + + + + +Introduction to Gofer 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + + + :: = .. @ \ | <- -> ~ => + + All other operator symbols can be used as variables or function + names, including each of the following examples: + + + ++ && || <= == /= // . + ==> $ @@ -*- \/ /\ ... ? + + [Note that each of the symbols in the first line is used in the + standard prelude. If you are interested in using Gofer to develop + programs for use with a Haskell compiler, you might also want to + avoid using the operator symbols := ! :+ and :% which are used to + support features in Haskell not currently provided by the Gofer + standard prelude.] + +Gofer provides two simple mechanisms which make it possible to use an +identifier as an operator symbol, or an operator symbol as an +identifier: + + o Any identifier will be treated as an operator symbol if it is + enclosed in backquotes (`) -- for example, the expressions using + the "plus" function above are a little easier to read using this + technique: + + (((1 `plus` 2) `plus` 3) `plus` 4) `plus` 5 + + In general, an expression of the form "x `op` y" is equivalent to + the corresponding expression "op x y", whilst an expression such + as "f x y z" can also be written as "(x `f` y) z". + + [NOTE: For those using Gofer on a PC, you may find that your + keyboard does not have a backquote key! In this case you should + still be able to enter a backquote by holding down the key marked + ALT, pressing the keys '9' and then '6' on the numeric keypad and + then releasing the ALT key.] + + o Any operator symbol can be treated as an identifier by enclosing + it in parentheses. For example, the addition function denoted by + the operator symbol "+" is often written as "(+)". Any expression + of the form "x + y" can also be written in the form "(+) x y". + +There are two more technical problems which have to be dealt with when +working with operator symbols: + + o Precedence: Given operator symbols (+) and (*), should "2 * 3 + 4" + be treated as either "(2 * 3) + 4" or "2 * (3 + 4)"? + + This problem is solved by assigning each operator a precedence + value (an integer in the range 0 to 9). In a situation such as + the above, we simply compare the precedence values of the + operators involved, and carry out the calculation associated + with the highest precedence operator first. The standard + precedence values for (+) and (*) are 6 and 7 respectively so that + the expression above will actually be treated as "(2 * 3) + 4". + + o Grouping: The above rule is only useful when the operator symbols + + + 9 + + + + +Introduction to Gofer 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + + + involved have distinct precedences. For example, should the + expression "1 - 2 - 3" be treated as either "(1 - 2) - 3" giving a + result of -4, or as "1 - (2 - 3)" giving a result of 2? + + This problem is solved by giving each operator a `grouping' + (sometimes called its associativity). An operator symbol (-) is + said to: + + o group to the left if "x - y - z" is treated as "(x - y) - z" + + o group to the right if "x - y - z" is treated as "x - (y - z)" + + A third possibility is that an expression of the form "x - y - z" + is to be treated as ambiguous and will be flagged as a syntax + error. In this case we say that the operator (-) is + non-associative. + + The standard approach in Gofer is to treat (-) as grouping to the + left so that "1 - 2 - 3" will actually be treated as "(1-2)-3". + +By default, every operator symbol in Gofer is treated as +non-associative with precedence 9. These values can be changed by a +declaration of one of the following forms: + + infixl digit ops to declare operators which group to the left + infixr digit ops to declare operators which group to the right + infix digit ops to declare non-associative operators + +In each of these declarations ops represents a list of one or more +operator symbols separated by commas and digit is an integer between 0 +and 9 which gives the precedence value for each of the listed operator +symbols. The precedence digit may be omitted in which case a value of +9 is assumed. There are a number of restrictions on the use of these +declarations: + + o Operator declarations can only appear in files of function + definitions which are loaded into Gofer; they cannot be entered + directly whilst using the Gofer interpreter. + + o At most one operator declaration is permitted for any particular + operator symbol (even if repeated declarations all specify the + same precedence and grouping as the original declaration). + + o Any file containing a declaration for an operator precedence and + grouping must also contain a (top-level) declaration for that + operator. + +In theory, it is possible to use an operator declaration at any point +in a file of definitions. In practice, it is sensible to ensure that +each operator is declared before the symbol is used. One way to +guarantee this is to place all operator declarations at the beginning +of the file [this condition is enforced in Haskell]. Note that until +an operator declaration for a particular symbol is encountered, any +occurrence of that symbol will be treated as a non-associative operator +with precedence 9. + + + + 10 + + + + +Introduction to Gofer 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + + +The following operator declarations are taken from the standard prelude: + + -- Operator precedence table + + infixl 9 !! + infixr 9 . + infixr 8 ^ + infixl 7 * + infix 7 /, `div`, `rem`, `mod` + infixl 6 +, - + infix 5 \\ + infixr 5 ++, : + infix 4 ==, /=, <, <=, >=, > + infix 4 `elem`, `notElem` + infixr 3 && + infixr 2 || + +and their use is illustrated by the following examples: + + Expression: Equivalent to: Reasons: + ----------- -------------- -------- + 1 + 2 - 3 (1 + 2) - 3 (+) and (-) have the same precedence + and group to the left. + x : ys ++ zs x : (ys ++ zs) (:) and (++) have the same precedence + and group to the right + x == y || z (x == y) || z (==) has higher precedence than (||). + 3 * 4 + 5 (3 * 4) + 5 (*) has higher precedence than (+). + y `elem` z:zs y `elem` (z:zs) (:) has higher precedence than elem. + 12 / 6 / 3 syntax error ambiguous use of (/); could mean + either (12/6)/3 or 12/(6/3). + +Note that function application always binds more tightly than any infix +operator symbol. For example, the expression "f x + g y" is equivalent +to "(f x) + (g y)". Another example which often causes problems is the +expression "f x + 1", which is treated as "(f x) + 1" and not as +"f (x+1)" as is sometimes expected. + + + + + + + + + + + + + + + + + + + + + + + 11 + + diff --git a/docs/ch07 b/docs/ch07 new file mode 100644 index 0000000..eecefd4 --- /dev/null +++ b/docs/ch07 @@ -0,0 +1,462 @@ + + +Introduction to Gofer 7. BUILT-IN TYPES + + +7. BUILT-IN TYPES + +An important part of Gofer is the type system which is used to detect +errors in expressions and function definitions. Starting with +primitive expressions such as numeric constants, Gofer assigns a type +to each expression that describes the kind of value represented by the +expression. + +In general we write object :: type to indicate that a particular +expression has the indicated type. For example: + + 42 :: Int indicating that 42 is an integer (Int is the + name for the type of integer values). + + fact :: Int -> Int indicating that "fact" is a function which + takes an integer argument and returns an + integer value (its factorial). + +The most important property of the type system is that it is possible +to determine the type of an expression without having to evaluate it. +For example, the information given above is sufficient to determine +that fact 42 :: Int without needing to calculate 42! first. + +Gofer has a wide range of built-in types, described in the following +sections. In addition, Gofer also includes facilities for defining new +types as well as types acting as abbreviations for complicated type +expressions as described in section 11. + + +7.1 Functions +-------------- +If t1 and t2 are types then t1 -> t2 is the type of a function which, +given an argument of type t1 produces a result of type t2. A function +of type t1 -> t2 is said to have argument type t1 and result type t2. + +In mathematics, the result of applying a function f to an argument x is +traditionally written as f(x). In many situations, these parentheses +are unnecessary and may be omitted when using Gofer. + +e.g. if f :: t1 -> t2 and x :: t1 then f x is the result of applying + f to x and has type t2. + + +If t1, t2, ..., tn are type expressions then: + + t1 -> t2 -> ... -> tn + +can be used as an abbreviation for the type: + + t1 -> (t2 -> ( ... -> tn) ...) + +In a similar way, an expression of the form f x1 x2 ... xn is simply an +abbreviation for the expression ( ... ((f x1) x2) ... xn). + +These two conventions allow us to deal with functions taking more than +one argument rather elegantly. For example, the type of the addition + + + 12 + + + + +Introduction to Gofer 7.1 Functions + + +function (+) is: + Int -> Int -> Int + +In other words, "(+)" is a function which takes an integer argument and +returns a value of type (Int -> Int). For example, "(+) 5" is the +function which takes an integer value n and returns the value of the +integer n plus 5. Hence "(+) 5 4", which is equivalent to "5 + 4", +evaluates to the integer 9 as expected. + + +7.2 Booleans +------------- +Represented by the type "Bool", there are two boolean values written as +"True" and "False". The standard prelude includes several useful +functions for manipulating boolean values: + + (&&), (||) :: Bool -> Bool -> Bool + + The value of the expression b && d is True if and only if both + b and d are True. If b is False then d is not evaluated. + + The value of the expression b || d is True if either of b or d + is True. If b is True then d is not evaluated. + + not :: Bool -> Bool + + The value of the expression not b is the opposite boolean value + to that of b; not True = False, not False = True. + +Gofer includes a special form of `conditional expression' which enables +an expression to select between two alternatives according to the value +of a boolean expression: + + if b then t else f + +is an expression which is equivalent to t if b evaluates to True, or to +f if b evaluates to False. Note that an expression of this form is +only acceptable if b is an expression of type Bool and if the types of +t and f are the same, in which case the whole expression also has that +type. + + +7.3 Integers +------------- +Represented by the type "Int", the integer type includes both positive +and negative integers such as -273, 0 and 383. Like many computer +systems, the range of integer values that can be used is restricted and +calculations using large positive or negative numbers may lead to +(undetected) overflow. + +A wide range of operators and functions are defined in the standard +prelude for use with integers: + + (+) addition. + (*) multiplication. + (-) subtraction. + + + 13 + + + + +Introduction to Gofer 7.3 Integers + + + (^) raise to power. + negate unary negation. An expression of the form "-x" is treated + as the expression "negate x". + (/) integer division. + div " " + rem remainder, related to integer division by the law: + (x `div` y)*y + (x `rem` y) == x + mod modulo, like remainder except that the modulo has the same + sign as the divisor. + odd returns True if argument is odd, False otherwise. + even returns True if argument is even, False otherwise. + gcd returns the greatest common divisor of its two arguments. + lcm returns the least common multiple of its two arguments. + abs returns the absolute value of its argument. + signum returns -1, 0 or 1 indicating that its argument is negative, + zero or positive respectively. + +The less familiar operators are illustrated by the following +identities: + + 3^4 == 81, 7 `div` 3 == 2, even 23 == False + 7 `rem` 3 == 1, -7 `rem` 3 == -1, 7 `rem` -3 == 1 + 7 `mod` 3 == 1, -7 `mod` 3 == 2, 7 `mod` -3 == -2 + gcd 32 12 == 4, abs (-2) == 2, signum 12 == 1 + + +7.4 Floating point numbers +--------------------------- +Represented by the type "Float", elements of this type can be used to +represent fractional values as well as very large or very small +quantities. Such values are however usually only accurate to a fixed +number of digits and rounding errors may occur in some calculations +making significant use of floating point quantities. A numeric value +in an input expression will only be treated as a floating point number +if it either includes a decimal point such as 3.14159, or if the number +is too large to be stored as a value of type Int. Scientific notation +may also be used to enter floating point quantities; for example 1.0e3 +is equivalent to 1000.0, whilst 5.0e-2 is equivalent to 0.05. + +[N.B. floating point numbers are not included in all implementations of +Gofer]. + + +7.5 Characters +--------------- +Represented by the type "Char", elements of this type represent +individual characters such as those entered at a keyboard. Character +values are written as single characters enclosed by apostrophe +characters: e.g. 'a', '0', 'Z'. Some special characters must be +entered using an `escape code'; each of these begins with a backslash +character '\', followed by one or more characters to select the +required character. Some of the most useful escape codes are: + + '\\' backslash + '\'' apostrophe + '\"' double quote + + + 14 + + + + +Introduction to Gofer 7.5 Characters + + + '\n' newline + '\b' or '\BS' backspace + '\DEL' delete + '\t' or '\HT' tab + '\a' or '\BEL' alarm (bell) + '\f' or '\FF' formfeed + +Additional escape characters include: + + '\^c' control character, where c is replaced by + one of the characters: + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" + For example, '\^A' represents control-A + + '\number' representing the character with ASCII value + specified by the given decimal 'number'. + + '\onumber' representing the character with ASCII value + specified by the given octal 'number'. + + '\xnumber' representing the character with ASCII value + specified by the given 'hexadecimal' number. + + '\name' named ASCII control character, where + `name' is replaced by one of the standard + ascii names e.g. `\DC3`. + +In contrast with some common languages (such as C, for example) +character values are quite distinct from integers; however the standard +prelude does include functions: + + ord :: Char -> Int + chr :: Int -> Char + +which enable you to map a character to its corresponding ASCII value, +or from an ASCII value to the corresponding character: + + ? ord 'a' + 97 + (2 reductions, 6 cells) + ? chr 65 + 'A' + (2 reductions, 7 cells) + ? + + +7.6 Lists +---------- +If a is a type then [a] is the type whose elements are lists of values +of type a. There are several ways of writing list expressions: + + o The simplest list of any type is the empty list, written []. + + o Non-empty lists can be constructed either by explicitly listing + the members of the list (for example: [1,3,10]) or by adding a + single element onto the front of another list using the (:) + + + 15 + + + + +Introduction to Gofer 7.6 Lists + + + operator (pronounced "cons"). These notations are equivalent: + + [1,3,10] = 1 : [3,10] = 1 : 3 : [10] = 1 : 3 : 10 : [] + + (the (:) operator groups to the right so 1 : 3 : 10 : [] is + equivalent to (1:(3:(10:[]))) -- a list whose first element is 1, + second element is 3 and last element is 10). + +The standard prelude includes a wide range of functions for +calculations involving lists. For example: + + o length xs returns the number of elements in the list xs. + o xs ++ ys returns the list of elements in xs followed by the + elements in ys + o concat xss returns the list of elements in each of the lists in + xss + o map f xs returns the list of values obtained by applying the + function f to each of the values in the list xs in turn. + +Here are some examples using these functions: + + ? length [1,3,10] + 3 + (15 reductions, 28 cells) + + ? [1,3,10] ++ [2,6,5,7] + [1, 3, 10, 2, 6, 5, 7] + (19 reductions, 77 cells) + + ? concat [[1], [2,3], [], [4,5,6]] + [1, 2, 3, 4, 5, 6] + (29 reductions, 93 cells) + + ? map ord ['H', 'e', 'l', 'l', 'o'] + [72, 101, 108, 108, 111] + (22 reductions, 73 cells) + + ? + +Note that all of the elements in a list must be of the same type, so +that an expression such as ['a', 2, False] is not permitted. + +[ASIDE: At this point it might be useful to mention an informal +convention that is used by a number of functional programmers when +choosing names for variables representing elements of lists, lists +themselves, lists of lists and so on. If for example, a typical +element of a list is called x, then it is often useful to use the name +xs for a list of such values, suggesting that a list contains a number +of "x"s. Similarly, a list of lists might be called xss. Once you +have understood this convention it is much easier to remember the +relationship between the variables in the expression (x:xs) than it +would be if different names had been used such as (a:b).] + + + + + + + 16 + + + + +Introduction to Gofer 7.7 Strings + + +7.7 Strings +------------ +A string is treated as a list of characters and the type String is +simply an abbreviation for the type [Char]. Strings are written as +sequences of characters enclosed between speech marks. All of the +escape codes that can be used for characters may also be used in a +string: + + ? "hello, world" + hello, world + (0 reductions, 13 cells) + + ? "hello\nworld" + hello + world + (0 reductions, 12 cells) + ? + +In addition, strings may contain the escape sequence "\&" which can be +used to separate otherwise ambiguous pairs of characters within a +string: + + e.g. "\123h" represents the string ['\123', 'h'] + "\12\&3h" represents the string ['\12', '3', 'h'] + +A string expression may be spread over a number of lines using a gap -- +a non-empty sequence of space, tab and new line characters enclosed by +backslash characters: + + ? "hell\ \o" + hello + (0 reductions, 6 cells) + ? + +Notice that strings are printed differently from other values, which +gives the programmer complete control over the format of the output +produced by a program. The only values that Gofer can in fact display +on the terminal are strings. If the type of an expression entered into +Gofer is equivalent to String then the expression is printed directly +by evaluating and printing each character in the list in sequence. +Otherwise, the expression to be evaluated, e, is replaced by the +expression show' e where show' is a built-in function (defined as part +of the standard prelude) which converts any value to a printable +representation. The only way of printing a string value in the same +way as any other value is by explicitly using the show' function: + + ? show' "hello" + "hello" + (7 reductions, 24 cells) + ? + +The careful reader may have been puzzled by the fact the number of +reductions used in the first three examples above was zero. This is in +fact quite correct since these expressions are constants and no further +evaluation can be carried out. For constant expressions of any other +type there will always be at least one reduction needed to print the + + + 17 + + + + +Introduction to Gofer 7.7 Strings + + +value since the constant must first be translated to a printable +representation using the show' function. + +Because strings are represented as lists of characters, all of the +standard prelude functions for manipulating lists can also be used with +strings: + + ? length "Hello" + 5 + (22 reductions, 36 cells) + + ? "Hello, " ++ "world" + Hello, world + (8 reductions, 37 cells) + + ? concat ["super","cali","fragi","listic"] + supercalifragilistic + (29 reductions, 101 cells) + + ? map ord "Hello" + [72, 101, 108, 108, 111] + (22 reductions, 69 cells) + + ? + + +7.8 Tuples and the unit type +----------------------------- +If t1, t2, ..., tn are types and n>=2, then there is a type of n-tuples +written (t1, t2, ..., tn) whose elements are also written in the form +(x1, x2, ..., xn) where the expressions x1, x2, ..., xn have types t1, +t2, ..., tn respectively. + + e.g. (1, [2], 3) :: (Int, [Int], Int) + ('a', False) :: (Char, Bool) + ((1,2),(3,4)) :: ((Int, Int), (Int, Int)) + +Note that, unlike lists, the elements in a tuple may have different +types, although the number of elements in the tuple is fixed. + +The unit type is written () and has a single element which is also +written as (). The unit type is of particular interest in theoretical +treatments of the type system of Gofer, although you may occasionally +find a use for it in practical programs. + + + + + + + + + + + + + + + 18 + + diff --git a/docs/ch08 b/docs/ch08 new file mode 100644 index 0000000..b32f636 --- /dev/null +++ b/docs/ch08 @@ -0,0 +1,132 @@ + + +Introduction to Gofer 8. ERRORS + + +8. ERRORS + +8.1 Errors detected on input +----------------------------- +After an expression has been entered, but before any attempt is made to +evaluate it, Gofer carries out a number of checks to make sure that the +expression that you typed does not contain any errors. Here are some +examples of the kind of problem that might occur: + + o Syntax errors. The most common situation in which this happens is + when you make a typing mistake, either leaving out some + characters, or perhaps pressing the wrong keys instead. In the + following example, the user has missed out a `[' character: + + ? sum 1..100] + ERROR: Syntax error in input (unexpected `..') + ? + + o Undefined variables. This happens when you enter an expression + using a variable or function name that is not defined in any of + the files of definitions loaded into Gofer. This can often mean + that you have misspelt the name of a function, or that the files + defining a function have not yet been loaded. For example: + + ? sum [1..n] + ERROR: Undefined variable "n" + ? + + o Type errors. Certain expressions are sensible only when the + functions used in those expressions are applied to values of the + appropriate type. For example, whilst the factorial function can + be used to calculate the factorial of an integer, it is clearly + meaningless to try to determine the factorial of a character + value. This kind of problem can be detected using the types of + the components of an expression. In the expression "fact 'A'", we + can see that the argument 'A' has type Char which does not match + the argument type Int of the factorial function. This error will + be detected by Gofer if you try to evaluate the expression: + + ? fact 'A' + ERROR: Type error in application + *** expression : fact 'A' + *** term : 'A' + *** type : Char + *** does not match : Int + + ? + + +8.2 Errors during evaluation +----------------------------- +If no errors are detected in an input expression, Gofer then begins to +evaluate that expression. Despite all of the checks that are carried +out before the evaluation begins, it is still possible for an error to +occur during the evaluation of an expression. A typical example of +this is an attempt to divide a number by zero. In this case, Gofer + + + 19 + + + + +Introduction to Gofer 8.2 Errors during evaluation + + +prints the part of the expression being evaluated that caused the +error, surrounded by braces `{' and `}': + + ? 3/0 + {primDivInt 3 0} + (4 reductions, 30 cells) + ? + +[The function "primDivInt" which appears here is a primitive function +used to divide one integer (its first argument) by another (the +second)]. If an error occurs in just one part of an expression, only +the part causing the problem will be displayed: + + ? 4 + (5/0) + {primDivInt 5 0} + (5 reductions, 32 cells) + ? + +A standard function called "error" is defined in the standard prelude +which is often useful for ensuring that appropriate error messages are +produced when an error occurs: + + ? error "Problem has occurred" + {error "Problem has occurred"} + (23 reductions, 99 cells) + ? + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 20 + + diff --git a/docs/ch09 b/docs/ch09 new file mode 100644 index 0000000..781fe52 --- /dev/null +++ b/docs/ch09 @@ -0,0 +1,1056 @@ + + +Introduction to Gofer 9. MORE ABOUT VALUE DECLARATIONS + + +9. MORE ABOUT VALUE DECLARATIONS + +9.1 Simple pattern matching +---------------------------- +Although the Gofer standard prelude includes many useful functions, you +will usually need to define a collection of new functions for specific +problems and calculations. The declaration of a function "f" usually +takes the form of a number of equations of the form: + + f ... = + +(or an equivalent expression, if "f" is written as by an operator +symbol). Each of the expressions , , ..., +represents an argument to the function "f" and is called a `pattern'. +The number of such arguments is called the arity of "f". If "f" is +defined by more than one equation then they must be entered together +and each one must give the same arity for "f". + +When a function is defined by more than one equation, it will usually +be necessary to evaluate one or more of the arguments to the function +to determine which equation applies. This process is called +`pattern-matching'. In all of the previous examples we have used only +the simplest kind of pattern -- a variable. As an example, consider +the factorial function defined in section 5: + + fact n = product [1..n] + +If we then wish to evaluate the expression "fact 6" we first match the +expression "6" against the pattern "n" and then evaluate the expression +obtained from "product [1..n]" by replacing the variable "n" with the +expression "6". The process of matching the arguments of a function +against the patterns in its definition and obtaining another expression +to be evaluated is called a `reduction'. Using Gofer, it is easy to +verify that the evaluation of "fact 6" takes one more reduction than +that of "product [1..6]": + + ? fact 6 + 720 + (57 reductions, 85 cells) + ? product [1..6] + 720 + (56 reductions, 85 cells) + ? + +Many kinds of constants such as the boolean values True and False can +also be used in patterns, as in the following definition of the +function "not" taken from the standard prelude: + + not True = False + not False = True + +In order to determine the value of an expression of the form "not b", +we must first evaluate the expression "b". If the result is "True" +then we use the first equation and the value of "not b" will be +"False". If the value of "b" is "False", then the second equation is +used and the value of "not b" will be "True". + + + 21 + + + + +Introduction to Gofer 9.1 Simple pattern matching + + +Other constants, including integers, characters and strings may also be +used in patterns. For example, if we define a function "hello" by: + + hello "Mark" = "Howdy" + hello name = "Hello " ++ name ++ ", nice to meet you!" + +then: + + ? hello "Mark" + Howdy + (1 reduction, 12 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? + +Note that the order in which the equations are written is very +important because Gofer always uses the first applicable equation. If +instead we had defined the function with the equations: + + hello name = "Hello " ++ name ++ ", nice to meet you!" + hello "Mark" = "Howdy" + +then the results obtained using this function would have been a little +different: + + ? hello "Mark" + Hello Mark, nice to meet you! + (13 reductions, 66 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? + +There are a number of other useful kinds of pattern, some of which are +illustrated by the following examples: + + o Wildcard: _ matches any value at all; it is like a + variable pattern, except that there is no + way of referring to the matched value. + + o Tuples: (x,y) matches a pair whose first and second + elements are called x and y respectively. + + o Lists: [x] matches a list with precisely one element + called x. + [_,2,_] matches a list with precisely three + elements, the second of which is the + integer 2. + [] matches the empty list. + (x:xs) matches a non-empty list with head x and + tail xs. + + o As patterns: p@(x,y) matches a pair whose first and second + components are called x and y. The + complete pair can also be referred to + + + 22 + + + + +Introduction to Gofer 9.1 Simple pattern matching + + + directly as p. + + o (n+k) patterns: (m+1) matches an integer value greater than or + equal to 1. The value referred to by the + variable m is one less than the value + matched. + +A further kind of pattern (called an irrefutable pattern) is introduced +in section 9.11. + +Note that no variable name can be used more than once on the left hand +side of each equation in a function definition. The following example: + + areTheyTheSame x x = True + areTheyTheSame _ _ = False + +will not be accepted by the Gofer system, but should instead be defined +using the notation of guards introduced in the next section: + + areTheyTheSame x y + | x==y = True + | otherwise = False + + +9.2 Guarded equations +---------------------- +Each of the equations in a function definition may contain `guards' +which require certain conditions on the values of the function's +arguments to be met. As an example, here is a function which uses the +standard prelude function even :: Int -> Bool to determine whether its +argument is an even integer or not, and returns the string "even" or +"odd" as appropriate: + + oddity n | even n = "even" + | otherwise = "odd" + +In general, an equation using guards takes the form: + + f x1 x2 ... xn | condition1 = e1 + | condition2 = e2 + . + . + | conditionm = em + +This equation is used by evaluating each of the conditions in turn +until one of them evaluates to "True", in which case the value of the +function is given by the corresponding expression e on the right hand +side of the `=' sign. In Gofer, the variable "otherwise" is defined to +be equal to "True", so that writing "otherwise" as the condition in a +guard means that the corresponding expression will always be used if no +previous guard has been satisfied. + +[ASIDE: in the notation of [1], the above examples would be written as: + + oddity n = "even", if even n + = "odd", otherwise + + + 23 + + + + +Introduction to Gofer 9.2 Guarded equations + + + f x1 x2 ... xn = e1, if condition1 + = e2, if condition2 + . + . + = em, if conditionm + +Translation between the two notations is relatively straightforward.] + + +9.3 Local definitions +---------------------- +Function definitions may include local definitions for variables which +can be used both in guards and on the right hand side of an equation. +Consider the following function which calculates the number of distinct +real roots for a quadratic equation of the form a*x*x + b*x + c = 0: + + numberOfRoots a b c | discr>0 = 2 + | discr==0 = 1 + | discr<0 = 0 + where discr = b*b - 4*a*c + +[ASIDE: The operator (==) is used to test whether two values are equal +or not. You should take care not to confuse this with the single `=' +sign used in function definitions]. + +Local definitions can also be introduced at an arbitrary point in an +expression using an expression of the form: + + let in + +For example: + + ? let x = 1 + 4 in x*x + 3*x + 1 + 41 + (8 reductions, 15 cells) + ? let p x = x*x + 3*x + 1 in p (1 + 4) + 41 + (7 reductions, 15 cells) + ? + + +9.4 Recursion with integers +---------------------------- +Recursion is a particularly important and powerful technique in +functional programming which is useful for defining functions involving +a wide range of datatypes. In this section, we describe one particular +application of recursion to give an alternative definition for the +factorial function from section 5. + +Suppose that we wish to calculate the factorial of a given integer n. +We can split the problem up into two special cases: + + o If n is zero then the value of n! is 1. + + o Otherwise, n! = 1 * 2 * ... * (n-1) * n = (n-1)! * n and so we + can calculate the value of n! by calculating the value of (n-1)! + + + 24 + + + + +Introduction to Gofer 9.4 Recursion with integers + + + and then multiplying it by n. + +This process can be expressed directly in Gofer using a conditional +expression: + + fact1 n = if n==0 then 1 else n * fact1 (n-1) + +This definition may seem rather circular; in order to calculate the +value of n!, we must first calculate (n-1)!, and unless n is 1, this +requires the calculation of (n-2)! etc... However, if we start with +some positive value for the variable n, then we will eventually reach +the case where the value of 0! is required -- and this does not require +any further calculation. The following diagram illustrates how 6! is +evaluated using "fact1": + + fact1 6 ==> 6 * fact1 5 + ==> 6 * (5 * fact1 4) + ==> 6 * (5 * (4 * fact1 3)) + ==> 6 * (5 * (4 * (3 * fact1 2))) + ==> 6 * (5 * (4 * (3 * (2 * fact1 1)))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * fact1 0))))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * 1))))) + ==> 6 * (5 * (4 * (3 * (2 * 1)))) + ==> 6 * (5 * (4 * (3 * 2))) + ==> 6 * (5 * (4 * 6)) + ==> 6 * (5 * 24) + ==> 6 * 120 + ==> 720 + +Incidentally, there are several other ways of writing the recursive +definition of "fact1" above in Gofer. For example, using guards: + + fact2 n + | n==0 = 1 + | otherwise = n * fact2 (n-1) + +or using pattern matching with an integer constant: + + fact3 0 = 1 + fact3 n = n * fact3 (n-1) + +Which of these you use is largely a matter of personal taste. + +Yet another style of definition uses the (n+k) patterns mentioned in +section 9.1: + + fact4 0 = 1 + fact4 (n+1) = (n+1) * fact4 n + +which is equivalent to: + + fact5 n | n==0 = 1 + | n>=1 = n * fact5 (n-1) + +[COMMENT: Although each of the above definitions gives the same result +as the original "fact" function for each non-negative integer, the + + + 25 + + + + +Introduction to Gofer 9.4 Recursion with integers + + +functions can still be distinguished by the values obtained when they +are applied to negative integers: + + o "fact (-1)" evaluates to the integer 1. + o "fact1 (-1)" causes Gofer to enter an infinite loop, which is only + eventually terminated when Gofer runs out of `stack space'. + o "fact4 (-1)" causes an evaluation error and prints the + message {fact4 (-1)} on the screen. + +To most people, this suggests that the definition of "fact4" is perhaps +preferable to that of either "fact" or "fact1" as it neither gives the +wrong answer without allowing this to be detected nor causes a +potentially non-terminating computation.] + + +9.5 Recursion with lists +------------------------- +The same kind of technique that can be used to define recursive +functions with integers can also be used to define recursive functions +on lists. As an example, suppose that we wish to define a function to +calculate the length of a list. As the standard prelude already +includes such a function called "length", we will call the function +developed here "len" to avoid any conflict. Now suppose that we wish +to find the length of a given list. There are two cases to consider: + + o If the list is empty then it has length 0 + + o Otherwise, it is non-empty and can be written in the form (x:xs) + for some element x and some list xs. Thus the original list is + one element longer than xs, and so has length 1 + len xs. + +Writing these two cases out leads directly to the following definition: + + len [] = 0 + len (x:xs) = 1 + len xs + +The following diagram illustrates the way that this function can be +used to determine the length of the list [1,2,3,4] (remember that this +is just an abbreviation for 1 : 2 : 3 : 4 : []): + + len [1,2,3,4] ==> 1 + len [2,3,4] + ==> 1 + (1 + len [3,4]) + ==> 1 + (1 + (1 + len [4])) + ==> 1 + (1 + (1 + (1 + len []))) + ==> 1 + (1 + (1 + (1 + 0))) + ==> 1 + (1 + (1 + 1)) + ==> 1 + (1 + 2) + ==> 1 + 3 + ==> 4 + +As further examples, you might like to look at the following +definitions which use similar ideas to define the functions product and +map introduced in earlier sections: + + product [] = 1 + product (x:xs) = x * product xs + + + 26 + + + + +Introduction to Gofer 9.5 Recursion with lists + + + map f [] = [] + map f (x:xs) = f x : map f xs + + +9.6 Lazy evaluation +-------------------- +Gofer evaluates expressions using a technique sometimes described as +`lazy evaluation' which means that: + + o No expression is evaluated until its value is needed. + + o No shared expression is evaluated more than once; if the + expression is ever evaluated then the result is shared between all + those places in which it is used. + +The first of these ideas is illustrated by the following function: + + ignoreArgument x = "I didn't need to evaluate x" + +Since the result of the function "ignoreArgument" doesn't depend on the +value of its argument "x", that argument will not be evaluated: + + ? ignoreArgument (1/0) + I didn't need to evaluate x + (1 reduction, 31 cells) + ? + +In some situations, it is useful to be able to force Gofer to evaluate +the argument to a function before the function is applied. This can be +achieved using the function "strict" defined in the standard prelude; +An expression of the form "strict f x" is evaluated by first evaluating +the argument "x" and then applying the function "f" to the result: + + ? strict ignoreArgument (1/0) + {primDivInt 1 0} + (4 reductions, 29 cells) + ? + +The second basic idea behind lazy evaluation is that no shared +expression should be evaluated more than once. For example, the +following two expressions can be used to calculate 3*3*3*3: + + ? square * square where square = 3 * 3 + 81 + (3 reductions, 9 cells) + ? (3 * 3) * (3 * 3) + 81 + (4 reductions, 11 cells) + ? + +Notice that the first expression requires one less reduction than the +second. Excluding the single reduction step needed to convert each +integer into a string, the sequences of reductions that will be used in +each case are as follows: + + + + + 27 + + + + +Introduction to Gofer 9.6 Lazy evaluation + + + square * square where square = 3 * 3 + -- calculate the value of square by reducing 3 * 3 ==> 9 + -- and replace each occurrence of square with this result + ==> 9 * 9 + ==> 81 + + (3 * 3) * (3 * 3) -- evaluate first (3 * 3) + ==> 9 * (3 * 3) -- evaluate second (3 * 3) + ==> 9 * 9 + ==> + +Lazy evaluation is a very powerful feature of programming in a language +like Gofer, and means that only the minimum amount of calculation is +used to determine the result of an expression. The following example +is often used to illustrate this point. + +Consider the task of finding the smallest element of a list of +integers. The standard prelude includes a function "minimum" which can +be used for this very purpose: + + ? minimum [100,99..1] + 1 + (809 reductions, 1322 cells) + ? + +(The expression [100,99..1] denotes the list of integers from 1 to 100 +arranged in decreasing order, as described in section 10.1). + +A rather different approach involves sorting the elements of the list +into increasing order (using the function "sort" defined in the +standard prelude) and then take the element at the head of the +resulting list (using the standard function "head"). Of course, +sorting the list in its entirety is likely to require significantly +more work than the previous approach: + + ? sort [100,99..1] + [1, 2, 3, 4, 5, 6, 7, 8, ... etc ..., 99, 100] + (10712 reductions, 21519 cells) + ? + +However, thanks to lazy-evaluation, calculating just the first element +of the sorted list actually requires less work in this particular case +than the first solution using "minimum": + + ? head (sort [100,99..1]) + 1 + (713 reductions, 1227 cells) + ? + +Incidentally, it is probably worth pointing out that this example +depends rather heavily on the particular algorithm used to "sort" a +list of elements. The results are rather different if we compare the +same two approaches used to calculate the maximum value in the list: + + ? maximum [100,99..1] + 100 + + + 28 + + + + +Introduction to Gofer 9.6 Lazy evaluation + + + (812 reductions, 1225 cells) + ? last (sort [100,99..1]) + 100 + (10612 reductions, 20732 cells) + ? + +This difference is caused by the fact that each element in the list +produced by "sort" is only known once the values of all of the +preceding elements are also known. Thus the complete list must be +sorted in order to obtain the last element. + + +9.7 Infinite data structures +----------------------------- +One particular benefit of lazy evaluation is that it makes it possible +for functions in Gofer to manipulate `infinite' data structures. +Obviously we cannot hope either to construct or store an infinite +object in its entirety -- the advantage of lazy evaluation is that it +allows us to construct infinite objects piece by piece as necessary +(and to reuse the storage space used by parts of the object when they +are no longer required). + +As a simple example, consider the following function which can be used +to produce infinite lists of integer values: + + countFrom n = n : countFrom (n+1) + +If we evaluate the expression "countFrom 1", Gofer just prints the list +of integer values beginning with 1 until it is interrupted. Once each +element in the list has been printed, the storage used to hold that +element can be reused to hold later elements in the list. Evaluating +this expression is equivalent to using an `infinite' loop to print the +list of integers in an imperative programming language: + + ? countFrom 1 + [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,^C{Interrupted!} + (53 reductions, 160 cells) + ? + +For practical applications, we are usually only interested in using a +finite portion of an infinite data structure (just as loops in an +imperative programming language are usually terminated after finitely +many iterations). For example, using "countFrom" together with the +function "take" defined in the standard prelude, we can repeat the +calculation from section 4 to find the sum of the integers 1 to 10: + + ? sum (take 10 (countFrom 1)) + 55 + (62 reductions, 119 cells) + ? + +[ASIDE: The expression "take n xs" evaluates to a list containing the +first n elements of the list xs (or to xs itself if the list contains +fewer than n elements). Thus "countFrom 1" generates the infinite list +of integers, "take 10" ensures that only the first ten elements are +calculated, and "sum" calculates the sum of those integers as before.] + + + 29 + + + + +Introduction to Gofer 9.7 Infinite data structures + + +A particular advantage of using infinite data structures is that it +enables us to describe an object without being tied to one particular +application of that object. Consider the following definition for the +infinite list of powers of two [1, 2, 4, 8, ...]: + + powersOfTwo = 1 : map double powersOfTwo + where double n = 2*n + +This list be used in a variety of ways; using the operator (!!) defined +in the standard prelude [xs!!n evaluates to the nth element of the list +xs], we can define a function to find the nth power of 2 for any given +integer n: + + twoToThe n = powersOfTwo !! n + +Alternatively, we can use the list "powersOfTwo" to define a function +mapping lists of bits (represented by integers 0 and 1) to the +corresponding decimal number: simply reverse the order of the digits, +multiply each by the corresponding power of two and calculate the sum. +Using functions from the standard prelude, this translates directly +into the definition: + + binToDec ds = sum (zipWith (*) (reverse ds) powersOfTwo) + +For example: + + ? twoToThe 12 + 4096 + (15 reductions, 21 cells) + ? binToDec [1,0,1,1,0] + 22 + (40 reductions, 85 cells) + ? + +9.8 Polymorphism +----------------- +Given the definition of "product" in section 9.5, it is easy to see +that product takes a single argument which is a list of integers and +returns a single integer value -- the product of the elements of the +list. In other words, "product" has type [Int] -> Int. On the other +hand, it is not immediately clear what the type of the function "map" +should be. Clearly the first argument of "map" must be a function and +both the second argument and the result are lists, so that the type of +"map" must be of the form: + + (a -> b) -> [c] -> [d] + \______/ \___/ \___/ + type of 1st type of 2nd type of result + argument "f" argument "xs" "map f xs" + +But what can be said about the types a, b, c and d? One possibility +would be to choose a = b = c = d = Int which would be acceptable for +expressions such as "map fact [1,2,3,4]", but this would not be +suitable in an expression such as "map chr [65,75,32]" because the +"chr" function does not have type Int -> Int. + + + + 30 + + + + +Introduction to Gofer 9.8 Polymorphism + + +Notice however that the argument type of "f" must be the same as the +type of elements in the second argument (i.e. a = c) since "f" is +applied to each element in that list. Similarly, the result type of +"f" must be the same as the type of elements in the result list (i.e. b += d) since each element in this list is obtained as a result of +applying the function "f" to some value. It is therefore reasonable to +treat the "map" function as having any type of the form: + + (a -> b) -> [a] -> [b] + +The letters "a" and "b" used in this type expression represent +arbitrary types and are called type variables. An object whose type +includes one or more type variables can be thought of as having many +different types and is often described as having a `polymorphic type' +(literally: its type has `many shapes'). + +The ability to define and use polymorphic functions in Gofer turns out +to be very useful. Here are the types of some of the other polymorphic +functions which have been used in previous examples which illustrate +this point: + + length :: [a] -> Int + (++) :: [a] -> [a] -> [a] + concat :: [[a]] -> [a] + +Thus we can use precisely the same "length" function to determine both +the length of a list of integers as well as finding the length of a +string: + + ? length [1..10] + 10 + (98 reductions, 138 cells) + ? length "Hello" + 5 + (22 reductions, 36 cells) + ? + + +9.9 Higher-order functions +--------------------------- +In Gofer, function values are treated in much the same way as any other +kind of value; in particular, they can be used both as arguments to, +and results of other functions. + +Functions which manipulate other functions in this way are often +described as `higher-order functions'. Consider the following example, +taken from the standard prelude: + + (.) :: (b -> c) -> (a -> b) -> (a -> c) + (f . g) x = f (g x) + +As indicated by the type declaration, we think of the (.) operator as a +function taking two function arguments and returning another function +value as its result. If f and g are functions of the appropriate +types, then (f . g) is a function called the composition of f with g. +Applying (f . g) to a value is equivalent to applying g to that value, + + + 31 + + + + +Introduction to Gofer 9.9 Higher-order functions + + +and then applying f to the result [As described, far more eloquently, +by the second line of the declaration above!]. + +Many problems can often be described very elegantly as a composition of +other functions. Consider the problem of calculating the total number +of characters used in a list of strings. A simple recursive function +provides one solution: + + countChars [] = 0 + countChars (w:ws) = length w + countChars ws + + ? countChars ["super","cali","fragi","listic"] + 20 + (96 reductions, 152 cells) + ? + +An alternative approach is to notice that we can calculate the total +number of characters by first combining all of the words in the +argument list into a single word (using concat) and then finding the +length of that word: + + ? (length . concat) ["super","cali","fragi","listic"] + 20 + (113 reductions, 211 cells) + ? + +Another solution is to first find the length of each word in the list +(using the "map" function to apply "length" to each word) and then +calculate the sum of these individual lengths: + + ? (sum . map length) ["super","cali","fragi","listic"] + 20 + (105 reductions, 172 cells) + ? + + +9.10 Variable declarations +-------------------------- +A variable declaration is a special form of function definition, +almost always consisting of a single equation of the form: + + var = rhs + +(i.e. a function declaration of arity 0). Whereas the values defined +by function declarations of arity>0 are guaranteed to be functions, the +values defined by variable declarations may or may not be functions: + + odd = not . even -- if an integer is not even then it must be odd + val = sum [1..100] + +Note that variables defined like this at the top level of a file of +definitions will be evaluated using lazy evaluation. The first time we +refer to the variable "val" defined above (either directly or +indirectly), Gofer evaluates the sum of the integers from 1 to 100 and +overwrites the definition of "val" with this number. This calculation +can then be avoided for each subsequent use of "val" (unless the file + + + 32 + + + + +Introduction to Gofer 9.10 Variable declarations + + +containing the definition of "val" is reloaded). + + ? val + 5050 + (809 reductions, 1120 cells) + + ? val + 5050 + (1 reduction, 7 cells) + + ? + +Because of this behaviour, we should probably try to avoid using +variable declarations where the resulting value will require a lot of +storage space. If we load a file of definitions including the line: + + longList = [1..10000] + +and then evaluate the expression "length longList" (eventually +obtaining the expected result of 10000), then Gofer will evaluate the +definition of "longList" and replace it with the complete list of +integers from 1 upto 10000. Unlike other memory used during a +calculation, it will not be possible to reuse this space for other +calculations without reloading the file defining "longList", or loading +other files instead. + + +9.11 Pattern bindings and irrefutable patterns +---------------------------------------------- +Another useful way of defining variables uses `pattern bindings' which +are equations of the form: + + pat = rhs + +where the expression on the left hand side is a pattern as described in +section 9.1. As a simple example of pattern bindings, here is one +possible definition for the function "head" which returns the first +element in a list of values: + + head xs = x where (x:ys) = xs + +[The definition "head (x:_) = x" used in the standard prelude is +slightly more efficient, but otherwise equivalent.] + +[ASIDE: Note that pattern bindings are treated quite differently from +function bindings (of which the variable declarations described in the +last section are a special case). There are two situations in which an +ambiguity may occur; i.e. if the left hand side of an equation is a +simple variable or an (n+k) pattern of the kind described in section +9.1. In both cases, these are treated as function bindings, the former +being a variable declaration whilst the latter will be treated as a +definition for the operator symbol (+).] + +Pattern bindings are often useful for defining functions which we might +think of as `returning more than one value' -- although they are +actually packaged up in a single value such as a tuple. As an example, + + + 33 + + + + +Introduction to Gofer 9.11 Pattern bindings and irrefutable patterns + + +consider the function "span" defined in the standard prelude. + + span :: (a -> Bool) -> [a] -> ([a],[a]) + +If xs is a list of values and p is a predicate, then span p xs returns +the pair of lists (ys,zs) such that ys++zs == xs, all of the elements +in ys satisfy the predicate p and the first element of zs does not +satisfy p. A suitable definition, using a pattern binding to obtain +the two lists resulting from the recursive call to "span" is as +follows: + + span p [] = ([],[]) + span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) + + +For consistency with the lazy evaluation strategy used in Gofer, the +right hand side of a pattern binding is not evaluated until the value +of one of the variables bound by that pattern is required. The +definition: + + (0:xs) = [1,2,3] + +will not cause any errors when it is loaded into Gofer, but will cause +an error if we attempt to evaluate the variable xs: + + ? xs + {v120 [1, 2, 3]} + (11 reductions, 46 cells) + ? + +The variable name "v120" appearing in this expression is the name of a +function called a `conformality check' which is defined automatically +by Gofer to ensure that the value on the right hand side of the pattern +binding conforms with the pattern on the left. + +Compare this with the behaviour of pattern matching in function +definitions such as: + + ? example [1] where example (0:xs) = "Hello" + {v126 [1]} + (4 reductions, 22 cells) + ? + +where the equivalent of the conformality check is carried out +immediately even if none of the values of the variables in the pattern +are actually required. The reason for this difference is that the +arguments supplied to a function must be evaluated to determine which +equation in the definition of the function should be used. The error +produced by the example above was caused by the fact that the argument +[1] does not match the pattern used in the equation defining "example" +(represented by an internal Gofer function called "v126"). + +A different kind of behaviour can be obtained using a pattern of the +form ~pat, known as an irrefutable (or lazy) pattern. This pattern can + + + 34 + + + + +Introduction to Gofer 9.11 Pattern bindings and irrefutable patterns + + +initially be matched against any value, delaying the check that this +value does indeed match pat until the value of one of the variables +appearing in it is required. The basic idea (together with the method +used to implement irrefutable patterns in Gofer) is illustrated by the +identity: + + f ~pat = rhs is equivalent to f v = rhs where pat=v + +The following examples, based very closely on those given in the +Haskell report [5], illustrate the use of irrefutable patterns. The +variable "undefined" used in these examples is included in the standard +prelude and causes a run-time error each time it is evaluated +(technically speaking, it represents the bottom element of the relevant +semantic domain, and is the only value having all possible types): + + (\ (x,y) -> 0) undefined = {undefined} + (\~(x,y) -> 0) undefined = 0 + + (\ [x] -> 0) [] = {v113 []} + (\~[x] -> 0) [] = 0 + + (\~[x, (a,b)] -> x) [(0,1),undefined] = {undefined} + (\~[x,~(a,b)] -> x) [(0,1),undefined] = (0,1) + + (\ (x:xs) -> x:x:xs) undefined = {undefined} + (\~(x:xs) -> x:x:xs) undefined = {undefined}:{undefined}:{undefined} + +Irrefutable patterns are not used very frequently, although they are +particularly convenient in some situations (see section 12 for some +examples). Be careful not to use irrefutable patterns where they are +not appropriate. An attempt to define a map function "map'" using: + + map' f ~(x:xs) = f x : map' f xs + map' f [] = [] + +turns out to be equivalent to the definition: + + map' f ys = f x : map f xs where (x:xs) = ys + +and will not behave as you might have intended: + + ? map' ord "abc" + [97, 98, 99, {v124 []}, {v124 []}, {v^C{Interrupted!} + (35 reductions, 159 cells) + ? + + +9.12 Type declarations +----------------------- +The type system used in Gofer is sufficiently powerful to enable Gofer +to determine the type of any function without the need to declare the +types of its arguments and the return value as in some programming +languages. Despite this, Gofer allows the use of type declarations of +the form: + + var1, ..., varn :: type + + + 35 + + + + +Introduction to Gofer 9.12 Type declarations + + +which enable the programmer to declare the intended types of the +variables var1, ..., varn defined in either function or pattern +bindings. There are a number of benefits of including type +declarations of this kind in a program: + + o Documentation: The type of a function often provides useful + information about the way in which a function is to be used -- + including the number and order of its arguments. + + o Restriction: In some situations, the type of a function inferred + by Gofer is more general than is required. As an example, + consider the following function, intended to act as the identity + on integer values: + + idInt x = x + + Without an explicit type declaration, Gofer treats "idInt" as a + polymorphic function of type a -> a and the expression "idInt 'A'" + does not cause a type error. This problem can be solved by using + an explicit type declaration to restrict the type of "idInt" to a + particular instance of the polymorphic type a -> a: + + idInt :: Int -> Int + + Note that a declaration such as: + + idInt :: Int -> a + + is not a valid type for the function "idInt" (the value of the + expression "idInt 42" is an integer and cannot be treated as + having an arbitrary type, depending on the value of the type + variable "a"), and hence will not be accepted by Gofer. + + o Consistency check: As illustrated above, declared types are always + checked against the definition of a value to make sure that they + are compatible. Thus Gofer can be used to check that the + programmer's intentions (as described by the types assigned to + variables in type declarations) are consistent with the + definitions of those values. + + o Overloading: Explicit type declarations can be used to solve a + number of problems associated with overloaded functions and + values. See section 14 for further details. + + + + + + + + + + + + + + + + 36 + + diff --git a/docs/ch10 b/docs/ch10 new file mode 100644 index 0000000..36b0b79 --- /dev/null +++ b/docs/ch10 @@ -0,0 +1,594 @@ + + +Introduction to Gofer 10. INCREASING YOUR POWER OF EXPRESSION + + +10. INCREASING YOUR POWER OF EXPRESSION + +This section describes a number of useful extensions to the basic range +of expressions used in the previous sections. None of these add any +extra computational power to Gofer -- anything that can be done with +these constructs could also be done with the constructs already +described. They are however included in Gofer because they allow many +expressions and function definitions to be written more clearly and +concisely than the equivalent expressions without these notations. + +10.1 Arithmetic sequences +------------------------- +A number of useful lists can be generated using the notation of +arithmetic sequences (so named because of their similarity to +arithmetic progressions in mathematics). The following list summarises +the four forms of sequence expression that can be used in Gofer, +together with their translation using the standard functions enumFrom, +enumFromTo, enumFromThen and enumFromThenTo: + + [ n .. ] enumFrom n + + Produces the (potentially infinite) list of values + starting with the value of n and increasing in + single steps. + + e.g. [1..] = [1, 2, 3, 4, 5, 6, 7, 8, 9, etc... + + [ n .. m ] enumFromTo n m + + Produces the list of elements from n upto and + including m in single steps. If m is less than n + then the list is empty. + + e.g. [-3..3] = [-3, -2, -1, 0, 1, 2, 3] + [1..1] = [1] + [9..0] = [] + + [ n, m .. ] enumFromThen n m + + Produces the (potentially infinite) list of values + whose first two elements are given by the values n + and m. If m is greater than n then the following + elements of the list are increasing in steps of + the same size. A similar result is obtained if m + is less than n in which case the elements of + [n,m..] will be decreasing. If n and m are equal + then [n,m..] is an infinite list in which each + element is equal to n. + + e.g. [1,3..] = [1, 3, 5, 7, 9, 11, 13, etc... + [0,0..] = [0, 0, 0, 0, 0, 0, 0, etc... + [5,4..] = [5, 4, 3, 2, 1, 0, -1, etc... + + [ n, n' .. m ] enumFromThenTo n n' m + + Produces the list of elements from [n,n'..] upto + + + 37 + + + + +Introduction to Gofer 10.1 Arithmetic sequences + + + the limit value m. If m is less than n and + [n,n'..] is increasing, or m is greater than n and + [n,n'..] is decreasing the resulting list will be + empty. + + e.g. [1,3..12] = [1, 3, 5, 7, 9, 11] + [0,0..10] = [0, 0, 0, 0, 0, 0, 0, etc... + [5,4..1] = [5, 4, 3, 2, 1] + +In the standard prelude, the functions enumFrom, enumFromTo, +enumFromThen and enumFromThenTo are overloaded and may also be used to +enumerate lists of characters or floating point values: + + ? ['0'..'9'] ++ ['A'..'Z'] + 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ + (397 reductions, 542 cells) + + ? [1.2, 1.35 .. 2.00] + [1.2, 1.35, 1.5, 1.65, 1.8, 1.95] + (56 reductions, 133 cells) + + ? + +Arithmetic sequences such as those described above play the same role +in functional programming languages as the iterative `for' constructs +in traditional imperative languages. A good example of this is the +example in section 4 used to calculate the sum of the integers from 1 +upto 10 -- "sum [1..10]". An equivalent program in an imperative +language might look something like (especially if you think of C!): + + int i; + int total=0; + for (i=1; i<=10; i++) + total = total + i; + return total; + +The advantages of the functional notation in this case are clear: + + o It is more compact. + + o It separates the task of generating the sequence of integers + [1..10] from the task of finding their sum. + + o It does not require the declaration or use of auxiliary variables + such as "i" and "total" in the above. + + +10.2 List comprehensions +------------------------- +List comprehensions provide another very powerful and compact notation +for describing certain kinds of list expression. The basic form of a +list comprehension is: + + [ | ] + +There are three kinds of qualifier that can be used in Gofer: + + + 38 + + + + +Introduction to Gofer 10.2 List comprehensions + + + o Generators: A qualifier of the form pat<-exp is used to extract + each element that matches the pattern pat from the list exp in the + order that they elements appear in that list. A simple example of + this is the expression [x*x | x<-[1..10]] which denotes the list + of the squares of the integers between 1 and 10 inclusive and + evaluates to [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] as expected. + + Formally, we can define the meaning of a list comprehension with a + single generator by the equation: + + [ e | pat <- exp ] = loop exp + where loop [] = [] + loop (pat:xs) = e : loop xs + loop (_:xs) = loop xs + + If pat is an irrefutable pattern (for example, a variable) then + this is equivalent to: + + [ e | pat <- exp ] = map f exp + where f pat = e + + The full definition is needed for those cases where the pattern + pat may not match all of the elements in the list exp. This is + the case in expressions such as [ y | (3,y)<-[(1,2),(3,4),(5,6)] ] + which evaluates to the singleton list [4]. + + o Filters: A boolean valued expression may also be used as a + qualifier in which case it is often called a filter. We can + define the meaning of a list comprehension with a single filter by + the equation: + + [ e | condition ] = if condition then [e] else [] + + Whilst this form of list comprehension is occasionally useful as + it stands, it is more common to use filters in conjunction with + generators as described below. + + o Local definitions: A qualifier of the form pat=expr can be used to + introduce a local definition within a list comprehension. Its + meaning can be defined formally using the equation: + + [ e | pat = exp ] = [ let pat=exp in e ] + + As in the case of filters, local definitions are more commonly + used within lists of more than one qualifier as described below. + Particular care should be taken to distinguish a filter of the + form pat==expr from a local definition of the form pat=expr. + + [ASIDE: I originally suggested this form of qualifier in a message + sent to the Haskell mailing list, only to discover that a similar + (and more comprehensive) suggestion had been made by Kevin Hammond + almost a year earlier. There was a certain amount of controversy + surrounding the choice of an appropriate syntax and semantics for + the construct and consequently, this feature is not currently part + of the Haskell standard. The syntax and semantics above is + implemented by Gofer in the hope that it will give functional + + + 39 + + + + +Introduction to Gofer 10.2 List comprehensions + + + programmers an opportunity to experiment with this facility in + their own programs.] + +The real power of this notation is that it is possible to use several +qualifiers, separated by commas on the right of the vertical bar `|' +symbol in a list comprehension. Formally, if qs1 and qs2 are two such +lists of qualifiers, then we can define the meaning of multiple +qualifiers using: + + [ e | qs1, qs2 ] = concat [ [ e | qs2 ] | qs1 ] + +The following examples illustrate how this definition works in +practice: + + o Variables generated by later qualifiers vary more quickly than + those generated by earlier qualifiers: + + ? [ (x,y) | x<-[1..3], y<-[1..2] ] + [(1,1), (1,2), (2,1), (2,2), (3,1), (3,2)] + (107 reductions, 246 cells) + ? + + o Later qualifiers may use the values generated by earlier ones: + + ? [ (x,y) | x<-[1..3], y<-[1..x]] + [(1,1), (2,1), (2,2), (3,1), (3,2), (3,3)] + (107 reductions, 246 cells) + + ? [ x | x<-[1..10], even x ] + [2, 4, 6, 8, 10] + (108 reductions, 171 cells) + ? + + o Variables defined in later qualifiers hide those introduced by + earlier ones. The following expressions are valid list + comprehensions, but this style of definition in which names are + reused can result in programs which are difficult to understand, + and is not recommended: + + ? [ x | x<-[[1,2],[3,4]], x<-x ] + [1, 2, 3, 4] + (18 reductions, 53 cells) + + ? [ x | x<-[1,2], x<-[3,4] ] + [3, 4, 3, 4] + (18 reductions, 53 cells) + ? + + o Changing the order of qualifiers has a direct effect on + efficiency. The following two examples produce the same result, + but the first uses more reductions and cells because it repeats + the evaluation of "even x" for each possible value of "y". + + ? [ (x,y) | x<-[1..3], y<-[1..2], even x ] + [(2,1), (2,2)] + (110 reductions, 186 cells) + + + 40 + + + + +Introduction to Gofer 10.2 List comprehensions + + + ? [ (x,y) | x<-[1..3], even x, y<-[1..2] ] + [(2,1), (2,2)] + (62 reductions, 118 cells) + ? + + The following example illustrates a similar kind of behaviour with + local definitions; in the first case the expression "fact x" is + evaluated twice for each possible value of "x", whilst the second + expression uses a local definition to ensure that the evaluation + is not repeated: + + ? [ fact x + y | x<-[1..3], y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (246 reductions, 398 cells) + + ? [ factx + y | x<-[1..3], factx = fact x, y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (173 reductions, 294 cells) + ? + + +10.3 Lambda expressions +------------------------ +In addition to named function definitions, Gofer also allows the +definition and use of unnamed functions using a `lambda expression' of +the form: + + \ -> + +[ASIDE: This is a slight generalisation of the form of lambda +expression used in most theoretical treatments of functional +programming and dating back to the pioneering work of logicians +including Alonzo Church and Haskell Curry, from whom the programming +language takes its name. The `\' character used at the beginning of a +Gofer lambda expression has been chosen for its resemblance to the +greek letter lambda that might be used if the standard character set +were a little larger.] + +This expression denotes a function taking a number of parameters (one +for each pattern) and producing the result specified by the expression +to the right of the -> symbol. For example, (\x->x*x) represents the +function which takes a single integer argument `x' and produces the +square of that number as its result. Another example is the lambda +expression (\x y->x+y) which takes two integer arguments and outputs +their sum; this expression is in fact equivalent to the (+) operator: + + ? (\x y->x+y) 2 3 + 5 + (3 reductions, 7 cells) + ? + +A lambda expression of the form illustrated above is equivalent to the +following expression using a local definition: + + (let newName = in newName) + + + + 41 + + + + +Introduction to Gofer 10.3 Lambda expressions + + +where "newName" is a new variable name, chosen to avoid conflicts with +other variables that are already in use. This name will be printed if +you enter an expression involving a lambda expression without supplying +the full number of parameters for that function: + + ? (\x y -> x+y) 42 + v117 42 + (2 reductions, 14 cells) + ? + +Lambda expressions are particularly useful for certain styles of +functional programming; an example of this is the continuation-based +approach to I/O described in section 12. + + +10.4 Case expressions +--------------------- +A case expression can be used to evaluate an expression and, depending +on the result, return one of a number of possible values. As such, +case statements are a straightforward generalisation of conditional +expressions. Indeed, an expression of the form "if e then t else f" is +in fact equivalent to the case expression: + + case e of + True -> t + False -> f + +In general, a case expression takes the form "case exp of alts" where +exp is the expression to be evaluated and alts is a list of +alternatives, each of which is of the form: + + pat -> rhs for a simple alternative + + or: pat | condition1 -> rhs1 using guard expressions as + | condition2 -> rhs2 described in section 9.2 for + . function definitions + . + | conditionn -> rhsn + +In Gofer, a case expression of the form case e of alts is implemented +by choosing a new function name "newName" as in the previous section +and using the alternatives in alts to construct an appropriate +definition for this function (essentially by replacing each `->' symbol +with a `=' symbol). The complete case expression is then treated as +being equivalent to the expression "newName e". A simple example of +this is the "scanl" function whose definition in the standard prelude: + + scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +is equivalent to: + + scanl f q xs = q : scanl' xs + where scanl' [] = [] + scanl' (x:xs) = scanl f (f q x) xs + + + 42 + + + + +Introduction to Gofer 10.4 Case expressions + + +This latter form is precisely the definition used in [1] (but using the +name "scan" where Gofer uses "scanl"). + +Evaluating a case expression in which none of the alternatives match +the value of the discriminant results in an error such as the +following: + + ? case [1,2] of [] -> "empty list" + {v117 [1, 2]} + (6 reductions, 31 cells) + ? + +The function name "v117" which appears here is the name of the function +which is used internally by Gofer to implement the case expression +whilst the expression "[1, 2]" gives the discriminant value which could +not be matched. + +By combining case expressions with the lambda expressions introduced in +the previous section, any function declaration can be translated into a +single equation of the form = . For example, the +standard function "map" whose definition is usually written as: + + map f [] = [] + map f (x:xs) = f x : map f xs + +can also be defined by the equation: + + map = \f xs -> case xs of + [] -> [] + (y:ys) -> f y : map f ys + +This kind of translation is used in the implementation of many +functional programming languages, including Gofer. See Simon Peyton +Jones book [2] for more details of this. + + +10.5 Operator sections +---------------------- +As we have seen, most functions in Gofer taking more than one argument +are treated as a function of a single argument, whose result is a +function which can then be applied to the remaining arguments. Thus +"(+) 1" denotes the function which takes an integer argument "n" and +returns the integer value "1+n". Functions of this kind involving +operator symbols are sufficiently common that Gofer provides a special +syntax for them. Using e to denote an atomic expression and the symbol +"*" to represent an arbitrary infix operator, there are functions (e *) +and (* e), known as `sections of the operator (*)' defined by: + + (e *) x = e * x + (* e) x = x * e + +or, using lambda expressions as introduced in section 10.3: + + (e *) = \x -> e * x + (* e) = \x -> x * e + + + + 43 + + + + +Introduction to Gofer 10.5 Operator sections + + +For example: (1+) is the successor function which returns the value + of its argument plus 1, + (1.0/) is the reciprocal function, + (/2) is the halving function, + (:[]) is the function which maps any value to the + singleton list containing that element. + +In Gofer, the expressions "(e *)" and "(* e)" are actually treated as +abbreviations for "(*) e" and "flip (*) e" respectively, where "flip" +is the function defined by: + + flip :: (a -> b -> c) -> b -> a -> c + flip f x y = f y x + +There is an important special case which occurs with an expression of +the form (- e); this is interpreted as "negate e" and not as the +section which subtracts the value of "e" from its argument. The latter +function can be written as the section (+ (- e)) or as "subtract e" +where "subtract" is the function defined in the standard prelude using: + + subtract = flip (-) + + +10.6 Explicitly typed expressions +---------------------------------- +As described in section 9.12, it is often useful to be able to declare +the type of a variable defined in a function or pattern binding. For +much the same reasons, Gofer allows expressions of the form: + + :: + +so that the type of an expression can be specified explicitly. Note +that the :t command can be used to find the type of a particular +expression that is inferred by Gofer: + + ? :t \x -> [x] + \x -> [x] :: a -> [a] + + ? :t sum . map length + sum . map length :: [[a]] -> Int + + ? + +The types inferred in each case can be modified by including explicit +types in these expressions: + + ? :t (\x -> [x]) :: Char -> String + \x -> [x] :: Char -> String + + ? :t sum . map (length :: String -> Int) + sum . map length :: [String] -> Int + + ? + +Note that an error occurs if the type declared in an explicitly typed +expression is not compatible with the type inferred by Gofer: + + + 44 + + + + +Introduction to Gofer 10.6 Explicitly typed expressions + + + ? :t (\x -> [x]) :: Int -> a + ERROR: Declared type too general + *** Expression : \x -> [x] + *** Declared type : Int -> a + *** Inferred type : Int -> [Int] + + ? + +Explicitly typed expressions are most commonly used together with +overloaded functions and values as described in section 14. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 45 + + diff --git a/docs/ch11 b/docs/ch11 new file mode 100644 index 0000000..3a82929 --- /dev/null +++ b/docs/ch11 @@ -0,0 +1,198 @@ + + +Introduction to Gofer 11. USER-DEFINED DATATYPES AND TYPE SYNONYMS + + +11. USER-DEFINED DATATYPES AND TYPE SYNONYMS + +11.1 Datatype definitions +------------------------- +In addition to the wide range of built-in datatypes described in +section 7, Gofer also allows the definition of new datatypes using +declarations of the form: + + data DatatypeName a1 ... an = constr1 | ... | constrm + +where DatatypeName is the name of a new type constructor of arity n>=0, +a1, ..., an are distinct type variables representing the arguments of +DatatypeName and constr1, ..., constrm (m>=1) describe the way in which +elements of the new datatype are constructed. Each constr can take one +of two forms: + + o Name type1 ... typer where Name is a previously unused constructor + function name (i.e. an identifier beginning with a capital + letter). This declaration introduces Name as a new constructor + function of type: type1 -> ...-> typer -> DatatypeName a1 ... an. + + o type1 CONOP type2 where CONOP is a previously unused constructor + function operator (i.e. an operator symbol beginning with a + colon). This declaration introduces (CONOP) as a new constructor + function of type: type1 -> type2 -> DatatypeName a1 ... an. + +[N.B. only the type variables a1, ..., an may appear in the type +expressions in each constr in the definition of DatatypeName.] + + +As a simple example, the following definition introduces a new type Day +with elements Sun, Mon, Tue, Wed, Thu, Fri and Sat: + + data Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat + +Simple functions manipulating elements of type Day can be defined using +pattern matching: + + what_shall_I_do Sun = "relax" + what_shall_I_do Sat = "go shopping" + what_shall_I_do _ = "looks like I'll have to go to work" + +Another example uses a pair of constructors to provide a representation +for temperatures which may be given using either of the centigrade or +fahrenheit scales: + + data Temp = Centigrade Float | Fahrenheit Float + + freezing :: Temp -> Bool + freezing (Centigrade temp) = temp <= 0.0 + freezing (Fahrenheit temp) = temp <= 32.0 + +The following example uses a type variable on the left hand side of the +datatype definition to implement a Set type constructor for +representing sets using a list of values: + + + + 46 + + + + +Introduction to Gofer 11.1 Datatype definitions + + + data Set a = Set [a] + +For example, Set [1,2,3] is an element of type Set Int, representing +the set of integers {1, 2, 3} whilst Set ['a'] represents a singleton +set of type Set Char. As this example shows, it is possible to use the +same name simultaneously as both a type constructor and as a +constructor function. + +Datatype definitions may also be recursive, using the name of the +datatype being defined on the right hand side of the datatype +definition (mutually recursive datatype definitions are also +permitted). The following example is taken from the Haskell report [5] +and defines a type representing binary trees with values of a +particular type at their leaves: + + data Tree a = Lf a | Tree a :^: Tree a + +For example, (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10 has type Tree Int +and represents the binary tree: + + ,--- 12 + ,--| + | | ,--- 23 + | `--| + | `--- 13 + --| + `--- 10 + +As an example of a function defined on trees, here are two definitions +using recursion and pattern matching on tree valued expressions which +calculate the list of elements at the leaves of a tree traversing the +branches of the tree from left to right. The first definition uses a +simple definition, whilst the second uses an `accumulating parameter' +giving a more efficient algorithm: + + leaves, leaves' :: Tree a -> [a] + + leaves (Lf l) = [l] + leaves (l:^:r) = leaves l ++ leaves r + + leaves' t = leavesAcc t [] + where leavesAcc (Lf l) = (l:) + leavesAcc (l:^:r) = leavesAcc l . leavesAcc r + +Using the binary tree above as an example: + + ? leaves ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (24 reductions, 73 cells) + ? leaves' ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (20 reductions, 58 cells) + ? + + + + + + 47 + + + + +Introduction to Gofer 11.2 Type synonyms + + +11.2 Type synonyms +------------------ +Type synonyms are used to provide convenient abbreviations for type +expressions. A type synonym is introduced by a declaration of the +form: + + type Name a1 ... an = expansion + +where Name is the name of a new type constructor of arity n>=0, a1, +..., an are distinct type variables representing the arguments of Name +and expansion is a type expression. Note that the only type variables +permitted in the expansion type are those on the left hand side of the +synonym definition. Using this declaration any type expression of the +form: + + Name type1 ... typen + +is treated as an abbreviation of the type expression obtained from +expansion by replacing each of the type variables a1, ..., an with the +corresponding type type1, ..., typen. + +The most frequently used type synonym is almost certainly the String +type which is a synonym for [Char]: + + type String = [Char] + +[ASIDE: This definition is actually built in to the Gofer system, but +the effect is the same as if this declaration were included in the +standard prelude.] + +Note that the types of expressions inferred by Gofer will not usually +contain any type synonyms unless an explicit type signature is given, +either using an explicitly typed expression (section 10.6) or a type +declaration (section 9.12): + + ? :t ['c'] + ['c'] :: [Char] + ? :t ['c'] :: String + ['c'] :: String + ? + +Unlike the datatype declarations described in the previous section, +recursive (and mutually recursive) synonym declarations are not +permitted. This rules out examples such as: + + type BadSynonym = [BadSynonym] + +and ensures that the process of expanding all of the type synonyms used +in any particular type expression will always terminate. The same +property does not hold for the illegal definition above, in which any +attempt to expand the type BadSynonym would lead to the non-terminating +sequence: + + BadSynonym ==> [BadSynonym] ==> [[BadSynonym]] ==> .... + + + + + 48 + + diff --git a/docs/ch12 b/docs/ch12 new file mode 100644 index 0000000..1ea0de4 --- /dev/null +++ b/docs/ch12 @@ -0,0 +1,528 @@ + + +Introduction to Gofer 12. DIALOGUES: INPUT AND OUTPUT + + +12. DIALOGUES: INPUT AND OUTPUT + +The Gofer system implements a subset of the facilities for programs +involving I/O described in the Haskell report [5]. In particular, this +makes it possible for Gofer programs to be run interactively, and to +make limited use of text files for both reading and writing. A +significant factor in the design of the Haskell I/O facilities is that +it allows the use of such programs without loss of referential +transparency. + +12.1 Basic description +---------------------- +Programs using the I/O facilities in Gofer are modelled by functions of +type Dialogue, defined by the type synonym: + + type Dialogue = [Response] -> [Request] + +In other words, a Gofer program produces a list of output values, each +of which may be thought of as a request for some particular input or +output action, and obtains the corresponding list of operating system +responses as its input. Note that the input list of responses will be +evaluated lazily; i.e. we can ensure that we do not attempt to obtain +the response to a given request until that request has been completed. + +The current range of requests supported by Gofer is described by the +following datatype definition, taken from the standard prelude: + + data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + +Each response is an element of the type defined by the following +datatype definition, using an auxiliary datatype IOError to describe a +variety of error conditions that may occur: + + data Response = Success + | Str String + | Failure IOError + + data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +The following list describes the kind of I/O behaviour specified by +each form of Request and indicates the possible Response values that +may be obtained in each case: + + o ReadFile string: Read contents of file named by "string". + + + 49 + + + + +Introduction to Gofer 12.1 Basic description + + + Possible responses to this request are: + + o Str contents if the request is successful, where "contents" + is a string (evaluated lazily) containing the contents of the + file specified by the ReadFile request. + + o Failure (SearchError name) occurs if file "name" cannot be + accessed. + + o Failure (ReadError name) occurs if some other error occurs + whilst opening the file "name". + + o WriteFile name string: Write the given "string" to the file + "name". If the file does not already exist, it is created before + attempting to write the value to file. If the file already exists + then it will be truncated to zero length before the write begins. + No response is obtained until the string argument has been fully + evaluated and its contents written to file. Possible responses + are: + + o Success if the write to file was completed successfully. + + o Failure (WriteError msg) if an error was detected whilst + trying to perform the output. If the problem occurred whilst + attempting to open the specified file, then "msg" contains + the filename, otherwise it contains a printable + representation of the evaluation error which occurred. + + o AppendFile name string: Similar to the WriteFile request except + that the value of the given "string" is appended onto the file + "name" if that file already exists. The responses that may be + obtained from this request are the same as those for WriteFile. + + o ReadChan name: Read from the input stream "name". Note that + it is an error to attempt to read from the same channel more than + once in the same program. Possible responses are: + + o Str contents if the request is successful, where "contents" + is a string (evaluated lazily) containing the list of + characters entered on the input stream. + + o Failure (SearchError name) if the named channel cannot be + found. The only input channel known to Gofer is the standard + input channel "stdin". For convenience, the standard prelude + defines the variable stdin bound to this string. + + o Failure (ReadError name) if a ReadChan request for the named + channel has already been given by a previous request. + + o AppendChan name string: Output "string" on channel "name". No + response is obtained until the string has been fully evaluated and + written to the named channel. Possible responses are: + + o Success if the append to channel was completed successfully. + + o Failure (SearchError name) if the named channel cannot be + + + 50 + + + + +Introduction to Gofer 12.1 Basic description + + + found. The only output channels known to Gofer are "stdout", + "stderr" and "stdecho" (which is actually just another name + for "stdout" in Gofer). For convenience, the standard + prelude defines variables stdout, stderr and stdecho bound to + the corresponding string values. + + o Failure (WriteError msg) if an error is detected whilst + trying to perform the output. The string "msg" contains a + printable representation of the evaluation error which + occurred. + + o Echo status: Set the echo status on the standard input channel + stdin to the given boolean value. If the echo status is True, + then user input will be echoed onto the screen as it is typed and + the usual line editing facilities (such a backspace or delete) + provided by the host system can be used to edit the input lines as + they are entered. If the echo status is False, then individual + characters may be read from the standard input channel without any + echo or line editing features. + + Note that at most one Echo request can be used in a program, and + must precede any ReadChan request for stdin. If not set by an + explicit Echo request, the echo status defaults to True. Possible + responses are: + + o Success if the request was completed successfully. + + o Failure (OtherError msg) if the request could not be + completed either because a readChannel request for stdin has + already been processed, or because a previous Echo request + has already been given. The corresponding values of "msg" + are "stdin already in use" and "repeated Echo request" + respectively. + +A simple example of a program using these facilities to output a short +message on the standard output stream is: + + helloWorld :: Dialogue + helloWorld resps = [AppendChan stdout "hello, world"] + +Any expression entered into Gofer of type "Dialogue" will be treated as +a Gofer program using I/O and will be executed accordingly: + + ? helloWorld + hello, world + (1 reduction, 28 cells) + ? + +Notice that without the explicit type declaration, the type that would +be inferred for helloWorld would be a -> [Request], and hence +helloWorld would not be executed as a Dialogue program. This point can +be illustrated using lambda expressions: + + ? \resps -> [AppendChan stdout "hello, world"] + v128 + (1 reduction, 7 cells) + + + 51 + + + + +Introduction to Gofer 12.1 Basic description + + + ? (\resps -> [AppendChan stdout "hello, world"]) :: Dialogue + hello, world + + (1 reduction, 28 cells) + ? + +In many cases the structure of an expression is enough to fully +determine its type as Dialogue (or equivalently as [Response] -> +[Request]), in which case no explicit types are required to ensure that +the expression is treated as a Gofer program using I/O: + + ? \~[Success] -> [AppendChan stdout "hello, world"] + hello, world + (1 reduction, 29 cells) + ? + +Note the use of the irrefutable pattern ~[Success] for the lambda +expression in the last example; without this, the usual rules of +pattern matching as described in section 9 would force Gofer to try to +match the pattern [Success] against the list of responses, before the +corresponding request had been produced: + + ? \ [Success] -> [AppendChan stdout "hello, world"] + + Aborting Dialogue: + {error "Attempt to read response before request complete"} + (50 reductions, 229 cells) + ? + +The next example takes a single string as a parameter and displays the +contents of the corresponding file: + + showFile :: String -> Dialogue + showFile name ~(read:_) = [ReadFile name, AppendChan stdout result] + where result = case read of Str contents -> contents + Failure _ -> "Can't open " ++ name + +With a few modifications, we can implement a similar program which +prompts for, and reads, a filename from the standard input and then +reads and displays the contents of that file as before. This program +is based on a similar example in the Haskell report [5]: + + main ~(Success : ~(Str userInput : ~(r3 : _))) + = [ AppendChan stdout "Please type a filename: ", + ReadChan stdin, + ReadFile name, + AppendChan stdout (case r3 of Str contents -> contents + Failure _ -> "Can't open " + ++ name) + ] where (name : _) = lines userInput + + + + + + + + + 52 + + + + +Introduction to Gofer 12.2 Continuation style I/O + + +12.2 Continuation style I/O +--------------------------- +As an alternative to the `stream-based' approach to programs using the +I/O facilities in Gofer, the standard prelude defines a family of +functions which enables such programs to be written in a `continuation' +style. The basic idea is to define a function corresponding to each +different kind of request, whose parameters include the values required +to make the request together with two continuations. The continuations +are functions describing "what to do next", one of which is used if the +request is successful, the other if the request fails. + +As an example, the ReadFile request is represented by the function +"readFile" whose definition is equivalent to: + + readFile name fail succ ~(r:rs) = ReadFile name : rest rs + where rest = case r of Str s -> succ s + Failure ioerror -> fail ioerror + +The first thing to happen when a dialogue expression of the form +"readFile name fail succ" is evaluated is that the corresponding +request "ReadFile name" is added to the list of I/O requests. A new +dialogue value "rest" is chosen, depending on the response to the +ReadFile request, and the program continues by passing the remaining +part of the response list to "rest". The functions "succ" and "fail" +(called the success and failure continuations respectively) describe +the way in which the new dialogue "rest" is obtained. + +The following example (edited a little to fit within the margins of this +document) shows how the readFile function described above can be used to +print the contents of a file called "test" on the display: + + ? readFile "test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + This is a test message + + (4 reductions, 52 cells) + ? + +The success continuation "(\s resps->[AppendChan stdout s])" used here +receives the contents of the file "test" in the the parameter "s" and +uses an AppendChan request to output that string on the display. As +this example shows, the stream based approach of the previous section +can be combined with the continuation based style of I/O without any +difficulty. The failure continuation "(\ioerror resps -> [])" ignores +the error condition "ioerror" which caused the request to fail and +gives a dialogue which terminates immediately without any action. For +example, assuming that the file "Test" cannot be found: + + ? readFile "Test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + + (4 reductions, 24 cells) + ? + +In practice, it is usually a good idea to produce some kind of +diagnostic message when an error occurs: + + + 53 + + + + +Introduction to Gofer 12.2 Continuation style I/O + + + ? readFile "Test" + (\ioerror resps -> [AppendChan stdout (show' ioerror)]) + (\s resps -> [AppendChan stdout s]) + SearchError "Test" + (11 reductions, 59 cells) + ? + +In each of the examples above, the failure continuation has type +"FailCont" as defined by the following type synonym in the standard +prelude: + + type FailCont = IOError -> Dialogue + +Similarly, the success continuation, which takes a string representing +an input string and produces a new Dialogue has type "StrCont": + + type StrCont = String -> Dialogue + +A third kind of continuation is needed for those requests which return +a response of the form "Success" if successful (e.g. output +requests). In this case the continuation is simply another dialogue: + + type SuccCont = Dialogue + +The following list gives the type of each of the six functions +corresponding to the six different kinds of I/O request described in +the previous section. Full definitions for each of these functions are +given in appendix B: + + readFile :: String -> FailCont -> StrCont -> Dialogue + writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue + appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue + readChan :: String -> FailCont -> StrCont -> Dialogue + appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue + echo :: Bool -> FailCont -> SuccCont -> Dialogue + +As an illustration of the use of these functions, we show how each of +the example programs from the previous section can be rewritten using +the continuation based style of I/O, starting with the program +"helloWorld": + + helloWorld :: Dialogue + helloWorld = appendChan stdout "hello, world" abort done + +In this case, the explicit type declaration is not actually required +since the type of the expression is completely determined by the type +of "appendChan". The failure continuation "abort" is equivalent to the +function "(\ioerror resps -> [])" described above and terminates the +program if an error occurs without any further action. In a similar +way, "done" is the trivial dialogue which terminates immediately +without any action. Both of these values are defined in the standard +prelude: + + done :: Dialogue + done resps = [] + + + + 54 + + + + +Introduction to Gofer 12.2 Continuation style I/O + + + abort :: FailCont + abort ioerror = done + +Using the same approach, the "showFile" and "main" programs from the +previous section are written as: + + showFile :: String -> Dialogue + showFile name + = readFile name (\ioerror -> appendChan stdout + ("Can't open " ++ name) abort done) + (\contents-> appendChan stdout contents abort done) + + main :: Dialogue + main = appendChan stdout "Please type a filename: " abort + (readChan stdin abort + (\userInput -> let (name : _) = lines userInput in + readFile name + (\ioerror -> appendChan stdout ("Can't open " ++ name) + abort done) + (\contents -> appendChan stdout contents abort done))) + + +12.3 Interactive programs +------------------------- +One of the principal motivations for including facilities for I/O in +Gofer programs was to provide a way of using interactive programs as +described in [1]. An interactive program is represented by a function +of type String -> String mapping an input string of characters entered +at the keyboard into an output string to be displayed on the screen. + +There are two functions defined in the standard prelude which can be +used to `execute' functions of this kind as interactive programs: + + o "interact f" executes f::String->String as an interactive program + with echo on. This means that characters are read from the + keyboard a line at a time. The usual editing characters such as + backspace can be used to correct mistakes which are noticed before + the return key is pressed at the end of each line. The input + stream can be terminated by typing an end of file character at the + beginning of a line: + + ? interact (map toUpper) + This text was entered using the interact function + THIS TEXT WAS ENTERED USING THE INTERACT FUNCTION + ^Z + (874 reductions, 1037 cells) + ? + + o "run f" behaves like "interact f" except that echo is turned off. + In this case, the only way of terminating the input stream without + reaching the end of the string produced by "f" is to use the + interrupt key: + + ? run (map toUpper) + ALTHOUGH THIS IS ENTERED IN LOWER CASE, IT STILL + APPEARS IN UPPER CASE ! + + + 55 + + + + +Introduction to Gofer 12.3 Interactive programs + + + {Interrupted!} + + (1227 reductions, 1463 cells) + ? + +[ASIDE: of these two functions, only "interact" is also included in the +standard prelude for Haskell, although "run" may also be added to a +Haskell system using the definition below.] + +The definitions of "interact" and "run" provide further examples of +Gofer programs using simple I/O facilities: + + interact :: (String -> String) -> Dialogue + interact f = readChan stdin abort + (\s -> appendChan stdout (f s) abort done) + + run :: (String -> String) -> Dialogue + run f = echo False abort (interact f) + +[EXERCISE for the interested reader: construct alternative definitions +for these functions using the stream based approach from section 12.1.] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 56 + + diff --git a/docs/ch13 b/docs/ch13 new file mode 100644 index 0000000..f5c0c94 --- /dev/null +++ b/docs/ch13 @@ -0,0 +1,264 @@ + + +Introduction to Gofer 13. LAYOUT + + +13. LAYOUT + +13.1 Comments +------------- +Comments provide an informal but useful way of annotating a program +with a description of its purpose, structure and development. +Following the definition of Haskell, two styles of comment are +supported by Gofer: + + o A one line comment begins with the two characters "--" and is + terminated at the end of the same line. Note that an operator + symbol cannot begin with "--" as this will be treated as the + beginning of a comment. It is however possible to use the two + characters "--" at any other position within an operator symbol. + Thus a line such as: + + (xs ++ ys) -- xs + + includes a comment and will actually be treated as if the line had + been written: + (xs ++ ys) + + Whereas the line: + + xs >--> ys >--> zs + + does not contain any comments (although it will cause an error + unless ">-->" has been defined using an appropriate infixl or + infixr declaration). + + o A nested comment begins with the characters "{-", ends with the + characters "-}" and may span any number of lines. [N.B. the + initial "{-" string cannot overlap with the terminating "-}" + string so that the shortest possible nested comment is "{--}", and + not "{-}"]. An unterminated nested comment will be treated as an + error. + + As the name suggests, comments of this kind may be nested so that + "{- {- ... -} ... {- ... -} -}" is treated as a single comment. + This makes nested comments particularly convenient for enclosing + parts of a program which may already contain other nested + comments. + +Both kinds of comment may be used in expressions entered directly into +the Gofer system, or more usually, in files of definitions loaded into +Gofer. The two styles of comment may be mixed within the same +expression or program, remembering that the string "--" has no special +significance within a nested comment and that the strings "{-" and "-}" +have no special significance in a single line comment. Thus: + + [ 2, -- {- [ 2, {- + 3, -- -} -- -} 3, + 4 ] 4 ] + +are both equivalent to the list expression [2,3,4]. + + + + 57 + + + + +Introduction to Gofer 13.2 The layout rule + + +13.2 The layout rule +-------------------- +In a tradition dating back at least a quarter of a century to Landin's +ISWIM family of languages, most Gofer programs use indentation to +indicate the structure of a program. For example, in a definition such +as: + + f x y = g (x + w) + where g u = u + v + where v = u * u + w = 2 + y + +it is clear from the layout that the definition of w is intended to be +local to f rather than to g. Another example where layout plays an +important role is in distinguishing the two definitions: + + example x y z = a + b example x y z = a + b + where a = f x y where a = f x + b = g z y b = g z + +There are three situations in Gofer where indentation is typically used +to determine the structure of a program: + + o At the top-level of a file of definitions. + + o In a group of local declarations following either of the keywords + "let" or "where". + + o In a group of alternatives in a case expression, following the + keyword "of". + +In each case, Gofer actually expects to find a list of items enclosed +between braces `{' and `}' with individual items separated from one +another by semicolons `;'. However, if the leading brace is not found +then Gofer uses the layout rule described below to arrange for `{', `}' +and `;' tokens to be inserted into the input stream automatically +according to the indentation of each line. + +In this way, the first example above will in fact be treated as if the +user had entered: + + f x y = g (x + w) + where {g u = u + v + where {v = u * u + }; w = 2 + y + } + +or, equivalently, just: + + f x y = g (x + w) where {g u = u + v where {v = u * u}; w = 2 + y} + +where the additional punctuation using the `{', `}' and `;' characters +makes the intended grouping clear, regardless of indentation. + + + + + + 58 + + + + +Introduction to Gofer 13.2 The layout rule + + +The layout rule used in Gofer is the same as that of Haskell, and can +be described as follows: + + o An opening brace `{' is inserted in front of the first token at + the beginning of a file or following one of the keywords "where", + "let" or "of", unless that token is itself an opening brace. + + o A `;' token is inserted in front of the first token in any + subsequent line with exactly the same indentation as the token in + front of which the opening brace was inserted. + + o The layout rule ends and a `}' token is inserted in front of the + first token in a subsequent line whose indentation is strictly + less than that of the token in front of which the opening brace + was inserted. + + o A closing brace `}' will also be inserted at any point where an + otherwise unexpected token is encountered. This part of the rule + makes it possible to use expressions such as: + + let a = fact 12 in a+a + + without needing to use the layout characters explicitly as in: + + let {a = fact 12} in a+a. + + o Lines containing only whitespace (blanks and tabs) and comments do + not affect the use of the layout rule. + + o For the purposes of determining the indentation of each line in a + file, tab stops are assumed to be placed every 8 characters, with + the leftmost tab stop in column 9. Each tab character inserts one + or more spaces as necessary to move to the next tab stop. + + o The indentation of the end of file token is zero. + +The following (rather contrived) program, is based on an example in the +Haskell report [5], and provides an extended example of the use of the +layout rule. A file containing the following definitions: + + data Stack a = Empty + | MkStack a (Stack a) + + push :: a -> Stack a -> Stack a + push x s = MkStack x s + + size :: Stack a -> Int + size s = length (stkToList s) where + stkToList Empty = [] + stkToList (MkStack x s) = x:xs where xs = stkToList s + + pop :: Stack a -> (a, Stack a) + pop (MkStack x s) = (x, case s of r -> i r where i x = x) + + top :: Stack a -> a + top (MkStack x s) = x + + + 59 + + + + +Introduction to Gofer 13.2 The layout rule + + +will be treated by Gofer as if it has been written: + + {data Stack a = Empty + | MkStack a (Stack a) + + ;push :: a -> Stack a -> Stack a + ;push x s = MkStack x s + + ;size :: Stack a -> Int + ;size s = length (stkToList s) where + {stkToList Empty = [] + ;stkToList (MkStack x s) = x:xs where {xs = stkToList s + + }};pop :: Stack a -> (a, Stack a) + ;pop (MkStack x s) = (x, case s of {r -> i r where {i x = x}}) + + ;top :: Stack a -> a + ;top (MkStack x s) = x + } + +Note that some of the more sophisticated forms of expression cannot be +written on a single line (and hence entered directly into the Gofer +system) without explicit use of the layout characters `{', `}' and `;': + + ? len [1..10] where len [] = 0; len (x:xs) = 1 + len xs + 10 + (81 reductions, 108 cells) + + ? f True where f x = case x of True->n where {n=not x}; False->True + False + (4 reductions, 11 cells) + + ? + +One situation in which the layout rule can cause problems is with +top-level definitions. For example, the two lines: + + f x = 1 + x + g y = 1 - y + +will be treated as a single line "f x = 1 + x g y = 1 - y", which will +cause a syntax error. This kind of problem becomes rather more +difficult to spot if the two definitions are not on subsequent lines, +particularly if they are separated by several lines of comments. For +this reason, it is usually a good idea to ensure that all of the +top-level definitions in a file start in the same column (the first +column is usually the most convenient). COBOL and Fortran programmers +are not likely to find this problem too distressing :-) + + + + + + + + + + + 60 + + diff --git a/docs/ch14 b/docs/ch14 new file mode 100644 index 0000000..8935193 --- /dev/null +++ b/docs/ch14 @@ -0,0 +1,2112 @@ + + +Introduction to Gofer 14. OVERLOADING IN GOFER + + +14. OVERLOADING IN GOFER + +One of the biggest differences between Gofer and most other programming +languages (with the exception of Haskell) is the approach to +overloading; enabling the definition and use of functions in which the +meaning of a function symbol may depend on the types of its arguments. + +Like Haskell, overloading in Gofer is based around a system of type +classes which allow overloaded functions to be grouped together into +related groups of functions. Whilst the precise details of the +approach to type classes used by Gofer are quite different from those +of Haskell, both rely on the same basic ideas and use a similar syntax +for defining and using type classes. It would therefore seem possible +that experience gained with the overloading system in one language can +readily by applied to the other. + +The differences embodied in the Gofer system of classes stem from my +own, theoretically based investigations into `qualified types' some of +which is detailed in references [8-12]. In my personal opinion, the +Gofer system has some significant advantages over the Haskell approach +(see [12] for details) and one of the principal motivations behind the +implementation to Gofer was to provide a way of testing such claims. +One fact which I believe has already been established using Gofer is +that the use and implementation of overloaded functions need not have +the significant effect on performance that was anticipated with early +implementations of Haskell. + +This section outlines the system of type classes used in Gofer, +indicating briefly how they can be used and how they are implemented. + + +14.1 Type classes and predicates +-------------------------------- +A type class can be thought of as a family of types (or more generally +as a family of tuples of types) whose elements are called instances of +the class. If C is the name of an n-parameter type class then an +expression of the form C t1 t2 ... tn where t1, t2, ..., tn are type +expressions is called a predicate and represents the assertion that the +specified tuple of types is an instance of the class C. + +Given a polymorphic function (e.g. map::(a->b)->[a]->[b]), we are free +to use the function at any type which can be obtained by substituting +arbitrary types for each of the type variables in its type. In Gofer, +a type expression may be qualified by one or more predicates which +restrict the range of types at which a value can be used: + +e.g. a function of type C a => a -> a -> a can be treated as a function + of type t -> t -> t for any instance t of the class C. + +The predicate C a in the type expression in the previous example is +called the context of the type. Contexts may contain more than one +predicate in which case the predicates involved must be separated by +commas and the context enclosed in parentheses as in (C a, D b). The +empty context is written () and any type expression t is equivalent to +the qualified type () => t. For uniformity, a context with only one +element may also be enclosed by parentheses. + + + 61 + + + + +Introduction to Gofer 14.1 Type classes and predicates + + +For technical reasons, type synonyms are not currently permitted in +predicates. This is consistent with the use of predicates in Haskell, +but may be relaxed, at least in certain cases, in later versions of +Gofer. + + +14.2 The type class Eq +---------------------- +The type class Eq is a simple and useful example, whose instances are +precisely those types whose elements can be tested for equality. The +declaration of this class given in the standard prelude is as follows: + + class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +There are three parts in any class declaration. For this particular +example we have: + + o The first line (called the `header') of the declaration introduces + a name Eq for the class and indicates that it has a single + parameter, represented by the type variable a. + + o The second line of the declaration (the `signature part') + indicates that there are functions denoted by the operator symbols + (==) and (/=) of type a -> a -> Bool for each instance a of class + Eq. Using the notation introduced in the previous section, both + of these operators have type: + + Eq a => a -> a -> Bool + + These functions are called the `members' (or `member functions') + of the class. [This terminology, taken from Haskell, is rather + unfortunate; thinking of a type class as a set of types, the + elements of the class are called `instances', whilst the `members' + of the class correspond more closely to the instance variables + that are used in the terminology of object-oriented programming.] + + The intention is that the (==) function will be used to implement + an equality test for each instance of the class, with the (/=) + operator providing the corresponding inequality function. The + ability to include related groups of functions within a single + type class in this way is a useful tool in program design. + + o The third line of the class declaration (the `default + definitions') provides a default definition of the (/=) operator + in terms of the (==) operator. Thus it is only necessary to give + a definition for the (==) operator in order to define all of the + member functions for the class Eq. It is possible to override + default member definitions by giving an alternative definition as + appropriate for specific instances of the class. + + + + + + + + 62 + + + + +Introduction to Gofer 14.2.1 Implicit overloading + + +14.2.1 Implicit overloading +--------------------------- +Member functions are clearly marked as overloaded functions by their +definition as part of a class declaration, but this is not the only way +in which overloaded functions occur in Gofer; the restriction to +particular instances of a type class is also carried over into the type +of any function defined either directly or indirectly in terms of the +member functions of that class. For example, the types inferred for +the following two functions: + + x `elem` xs = any (x==) xs + xs `subset` ys = all (`elem` ys) xs + +are: + + elem :: Eq a => a -> [a] -> Bool + subset :: Eq a => [a] -> [a] -> Bool + +[ASIDE: On the other hand, if none of the functions used in a +particular expression or definition are overloaded then there will not +be any overloading in the corresponding value. Gofer does not support +the concept of implicit overloading used in some languages where a +value of a particular type might automatically be coerced to a value of +some supertype. An example of this would be the automatic translation +of a badly typed expression "1.0 == 1" to a well-typed expression of +the form "1.0 == float 1" for some (potentially overloaded) coercion +function "float" mapping numeric values to elements of type Float.] + +Note also that the types appearing in the context of a qualified type +reflect the types at which overloaded functions are used. Thus: + + f x ys = [x] == ys + +has type Eq [a] => a -> [a] -> Bool, and not Eq a => a -> [a] -> Bool, +which is the type that would be assigned to "f" in a Haskell system. + + +14.2.2 Instances of class Eq +---------------------------- +Instances of a type class are defined using declarations similar to +those used to define the corresponding type class. The following +examples, taken from the standard prelude, give the definitions for a +number of simple instances of the class Eq: + + instance Eq Int where (==) = primEqInt + + instance Eq Bool where + True == True = True + False == False = True + _ == _ = False + + instance Eq Char where c == d = ord c == ord d + + instance (Eq a, Eq b) => Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + + + + 63 + + + + +Introduction to Gofer 14.2.2 Instances of class Eq + + + instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +The interpretation of these declarations is as follows: + + o The first declaration makes Int an instance of class Eq. The + function "primEqInt" is a primitive Gofer function which tests the + equality of two integer values and has type Int -> Int -> Bool. + + o The second declaration makes Bool an instance of class Eq with a + simple definition involving pattern matching. + + o The third declaration makes Char an instance of class Eq. This + definition indicates that a pair of characters are equal if they + have the same ASCII value, which is obtained using the "ord" + function. Note that the two occurrences of the symbol (==) in the + equation: + + c == d = ord c == ord d + + have different meanings; the first denotes equality between + characters (elements of type Char), whilst the second denotes + equality between integers (elements of type Int). + + o The fourth declaration provides an equality operation on pairs. + Given two elements (x,y) and (u,v) of type (a,b) for some a, b, it + must be possible to check that both x==u and y==v before we can be + sure that the two pairs are indeed equal. In other words, both a + and b must also be instances of Eq in order to make (a,b) an + instance of Eq. This requirement is described by the first line + in the instance declaration using the expression: + + (Eq a, Eq b) => Eq (a,b) + + o The fifth declaration makes [a] an instance of Eq, whenever a is + itself an instance of Eq in a similar way to the previous + example. The context Eq a is used in the last equation in the + declaration: + + (x:xs) == (y:ys) = x==y && xs==ys + + which contains three occurrences of the (==) operator; the first + and third are used to compare lists of type [a], whilst the second + is used to compare elements of type a, using the instance Eq a. + +Combining these five declarations, we obtain definitions for (==) on an +infinite family of types including Int, Char, Bool, (Int,Bool), +(Char,Int), [Char], (Bool,[Int]), [(Bool,Int)], etc...: + + ? 2 == 3 -- using Eq Int + False + (2 reductions, 10 cells) + ? (["Hello"],3) == (["Hello"],3) -- using Eq ([[Char]],Int) + + + 64 + + + + +Introduction to Gofer 14.2.2 Instances of class Eq + + + True + (31 reductions, 65 cells) + ? + +On the other hand, any attempt to use (==) to compare elements of some +type not covered by a suitable instance declaration will result in an +error. For example, the standard prelude does not define the equality +operation on triples of values: + + ? (1,2,3) == (1,2,3) + ERROR: Cannot derive instance in expression + *** Expression : (==) d125 (1,2,3) (1,2,3) + *** Required instance : Eq (Int,Int,Int) + ? + +This can be solved by including an instance declaration of the +following form into a file of definitions loaded into Gofer: + + instance (Eq a, Eq b, Eq c) => Eq (a,b,c) where + (x,y,z) == (u,v,w) = x==u && y==v && z==w + +Giving: + + ? (1,2,3) == (1,2,3) + True + (6 reductions, 20 cells) + ? + +In general, an instance declaration has the form: + + instance context => predicate where + definitions of member functions + +The context part of the declaration gives a list of predicates which +must be satisfied for the predicate on the right hand side of the `=>' +sign to be valid. Constant predicates (i.e. predicates not involving +any type variables) required by an instance declaration (such as the +predicate Eq Int required by the third declaration) need not be +included in the context. If the resulting context is empty (as in the +first three declarations above) then it may be omitted, together with +the corresponding `=>' symbol. + + +14.2.3 Testing equality of represented values +--------------------------------------------- +Instances of Eq can also be defined for other types, including +user-defined datatypes, and unlike the instances described above, the +definition of (==) need not be used to determine whether the values +being compared have the same structure; it is often more useful to +check that they represent the same value. As an example, suppose that +we introduce a type constructor Set for representing sets of values, +using a list to store the values held in the set: + + data Set a = Set [a] + +As usual, we say that two sets are equal if they have the same members, + + + 65 + + + + +Introduction to Gofer 14.2.3 Testing equality of represented values + + +ignoring any repetitions or differences in the ordering of the elements +in the lists representing the sets. This is achieved using the +following instance declaration: + + instance Eq a => Eq (Set a) where + Set xs == Set ys = xs `subset` ys && ys `subset` xs + where xs `subset` ys = all (`elem` ys) xs + +A couple of examples illustrate the use of this definition: + + ? Set [1,2,3] == Set [3,4,1] + False + (49 reductions, 89 cells) + ? Set [1,2,3] == Set [1,2,2,2,1,3] + True + (157 reductions, 240 cells) + ? + + +14.2.4 Instance declarations without members +-------------------------------------------- +It is possible to give an instance declaration without specifying any +definitions for the member functions of the class. For example: + + instance Eq () + +In this case, the definition of (==) for the instance Eq () is left +completely undefined, and hence so is the definition of (/=), which is +defined in terms of (==): + + ? () == () + {undefined_member (==)} + (3 reductions, 34 cells) + ? () /= () + {undefined_member (==)} + (4 reductions, 36 cells) + ? + + +14.2.5 Equality on function types +--------------------------------- +If an expression requires an instance of a class which cannot be +obtained using the rules in the given instance declarations, then an +error message will be produced when the expression is type-checked. +For example, in general there is no sensible way to determine when a +pair of functions are equal, and the standard prelude does not include +a definition for an instance of the form Eq (a -> b) for any types a +and b: + + ? (1==) == (\x->1==x) + ERROR: Cannot derive instance in expression + *** Expression : (==) d148 ((==) {dict} 1) (\x->(==) {dict} 1 x) + *** Required instance : Eq (Int -> Bool) + + ? + + + + 66 + + + + +Introduction to Gofer 14.2.5 Equality on function types + + +If for some reason, you would prefer this kind of error to produce an +error message when an expression is evaluated, rather than when it is +type-checked, you can use an instance declaration to specify the +required behaviour. For example: + + instance Eq (a -> b) where + (==) = error "Equality not defined between functions" + +Evaluating the previous expression once this instance declaration has +been included now produces the following result: + + ? (1==) == (\x->1==x) + {error "Equality not defined between functions"} + (42 reductions, 173 cells) + ? + +A limited form of equality can be defined for functions of type (a->b) +if a has only finitely many elements, such as the boolean type Bool: + + instance Eq a => Eq (Bool -> a) where + f == g = f False == g False && f True == g True + +[ASIDE: This instance declaration would not be accepted in a Haskell +program which insists that the predicate on the right of the `=>' +symbol contains precisely one type constructor symbol.] + +Using this instance declaration once for each argument, we can now test +two functions taking boolean arguments for equality (assuming of course +that their result type is also an instance of Eq). + + ? (&&) == (||) + False + (9 reductions, 21 cells) + ? not == (\x -> if x then False else True) + True + (8 reductions, 16 cells) + ? (&&) == (\x y-> if x then y else False) + True + (16 reductions, 30 cells) + ? + + +14.2.6 Non-overlapping instances +-------------------------------- +Other instance declarations for types of the form a -> b can be used at +the same time, so long as no pair of declarations overlap. For +example, adding the following instance declaration + + instance Eq a => Eq (() -> a) where f == g = f () == g () + +enables us to evaluate expressions such as: + + ? (\()->"Hello") == const "Hello" + True + (30 reductions, 55 cells) + ? + + + 67 + + + + +Introduction to Gofer 14.2.6 Non-overlapping instances + + +If however, we try to use instance declarations for types of the form +(a -> b) and (Bool -> a) at the same time, then Gofer produces an error +message similar to the following: + + ERROR "file" (line 37): Overlapping instances for class "Eq" + *** This instance : Eq (a -> b) + *** Overlaps with : Eq (Bool -> a) + *** Common instance : Eq (Bool -> a) + + ? + +indicating that, given the task of testing two values of type (Bool->a) +for equality, there are (at least) two definitions of (==) that could +be used, with potentially different results being obtained in each +case. + +Here is a further example of the use of non-overlapping instances of a +class to define a function "cat" (inspired by the unix (tm) command of +the same name) which uses the I/O facilities of Gofer to print the +contents of one or more files on the terminal: + + class Cat a where cat :: a -> Dialogue + instance Cat [Char] where cat n = showFile n done + instance Cat [[Char]] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) + +Given these declarations, an expression of the form: + + cat "file" + +can be used to display the contents of the named file, whilst a list of +files can be printed one after the other using an expression of the +form: + + cat ["file1", "file2", ..., "filen"]. + + +14.3 Dictionaries +----------------- +In order to understand some of the messages produced by Gofer, as well +as some of the more subtle problems associated with overloaded +functions, it is useful to have a rough idea of the way in which +overloaded functions are implemented. + +The basic idea is that a function with a qualified type context => type +where context is a non-empty list of predicates is implemented by a +function which takes an extra argument for each predicate in the +context. When the function is used, each of these parameters is filled +by a `dictionary' which gives the values of each of the member +functions in the appropriate class. None of these extra parameters is +entered by the programmer. Instead, they are inserted automatically +during type-checking. + +For the class Eq, each dictionary has at least two elements containing + + + 68 + + + + +Introduction to Gofer 14.3 Dictionaries + + +definitions for each of the functions (==) and (/=). A dictionary for +an instance of Eq can be depicted by a diagram of the form: + + +--------+--------+--------- + | | | + | (==) | (/=) | ..... + | | | + +--------+--------+--------- + +In order to produce useful error messages and indicate the way in which +dictionary expressions are being used, Gofer uses a number of special +notations for printing expressions involving dictionaries: + + (#1 d) selects the first element of the dictionary d + + (#2 d) selects the second element of the dictionary d + + (#n d) selects the nth element of the dictionary d + (note that (#0 d) is equivalent to the dictionary d). + + {dict} denotes a specific dictionary (the contents are not + displayed). + + dnnn a dictionary variable representing an unknown dictionary is + printed as a lower case letter `d' followed by an integer; + e.g. d231. + +Note that, whilst these notations are used in output produced by Gofer +and in the following explanations, they cannot be entered directly into +Gofer expressions or programs -- even if you use a variable such as +"d1" in an expression, Gofer will not confuse this with a dictionary +variable with the same name (although Gofer might confuse you by using +the same name in two different contexts!). + +Using these notations, the member functions (==) and (/=) of the class +Eq behave as if they were defined by the expressions: + + (==) d1 = (#1 d1) + (/=) d1 = (#2 d1) + +To understand how these definitions work, we need to take a look at a +specific dictionary. Following the original instance declaration used +for Eq Int, the corresponding dictionary is: + + d :: Eq Int + +------------+------------+ + | | | + | primEqInt | defNeq d | + | | | + +------------+------------+ + +Note that the dictionary variable d is used as a name for the +dictionary in this diagram, indicating how values within a dictionary +can include references to the same dictionary. + +[ASIDE: It turns out that predicates play a very similar role for + + + 69 + + + + +Introduction to Gofer 14.3 Dictionaries + + +dictionaries as types play for normal values. This motivates our use +of the notation d :: Eq Int to indicate that d is a dictionary for the +instance Eq Int. One difference between these, particularly important +for theoretical work, is that dictionary values are uniquely determined +by predicates; if d1::p and d2::p for some predicate p, then d1 = d2.] + +The value held in the first element of the dictionary is the primitive +equality function on integers, "primEqInt". The following diagram +shows how the dictionary is used to evaluate the expression "2 == 3". +Note that this expression will first be translated to "(==) d 2 3" by +the type checker. The evaluation then proceeds as follows: + + (==) d 2 3 ==> (#1 d) 2 3 + ==> primEqInt 2 3 + ==> False + +The second element of the dictionary is a little more interesting +because it uses the default definition for (/=) given in the original +class definition which, after translation, is represented by the +function "defNeq" defined by: + + defNeq d1 x y = not ((==) d1 x y) + +Notice the way in which the extra dictionary parameter is used to +obtain the appropriate overloading. For example, evaluation of the +expression "2 /= 3", which becomes "(/=) d 2 3" after translation, +proceeds as follows: + + (/=) d 2 3 ==> (#2 d) 2 3 + ==> defNeq d 2 3 + ==> not ((==) d 2 3) + ==> not ((#1 d) 2 3) + ==> not (primEqInt 2 3) + ==> not False + ==> True + +[Clearly there is some scope for optimisation here; whilst the actual +reduction sequences used by Gofer are equivalent to those illustrated +above, the precise details are a little different.] + +If an instance is obtained from an instance declaration with a +non-empty context, then the basic two element dictionary used in the +examples above is extended with an extra dictionary value for each +predicate in the context. As an example, the diagram below shows the +dictionaries that will be created from the instance definitions in +section 14.2.2 for the instance Eq (Int, [Int]). The functions +"eqPair" and "eqList" which are used in these dictionaries are obtained +from the definitions of (==) given in the instance declarations for Eq +(a,b) and Eq [a] respectively: + + eqPair d (x,y) (u,v) = (==) (#3 d) x u && (==) (#4 d) y v + + eqList d [] [] = True + eqList d [] (y:ys) = False + eqList d (x:xs) [] = False + eqList d (x:xs) (y:ys) = (==) (#3 d) x y && (==) d xs ys + + + 70 + + + + +Introduction to Gofer 14.3 Dictionaries + + +The dictionary structure for Eq (Int, [Int]) is as follows. Note that +the Gofer system ensures that there is at most one dictionary for a +particular instance of a class, and that the dictionary d1 :: Eq Int in +this system is automatically shared between d2 and d3: + + d3 :: Eq (Int, [Int]) + +------------+------------+------------+------------+ + | | | | | + | eqPair d3 | defNeq d3 | d1::Eq Int |d2::Eq [Int]| + | | | | | + +------------+------------+-----+------+-----+------+ + | | + +--------------+ | + | | + | d2 :: Eq [Int] V + | +------------+------------+------------+ + | | | | | + | | eqList d2 | defNeq d2 | d1::Eq Int | + | | | | | + | +------------+------------+-----+------+ + | | + d1 :: Eq Int V | + +------------+------------+ | + | | | | + | primEqInt | defNeq d1 |<--------------------------+ + | | | + +------------+------------+ + +Once again, it may be useful to see how these definitions are used to +evaluate the expression "(2,[1]) == (2,[1,3])" which, after +translation, becomes "(==) d3 (2,[1]) (2,[1,3])": + + (==) d3 (2,[1]) (2,[1,3]) + ==> (#1 d3) (2,[1]) (2,[1,3]) + ==> eqPair d3 (2,[1]) (2,[1,3]) + ==> (==) (#3 d3) 2 2 && (==) (#4 d3) [1] [1,3] + ==> (==) d1 2 2 && (==) (#4 d3) [1] [1,3] + ==> (#1 d1) 2 2 && (==) (#4 d3) [1] [1,3] + ==> primEqInt 2 2 && (==) (#4 d3) [1] [1,3] + ==> True && (==) (#4 d3) [1] [1,3] + ==> (==) (#4 d3) [1] [1,3] + ==> (==) d2 [1] [1,3] + ==> (#1 d2) [1] [1,3] + ==> eqList d2 [1] [1,3] + ==> (==) (#3 d2) 1 1 && (==) d2 [] [3] + ==> (==) d1 1 1 && (==) d2 [] [3] + ==> (#1 d1) 1 1 && (==) d2 [] [3] + ==> primEqInt 1 1 && (==) d2 [] [3] + ==> True && (==) d2 [] [3] + ==> (==) d2 [] [3] + ==> False + + + + + + + + 71 + + + + +Introduction to Gofer 14.3.1 Superclasses + + +14.3.1 Superclasses +------------------- +In general, a type class declaration has the form: + + class context => Class a1 ... an where + type declarations for member functions + default definitions of member functions + +where Class is the name of the new type class which takes n arguments, +represented by distinct type variables a1, ..., an. As in the case of +instance declarations, the context that appears on the left hand side +of the `=>' symbol specifies a list of predicates that must be +satisfied in order to construct any instance of "Class". + +The predicates in the context part of a class declaration are called +the superclasses of Class. This terminology is taken from Haskell +where all classes have a single parameter and each of the predicates in +the context part of a class declaration has the form C a1; in this +situation, any instance of Class must also be an instance of each class +C named in the context. In other words, each such C contains a +superset of the types in Class. + +As an example of a class declaration with a non-empty context, consider +the following declaration from the standard prelude which introduces a +class Ord whose instances are types with both strict (<), (>) and +non-strict (<=), (>=) versions of an ordering defined on their +elements: + + class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +Notice that this definition provides default definitions for all of the +member functions except (<=), so that in general only this single +function needs to be defined to construct an instance of class Ord. + +There are two reasons for defining Eq as a superclass of Ord: + + o The default definition for (<) relies on the use of (/=) taken + from class Eq. In order to guarantee that this is always valid we + must ensure that every instance of Ord must also be an instance of + Eq. + + o Given the definition of a non-strict ordering (<=) on the elements + of a type, it is always possible to construct a definition for the + (==) operator (and hence for (/=)) using the equation: + + + + 72 + + + + +Introduction to Gofer 14.3.1 Superclasses + + + x==y = x<=y && y<=x + + There will therefore be no loss in generality by requiring Eq to + be a superclass of Ord, and conversely, no difficulty in defining + an instance of Eq to accompany any instance of Ord for which an + instance of Eq has not already be provided. + + As an example, the following definitions provide an alternative + way to implement the equality operation on elements of the Set + datatype described in section 14.2.3, in terms of the subset + ordering defined in class Ord: + + instance Ord (Set a) => Eq (Set a) where + x == y = x <= y && y <= x + + instance Eq a => Ord (Set a) where + Set xs <= Set ys = all (`elem` ys) xs + + This definition is in fact no less efficient or effective than the + original version. + +Dictionaries for superclasses are dealt with in much the same way as +the instance specific dictionaries described above. For example, the +general layout of a dictionary for an instance of Ord is illustrated in +the following diagram: + + +--------+--------+--------+--------+--------+--------+--------+----- + | | | | | | | | + | (<) | (<=) | (>) | (>=) | max | min | Eq a | ..... + | | | | | | | | + +--------+--------+--------+--------+--------+--------+--------+----- + +Note the use of the seventh element of this dictionary which points to +the dictionary for the appropriate instance of Eq. This is used in the +translation of the default definition for (<) which is equivalent to: + + defLessThan d x y = (<=) d x y && (/=) (#7 d) x y + + +14.3.2 Combining classes +------------------------ +In general, a dictionary is made up of three separate parts: + + +-------------------+-------------------+-------------------+ + | Implementation | Superclass | Instance specific | + | of class members | Dictionaries | Dictionaries | + | | | | + +-------------------+-------------------+-------------------+ + +Each of these may be empty. We have already seen examples in which +there are no superclass dictionaries (e.g. instances of Eq) and in +which there are no instance specific dictionaries (e.g. Eq Int). +Classes with no member functions (corresponding to dictionaries with no +member functions) are sometimes useful as a convenient abbreviation for +a list of predicates. For example: + + + + 73 + + + + +Introduction to Gofer 14.3.2 Combining classes + + + class C a where cee :: a -> a + class D a where dee :: a -> a + + class (C a, D a) => CandD a + +makes CandD a an abbreviation for the context (C a, D a). Thinking of +single parameter type classes as sets of types, the type class CandD +corresponds to the intersection of classes C and D. + +Just as the type inferred for a particular function definition or +expression does not involve type synonyms unless explicit type +signatures are used, the Gofer type system will not use a single +predicate of the form CandD a instead of the two predicates C a and D a +unless explicit signatures are used: + + ? :t dee . cee + \d129 d130 -> dee d130 . cee d129 :: (C a, D a) => a -> a + ? :t dee . cee :: CandD a => a -> a + \d129 -> dee (#2 d129) . cee (#1 d129) :: CandD a => a -> a + ? + +In Haskell, all instances of a class such as CandD must have +explicit declarations, in addition to the corresponding declarations +for instances for C and D. This problem can be avoided by using the +more general form of instance declaration permitted in Gofer; a single +instance declaration: + + instance CandD a + +is all that is required to ensure that any instance of CandD can be +obtained, so long as corresponding instances for C and D can be found. + + +14.3.3 Simplified contexts +-------------------------- +Consider the function defined by the following equation: + + eg1 x = [x] == [x] || x == x + +This definition does not restrict the type of x in any way except that, +if x :: a, then there must be instances Eq [a] and Eq a which are used +for the two occurrences of the (==) operator in the equation. We might +therefore expect the type of eg1 to be: + + (Eq [a], Eq a) => a -> Bool + +with translation: + + eg1 d1 d2 x = (==) d1 [x] [x] || (==) d2 x x + +However, as can be seen from the case where a=Int illustrated in +section 14.3, given d1::Eq [a] we can always find a dictionary for Eq a +by taking the third element of d1 i.e. (#3 d1)::Eq a. Since it is more +efficient to select an element from a dictionary than to complicate +both type and translation with extra parameters, the type assigned to +"eg1" by default is: + + + 74 + + + + +Introduction to Gofer 14.3.3 Simplified contexts + + + Eq [a] => a -> Bool + +with translation: + + eg1 d1 x = (==) d1 [x] [x] || (==) (#3 d1) x x + +In general, given a set of predicates corresponding to the instances +required by an expression, Gofer will always attempt to find the +smallest possible subset of these predicates such that all of the +required dictionaries can still be obtained, whilst minimising the +number of dictionary parameters that are used. + +The original type and translation for eg1 given above can be produced +by including an explicit type signature in the file containing the +definition of eg1: + + eg1 :: (Eq [a], Eq a) => a -> Bool + eg1 x = [x] == [x] || x == x + +But even with this definition, Gofer will still always try to minimise +the number of dictionaries used in any particular expression: + + ? :t eg1 + \d153 -> eg1 d153 (#3 d153) :: Eq [a] => a -> Bool + ? + +As another example, consider the expression "(\x y-> x==x || y==y)". +The type and translation assigned to this term can be found directly +using Gofer: + + ? :t (\x y-> x==x || y==y) + \d121 d122 x y -> (==) d122 x x || + (==) d121 y y + :: (Eq b, Eq a) => a -> b -> Bool + ? + +Note that the translation has two dictionary parameters d121 and d122 +corresponding to the two predicates Eq a and Eq b respectively. Since +both of these dictionaries can be obtained from a dictionary for the +predicate Eq (a,b), we can use an explicit type signature to produce a +translation which needs only one dictionary parameter: + + ? :t (\x y-> x==x || y==y) :: Eq (a,b) => a -> b -> Bool + \d121 x y -> (==) (#3 d121) x x || + (==) (#4 d121) y y + :: Eq (a,b) => a -> b -> Bool + ? + + + + + + + + + + + + 75 + + + + +Introduction to Gofer 14.4 Other issues + + +14.4 Other issues +----------------- + +14.4.1 Unresolved overloading +----------------------------- +Consider the use of the (==) operator in the following three +situations: + + o In the expression "2 == 3", it is clear that the appropriate value + for the equality operator in this case is primIntEq as defined by + the instance declaration for Eq Int. The expression can therefore + be translated to "primEqInt 2 3". + + o In the function definition "f x = x==x", we cannot completely + determine the appropriate value for (==) because it depends on the + type assigned to the variable "x", which may itself vary with + different uses of the function "f". It is however possible to add + an extra parameter to the definition, giving "f d x = (==) d x x" + and taking the type of "f" to be Eq a => a -> Bool. + + In this way, the problem of finding the appropriate definition for + the (==) operator is deferred until the function is actually used. + + o In the expression "[]==[]", the appropriate value for (==) must be + obtained from the dictionary for some instance of the form Eq [a], + but there is not sufficient information in the expression to + determine what the value of the type variable a should be. + + Looking back to the instance declaration for Eq [a], we find that + the definition of (==) depends on the value of the dictionary for + the instance Eq a. In this particular case, it is clear that the + expression will always evaluate to True, regardless of the value + of this dictionary. Unfortunately, the only way that this can be + detected is by evaluating the expression to see if the calculation + can be completed without reference to the dictionary value (see + the comments in the aside at the end of this section). + + Attempting to evaluate this expression in Gofer will therefore + result in an error message indicating that the expression does not + contain sufficient information to resolve the use of overloading + in the expression: + + ? [] == [] + ERROR: Unresolved overloading + *** type : Eq [a] => Bool + *** translation : \d129 -> (==) d129 [] [] + ? + + Note that the expression has been converted into a lambda + expression using the dictionary variable d129 to represent the + dictionary for the unknown instance Eq [a]. + + One simple way to resolve the overloading in an expression of this + kind is to use an explicit type signature. For example, if we + specify that the second empty list is an empty list of type [Int]: + + + + 76 + + + + +Introduction to Gofer 14.4.1 Unresolved overloading + + + ? [] == ([]::[Int]) + True + (2 reductions, 9 cells) + ? + +The same problem occurs in Haskell, where it is described using the +idea of an `ambiguous type' -- i.e. a type expression of the form +context => type where one or more of the type variables appearing in +the given context do not appear in the remaining part of the type +expression. + +Further examples of unresolved overloading occur with other classes. +As an example consider the class Reader defined by: + + class Reader a where + parse :: String -> a + unparse :: a -> String + +whose member functions provide methods for obtaining the string +representation of an element of an instance type, and for converting +such representations back into the original values. (The standard +Haskell Text class contains similar functions.) Now consider the +expression "parse . unparse" which maps values from some instance of +Reader to values of another instance via an intermediate string +representation. + + ? parse . unparse + ERROR: Unresolved overloading + *** type : (Reader a, Reader b) => a -> b + *** translation : \d129 d130 -> parse d130 . unparse d129 + ? + +One of the first things that might surprise the reader here is that the +value produced by "parse . unparse" does not have to be of the same +type as the argument; for example, we would not usually expect to have +any sensible interpretation for a floating point number obtained from +the string representation of a boolean value! + +This can be fixed by using an explicit type declaration, although the +expression still produces unresolved overloading: + + ? (parse . unparse) :: Reader a => a -> a + ERROR: Unresolved overloading + *** type : Reader a => a -> a + *** translation : \d130 -> parse d130 . unparse d130 + ? + +Notice however that the type of this expression is not ambiguous so +that the unresolved overloading in this example can be eliminated when +the function is actually used: + + ? ((parse . unparse) :: Reader a => a -> a) 'a' + 'a' + (4 reductions, 11 cells) + ? + + + + 77 + + + + +Introduction to Gofer 14.4.1 Unresolved overloading + + +A more serious problem occurs with the expression "unparse . parse" +which maps string values to string values via some intermediate type. +Clearly this will lead to a problem with unresolved overloading: + + ? unparse . parse + ERROR: Unresolved overloading + *** type : Reader a => String -> String + *** translation : \d130 -> unparse d130 . parse (#0 d130) + ? + +Notice that the type obtained in this case is ambiguous; the type +variable a which appears in the predicate Reader a does not appear in +the type String -> String. There are a number of ways of resolving +this kind of ambiguity: + + o Using an explicitly typed expression: Assuming for example that + Char is an instance of Reader, we can write: + + ? unparse . (parse :: String -> Char) + v113 {dict} . v112 {dict} + (5 reductions, 42 cells) + ? + + without any ambiguity. If such type signatures are used in a + number of places, it might be better to define an auxiliary + function and use that instead: + + charParse :: String -> Char + charParse = parse + + ? unparse . charParse + v113 {dict} . charParse + (4 reductions, 37 cells) + ? + + In such situations, it is perhaps worth asking if overloaded + functions are in fact the most appropriate solution for the + problem at hand! + + o Using an extra dummy parameter in a function definition. In a + definition such as: + + f = unparse . parse + + we can introduce an additional dummy parameter `x' which is not + used except to determine the type of the result produced by parse + in f: + + f x = unparse . (parse `asTypeOf` (\""->x)) + + where the standard prelude operator `asTypeOf` defined by: + + asTypeOf :: a -> a -> a + x `asTypeOf` _ = x + + is used to ensure that the type of parse in the definition of f is + + + 78 + + + + +Introduction to Gofer 14.4.1 Unresolved overloading + + + the same as that of the function (\""->x) -- in other words, the + type must be String -> a where a is the type of the variable x. + + The resulting type for f is: + + f :: Reader a => a -> String -> String + + Notice how the addition of the dummy parameter has been used to + eliminate the ambiguity present in the original type. + + This kind of `coding trick' is rather messy and is not recommended + for anything but the simplest examples. + +[ASIDE: The idea of evaluating an expression with an ambiguous type to +see if it does actually need the unspecified dictionaries could have +been implemented quite easily in Gofer using an otherwise unused +datatype Unresolved and generating instance declarations such as: + + instance Eq Unresolved where + (==) = error "unresolved overloading for (==)" + (/=) = error "unresolved overloading for (/=)" + +for each class. Given a particular expression, we can then use the +type Unused in place of any ambiguous type variables in its type. The +evaluation of the expression could then be attempted, either completing +successfully if the dictionaries are not required, but otherwise +resulting in a run-time error. + +This approach is not used in Gofer; instead, the programmer is notified +of any unresolved polymorphism when the program is type checked, +avoiding the possibility that a program might contain an undetected +ambiguity.] + + +14.4.2 `Recursive' dictionaries +------------------------------- +Unlike Haskell, there are no restrictions on the form of the predicates +that may appear in the context part of a Gofer class or instance +declaration. This has a number of potentially useful applications +because it enables the Gofer programs to use mutually `recursive' +systems of dictionaries. + +One example of this is the ability to implement a large family of +related functions using a group of classes instead of having to use a +single class. The following example illustrates the technique with an +alternative definition for the class Eq in which the (==) and (/=) +operators are placed in different classes: + + class Neq a => Eq a where (==) :: a -> a -> Bool + + class Eq a => Neq a where (/=) :: a -> a -> Bool + x/=y = not (x == y) + + +[ASIDE: These declarations clash with those in the standard prelude and +hence cannot actually be used in Gofer unless a modified version of the + + + 79 + + + + +Introduction to Gofer 14.4.2 `Recursive' dictionaries + + +standard prelude is used instead.] + +If we then give instance declarations: + + instance Eq Int where (==) = primEqInt + instance Neq Int + +and try to evaluate the expression "2==3" then the following system of +dictionaries will be generated: + + d1 :: Eq Int d2 :: Neq Int + +-----------+-----------+ +-----------+-----------+ + | | | | | | + +-->| primEqInt |d2::Neq Int+----->| defNeq d2 |d1::Eq Int +---+ + | | | | | | | | + | +-----------+-----------+ +-----------+-----------+ | + | | + +------------------------------<-------------------------------+ + +where the function "defNeq" is derived from the default definition in +the class Neq and is equivalent to: + + defNeq d x y = not ((==) (#2 d) x y) + +Incidentally, if the instance declaration for Neq Int above had been +replaced by: + + instance Neq a + +then the effect of these declarations would be similar to the standard +definition of the class Eq, except that it would not be possible to +override the default definition for (/=). In other words, this +approach would give the same effect as defining (/=) as a top-level +function rather than a member function in the class Eq: + + class Eq a where (==) :: a -> a -> Bool + + (/=) :: Eq a => a -> a -> Bool + x /= y = not (x == y) + +There are other situations in which recursive dictionaries of the kind +described above can be used. A further example is given in the +following section. Unfortunately, the lack of restrictions on the form +of class and instance declarations can also lead to problems in some +(mostly pathological) cases. As an example, consider the class: + + class Bad [a] => Bad a where bad :: a -> a + +Without defining any instances of Bad, it is not possible to construct +any dictionaries for instances of Bad: + + ? bad 2 + ERROR: Cannot derive instance in expression + *** Expression : bad d126 2 + *** Required instance : Bad Int + ? + + + 80 + + + + +Introduction to Gofer 14.4.2 `Recursive' dictionaries + + +If however we add the instance declarations: + + instance Bad Int where bad = id + instance Bad [a] where bad = id + +then any attempt to construct a dictionary for Bad Int will also +require a dictionary for the superclass Bad [Int] and then for the +superclass of that instance Bad [[Int]] etc... Since Gofer has only a +finite amount of space for storing dictionaries, this process will +eventually terminate when that space has been used up: + + ? bad 2 + ERROR: Dictionary storage space exhausted + ? + +[ASIDE: depending on the configuration of your particular version of +Gofer and on the nature of the class and instance declarations that are +involved, an alternative error message "ERROR: Too many type variables +in type checker" may be produced instead of the message shown above.] + +From a practical point of view, this problem is unlikely to cause too +many real difficulties: + + o Class declarations involving predicates such as those in the + declaration of Bad are unlikely to be used in realistic programs. + + o All dictionaries are constructed before evaluation begins. This + process is guaranteed to terminate because each new dictionary + that is created uses up part of the space used to hold Gofer + dictionaries. The construction process will either terminate + successfully once complete, or be aborted as soon as all of the + dictionary space has been used. + +It remains to see what impact (if any) this has on realistic programs, +and if later versions of Gofer should be modified to impose some +syntactic restrictions (as in Haskell) or perhaps some form of static +checking of the contexts appearing in class and instance declarations. + + +14.4.3 Classes with multiple parameters +--------------------------------------- +Gofer is the first language to support the use of type classes with +multiple parameters. This again is an experimental feature of the +language, intended to make it possible to explore the claims from a +number of researchers about the use of such classes. + +Initial experiments suggest that multiple parameter type classes are +likely to lead to large numbers of problems with unresolved +overloading. Ultimately, this may mean that such classes are only of +practical use in explicitly typed languages, or alternatively that a +more powerful and general defaulting mechanism (similar to that used in +Haskell with numeric classes) is required to support user controlled +overloading resolution. + +The following declaration introduces a class Iso whose elements are +pairs of isomorphic types: + + + 81 + + + + +Introduction to Gofer 14.4.3 Classes with multiple parameters + + + class Iso b a => Iso a b where iso :: a -> b + +The single member function "iso" represents the isomorphism mapping +elements of type a to corresponding elements of type b. Note the +`superclass' context in this declaration which formalises the idea that +if a is isomorphic to b then b is also isomorphic to a. The class Iso +therefore provides further examples of the recursive dictionaries +described in the previous section. + +The fact that any type is isomorphic to itself can be described by the +following instance declaration: + + instance Iso a a where iso x = x + +For example, the dictionary structure created in order to evaluate the +expression "iso 2 = 3" is: + + d :: Iso Int Int + +--------------+--------------+ + | | | + +-->| id |d::Iso Int Int+--+ + | | | | | + | +--------------+--------------+ | + | | + +------------------<-----------------+ + + ? iso 2 == 3 + False + (4 reductions, 11 cells) + ? + +Our first taste of the problems to come occurs when we try to evaluate +the expression "iso 2 == iso 3": + + ? iso 2 == iso 3 + ERROR: Unresolved overloading + *** type : (Eq a, Iso Int a) => Bool + *** translation : \d130 d132 -> (==) d130 (iso d132 2) (iso d132 3) + ? + +In this case, the "iso" function is used to map the integers 2 and 3 to +elements of some type a, isomorphic to Int, and the values produced are +then compared using (==) at the instance Eq a; there is no way of +discovering what the value of a should be without using an explicit +type signature. + +Further instances can be defined. The following two declarations are +needed to describe the (approximate) isomorphism between lists of pairs +and pairs of lists: + + instance Iso [(a,b)] ([a],[b]) where + iso xs = (map fst xs, map snd xs) + + instance Iso ([a],[b]) [(a,b)] where + iso (xs,ys) = zip xs ys + + + + 82 + + + + +Introduction to Gofer 14.4.3 Classes with multiple parameters + + +Unfortunately, even apparently straightforward examples give problems +with unresolved overloading, forcing the use of explicit type +declarations: + + ? iso [(1,2),(3,4)] + ERROR: Unresolved overloading + *** type : Iso [(Int,Int)] a => a + *** translation : \d126 -> iso d126 [(1,2),(3,4)] + + ? (iso [(1,2),(3,4)]) :: ([Int],[Int]) + ([1, 3],[2, 4]) + (22 reductions, 64 cells) + ? + +A second example of a multiple parameter type class is defined as +follows: + + class Ord a => Collects a b where + emptyCollection :: b + addToCollection :: a -> b -> b + listCollection :: b -> [a] + +The basic intuition is that the predicate Collects a b indicates that +elements of type b can be used to represent collections of elements of +type a. A number of people have suggested using type classes in this +way to provide features similar to the (similarly named, but otherwise +different) classes that occur in object-oriented languages. + +Obvious implementations involve the use of ordered lists or binary +search trees defined by instances of the form: + + data STree a = Empty | Node a (STree a) (STree a) + + instance Collects a [a] where .... + instance Collects a (STree a) where .... + +Once again, there are significant problems even with simple examples +using these functions. As an example, the standard way of defining a +function of type: + + Collects a b => [a] -> b + +mapping a list of values to a collection of those values using the +higher order function "foldr": + + listToCollection = foldr addToCollection emptyCollection + +actually produces a function with ambiguous type: + + ? :t foldr addToCollection emptyCollection + \d139 d140 -> foldr (addToCollection d140) (emptyCollection d139) + :: (Collects c b, Collects a b) => [a] -> b + ? + +which cannot be resolved, even with an explicit type declaration. + + + + 83 + + + + +Introduction to Gofer 14.4.4 Overloading and numeric values + + +14.4.4 Overloading and numeric values +------------------------------------- +One of the most common uses of overloading is to allow the use of the +standard arithmetic operators such as (+), (*) etc. on the elements of +a range of numeric types including integers and floating point values +in addition to user defined numeric types such as arbitrary precision +integers, complex and rational numbers, vectors and matrices, +polynomials etc. In Haskell, these features are supported by a number +of built-in types and a complex hierarchy of type classes describing +the operations defined on the elements of each numeric type. + +As an experimental language, intended primarily for the investigation +of general purpose overloading, Gofer has only two built-in numeric +types; Int and Float (the second of which is not supported in all +implementations). Similarly, although the Gofer system could be used +to implement the full hierarchy of Haskell numeric classes, the +standard prelude uses a single numeric type class Num defined by: + + class Eq a => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +The first four member functions (+), (-), (*), (/) are the standard +arithmetic functions on instances of Num, whilst "negate" denotes unary +negation. The final member function, fromInteger is used to coerce any +integer value to the corresponding value in another instance of Num. +An expression such as "fromInteger 3" is called an overloaded numeric +constant and has type Num a => a indicating that it can be used as a +value of any instance of Num. See below for examples. + +Both Float and Int are defined as instances of Num using primitive +functions for integer and floating point arithmetic: + + instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + + instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +These definitions make it possible to evaluate numeric expressions +involving both types: + + ? 2 + 3 + 5 + (3 reductions, 6 cells) + + + 84 + + + + +Introduction to Gofer 14.4.4 Overloading and numeric values + + + ? 3.2 + 4.321 + 7.521 + (3 reductions, 13 cells) + ? + +Note however that any attempt to evaluate an expression mixing +different arithmetic types is likely to cause a type error: + + ? 4.2 * 4 + ERROR: Type error in application + *** expression : 4.2 * 4 + *** term : 4.2 + *** type : Float + *** does not match : Int + ? + +Further problems occur when we try to define functions intended to be +used with arbitrary instances of Num rather than specific numeric +types. As an example of this, the standard prelude function "sum", +roughly equivalent to: + + sum [] = 0 + sum (x:xs) = x + sum xs + +has type [Int] -> Int, rather than the more general Num a => [a] -> a +which could be used to find the sum of a list of numeric values in any +instance of Num. The problem in this particular case is caused by the +integer constant 0 in the first line of the definition. Replacing this +with the expression fromInteger 0 leads to the following definition for +a generic sum function of the required type: + + genericSum :: Num a => [a] -> a + genericSum [] = fromInteger 0 + genericSum (x:xs) = x + genericSum xs + +For example: + + ? genericSum [1,2,3] + 6 + (10 reductions, 18 cells) + ? genericSum [1.0,2.0,3.0] + 6.0 + (11 reductions, 27 cells) + ? + +The fromInteger function can also be used to solve the previous +problem: + + ? 4.2 * fromInteger 4 + 16.8 + (3 reductions, 13 cells) + ? + +In Haskell, any integer constant k appearing in an expression is +treated as if the programmer had actually written "fromInteger k" so +that both of the preceding problems are automatically resolved. + + + 85 + + + + +Introduction to Gofer 14.4.4 Overloading and numeric values + + +Unfortunately, this also creates some new problems; applying the +function fromInteger to each integer constant in the previous examples +causes problems with unresolved overloading: + + ? fromInteger 2 + fromInteger 3 + ERROR: Unresolved overloading + *** type : Num a => a + *** translation : \d143 -> (+) d143 (fromInteger d143 2) + (fromInteger d143 3) + ? + +Once again, Haskell provides a solution to this problem in the form of +a `default mechanism' for numeric types which, once the following +problem has been detected, will typically `default' the unknown type +represented by the type variable a above to be Int, so that the result +is actually equivalent to the following: + + ? (fromInteger 2 + fromInteger 3) :: Int + 5 + (4 reductions, 8 cells) + ? + +There are a number of problems with the Haskell default mechanism; both +theoretical and practical. In addition, if a default mechanism of some +form is used then it should also be capable of dealing with arbitrary +user-defined type classes, rather than a small group of `standard' +classes, in order to provide solutions to the unresolved overloading +problems described in previous sections. Therefore, for the time +being, Gofer does not support any form of default mechanism and +overloaded numeric constants can only be obtained by explicit use of +the fromInteger function. + + +14.4.5 Constants in dictionaries +-------------------------------- +The Gofer system constructs new dictionaries as necessary, and deletes +them when they are no longer required. At any one time, there is at +most one dictionary for each instance of a class. Coupled with lazy +evaluation, this has a number of advantages for classes in which member +functions are defined by variable declarations as in section 9.10. As +an example, consider the class Finite defined by: + + class Finite a where members :: [a] + +The only member in this class is a list enumerating the elements of the +type. For example: + + instance Finite Bool where members = [False, True] + + instance (Finite a, Finite b) => Finite (a,b) where + members = [ (x,y) | x<-members, y<-members ] + +In order to overcome any problems with unresolved overloading, explicit +type signatures are often needed to resolve overloading: + + ? members :: [Bool] + + + 86 + + + + +Introduction to Gofer 14.4.5 Constants in dictionaries + + + [False, True] + (6 reductions, 26 cells) + ? length (members :: [((Bool,Bool),(Bool,Bool))]) + 16 + (103 reductions, 195 cells) + ? + +In some cases, the required overloading is implicit from the context +and no additional type information is required, as in the following +example: + + ? [ x && y | (x,y) <- members ] + [False, False, False, True] + (29 reductions, 90 cells) + ? + +We can also use the technique of passing a `dummy' parameter to resolve +overloading problems in a function definition: + + size :: Finite a => a -> Int + size x = length (members `asTypeOf` [x]) + +which calculates the number of elements of a finite type, given an +arbitrary element of that type: + + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? + +Now consider the expression "size (True,False) + size (True,False)". +At first glance, we expect this to repeat the calculation in the +previous example two times, requiring approximately twice as many +reductions and cells as before. However, before this expression is +evaluated, Gofer constructs a dictionary for Finite (Bool,Bool). The +evaluation of the first summand forces Gofer to evaluate the value for +"members" in this dictionary. Since precisely the same dictionary is +used to calculate the value of the second summand, the evaluation of +"members" is not repeated and the complete calculation actually uses +rather fewer reductions and cells: + + ? size (True,False) + size (True,False) + 8 + (51 reductions, 90 cells) + ? + +On the other hand, repeating the original calculation gives exactly the +same number of reductions and cells as before, because the dictionaries +constructed at the beginning of each calculation are not retained for +use in subsequent calculations. + +We can force Gofer to construct specific dictionaries whilst reading +from a file of definitions, so that they are not deleted at the end of +each calculation, using an explicitly typed variable definition such +as: + + + + 87 + + + + +Introduction to Gofer 14.4.5 Constants in dictionaries + + + boolBoolMembers = members :: [(Bool,Bool)] + +This forces Gofer to construct the dictionary Finite (Bool,Bool) when +the file of definitions is loaded and prevents it from being deleted at +the end of each calculation. Having loaded a file containing this +definition, the first two attempts to evaluate "size (True,False)" +give: + + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? size (True,False) + 4 + (20 reductions, 32 cells) + ? + + +14.4.6 The monomorphism restriction +----------------------------------- +This section describes a technique used to limit the amount of +overloading used in the definition of certain values to avoid a number +of technical problems. This particular topic has attracted quite a lot +of attention within the Haskell community where it is affectionately +known as the `dreaded monomorphism restriction'. Although the initial +formulation of the rule was rather cumbersome and limiting, the current +version used in both Gofer and Haskell is unlikely to cause any +problems in practice. In addition, many of the examples used to +motivate the need for the monomorphism restriction in Haskell occur as +a result of the use of implicitly overloaded numeric constants, +described in section 14.4.4, and hence do not occur in Gofer. + +The monomorphism restriction takes its name from the way in which it +limits the amount of polymorphism that can be used in particular kinds +of declaration. Although we touch on this point in the following +discussion, the description given here uses an equivalent, but less +abstract approach, based on observations about the implementation of +overloaded functions. + +Basic ideas: +------------ +As we have seen, the implementation of overloading used by Gofer +depends on being able to add extra arguments to a function definition +to supply the required dictionary parameters. For example, given a +function definition such as: + + isElement x [] = False + isElement x (y:ys) = x==y || isElement x ys + +we first add a dictionary parameter for the use of the overloaded (==) +operator on the right hand side, obtaining: + + isElement x [] = False + isElement x (y:ys) = (==) d x y || isElement x ys + +Finally, we have to add the variable d as a new parameter for the +function isElement, on both the left and right hand sides of the + + + 88 + + + + +Introduction to Gofer 14.4.6 The monomorphism restriction + + +definition: + + isElement d x [] = False + isElement d x (y:ys) = (==) d x y || isElement d x ys + +The monomorphism restriction imposes conditions which prevent this last +step from being used for certain kinds of value binding. + +Declaration groups: +------------------- +Before giving the full details, it is worth pointing out that, in +general, the monomorphism restriction affects groups of value +declarations rather than just individual definitions. To illustrate +this point, consider the function definitions: + + f x y = x==y || g x y + g x y = not (f x y) + +Adding an appropriate dictionary parameter for the (==) operator gives: + + f x y = (==) d x y || g x y + g x y = not (f x y) + +The next stage is to make this dictionary variable into an extra +parameter to the function f wherever it appears, giving: + + f d x y = (==) d x y || g x y + g x y = not (f d x y) + +But now the right hand side of the second definition mentions the +dictionary variable d which must therefore be added as an extra +parameter to g: + + f d x y = (==) d x y || g d x y + g d x y = not (f d x y) + +In other words, if dictionary parameters are added to any particular +function definition, then each use of that function in another +definition will also be require extra dictionary parameters. As a +result, the monomorphism restriction has to be applied to the smallest +groups of declarations such that any pair of mutually recursive +bindings are in the same group. + +As the example above shows, if one (or more) of the bindings in a given +declaration group is affected by the monomorphism restriction so that +the appropriate dictionary parameters cannot be added as parameters for +that definition, then the same condition must also be imposed on all of +the other bindings in the group. [Adding the extra parameter to f in +the example forces us to add an extra parameter for g; if extra +parameters were not permitted for g then they could not be added to f.] + + + + + + + + + 89 + + + + +Introduction to Gofer 14.4.6 The monomorphism restriction + + +Restricted bindings: +-------------------- +There are three main reasons for avoiding adding dictionary parameters +to a particular value binding: + + o Dictionary parameters unnecessary. If the dictionary values are + completely determined by context then it is not necessary to pass + the appropriate values as dictionary parameters. For example, the + function definition: + + f x = x == 0 || x == 2 + + can be translated as: + + f x = (==) {dict} x 0 || (==) {dict} x 2 + + where, in both cases, the symbol {dict} denotes the dictionary for + Eq Int. As a further optimisation, once the dictionary is fully + determined, this can be simplified to: + + f x = primEqInt x 0 || primEqInt x 2 + + o Dictionary parameters cannot be added in a pattern binding. One + potential solution to this problem would be to replace the pattern + binding by an equivalent set of function bindings. In practice, + we do not use this technique because it typically causes ambiguity + problems, as illustrated by the pattern binding: + + (plus,times) = ((+), (*)) + + Translating this into a group of function bindings gives: + + newVariable = ((+), (*)) + plus = fst newVariable -- fst (x,_) = x + times = snd newVariable -- snd (_,y) = y + + The type of newVariable is (Num a, Num b) => (a->a->a, b->b->b) so + that the correct translation of these bindings using two + dictionary variables gives: + + newVariable da db = ((+) da, (*) db) + plus da db = fst (newVariable da db) + times da db = snd (newVariable da db) + + and hence the correct types for plus and times are: + + plus :: (Num a, Num b) => a -> a -> a + times :: (Num a, Num b) => b -> b -> b + + both of which are ambiguous. + + o Adding dictionary parameters may translate a variable definition + into a function definition, loosing the benefits of shared + evaluation. As an example, consider the following definition + using the function "size" and the class Finite described in the + previous section: + + + 90 + + + + +Introduction to Gofer 14.4.6 The monomorphism restriction + + + twiceSize x = n + n where n = size x + + Since the variable n is defined using a local definition, we would + not expect to have to evaluate size x more than once to determine + the value of twiceSize. However, adding extra dictionary + parameters without restriction gives: + + twiceSize d x = n d + n d where n d = size d x + + Now that n has been replaced by a function, the evaluation will be + repeated, once for each occurrence of the expression "n d". In + order to avoid this kind of problem, the monomorphism restriction + does not usually allow extra parameters to be added to a variable + definition. Thus the original definition above will be translated + to give: + + twiceSize d x = n + n where n = size d x + + Note that the same rule is applied to variable definitions at the + top-level of a file of definitions, resulting in an error if any + dictionary parameters are required for the right hand side of the + definition. As an example of this: + + twiceMembers = members ++ members + + which produces an error message of the form: + + ERROR "ex" (line 157): Unresolved top-level overloading + *** Binding : twiceMembers + *** Inferred type : [_7] + *** Outstanding context : Finite _7 + ? + + [COMMENT: A type expression of the form _n (such as _7 in this + particular example) represents a fixed (i.e. monomorphic) type + variable.] + + In the case of a variable declaration, the monomorphism + restriction can be overcome by giving an explicit type signature + including an appropriate context, to indicate that the variable + defined is intended to be used as an overloaded value. In this + case, we need only include the declaration: + + twiceMembers :: Finite a => [a] + + in the file containing the definition for twiceMembers to suppress + the previous error message and allow the function to be used as a + fully overloaded variable. + + Note that the monomorphism restriction interferes with the use of + polymorphism. For example, the definition: + + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers = members ++ members + + + + 91 + + + + +Introduction to Gofer 14.4.6 The monomorphism restriction + + + will not be accepted because the monomorphism restriction forces + the local definition of "twiceMembers" to be restricted to a + single overloading (the dictionary parameter supplied to each use + of members must be constant throughout the local definition): + + ERROR "ex" (line 12): Type error in type signature expression + *** term : twiceMembers + *** type : [(Bool,Bool)] + *** does not match : [Bool] + ? + + Once again, this problem can be fixed using an explicit type + declaration: + + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers :: Finite a => [a] + twiceMembers = members ++ members + + +Formal definition: +------------------ +The examples above describe the motivation for the monomorphism +restriction, captured by the following definition: + +Dictionary variables will not be used as extra parameters in the +definition of a value in a given declaration group G if: + + either: G includes a pattern binding + + or: G includes a variable declaration, but does not include an + explicit type signature for any of the variables in the + group. + +If neither of these conditions hold, then equivalent sets of dictionary +parameters will be added to each declaration in the group. + + + + + + + + + + + + + + + + + + + + + + + 92 + + diff --git a/docs/gofer.1 b/docs/gofer.1 new file mode 100644 index 0000000..612fc52 --- /dev/null +++ b/docs/gofer.1 @@ -0,0 +1,170 @@ +.TH GOFER 1 +.\" ***Local system maintainers should correct the following string def *** +.ds GL /usr/local/lib/Gofer +.SH NAME +gofer, gofc \- Gofer programming language interpreter and compiler + +.SH SYNOPSIS +.B gofer + +.B gofc [file] ... + +.SH DESCRIPTION +Gofer is an interactive functional programming environment (i.e. an +interpreter) supporting a language based on the draft report for Haskell +version 1.2, including the following features: +.PD 0 +.TP 10 + o Lazy functional language features such as +lazy evaluation, higher order functions, pattern matching, +etc. +.TP + o Wide range of built-in types +with provision for defining new free +datatypes and type synonyms. +.TP + o Polymorphic type system +with provision for overloading based on +a system of type classes. +.TP + o Full Haskell 1.2 expression and pattern syntax +including lambda, +case, conditional and let expressions, list comprehensions, operator +sections, and wildcard, as and irrefutable patterns. +.TP + o Partial implementation of Haskell 1.2 I/O +enabling +the use of simple interactive programs and programs reading and writing +text files. +.TP + o Constructor classes and overloaded monad comprehensions. +.TP + o Simple minded compiler/translator gofc +with runtime system for +generation of standalone applications. +.TP + o Runs on PC compatible computers, +but also works on Sun and other workstations. +.PP +Gofer is intended as an experimental language, particularly where type classes +are involved. Gofer extends the Haskell type class system in several ways: +.TP + o Type classes with multiple parameters. +.TP + o Instances of type classes +may be defined non-overlapping, +but otherwise arbitrary types. +.TP + o Predicates in contexts +may involve arbitrary type expressions, +not just type variables as in Haskell. +.TP + o Basic approach to dictionary construction is different, +based on the +approach described in a posting to the Haskell mailing list early in +Feburary 1991. The resulting system ensures that all dictionaries are +constructed before evaluation begins, avoiding repeated construction +and enabling the shared evaluation of overloaded constants in +dictionaries. +.PP +The most significant features of Haskell not currently supported are: +modules, arrays, overloaded numeric constants, default declarations, derived +instances, contexts in datatype definitions. + +.SH INTERPRETER +.PP +The Gofer interpreter is usually entered by giving the command `gofer'. +.PP +Most commands in Gofer take the form of a colon followed by one or more +characters which distinguish one command from another. There are two +commands which are particularly worth remembering: +.TP + o :q exits the Gofer interpreter. +On most systems, you can also +exit from Gofer by typing the end of file character (^D). +.TP + o :? prints a list of all the commands, +which can be useful if you +forget the name of the command that you want to use. +.PP +Note that the interrupt key (^C on most systems) can be used at any +time whilst using Gofer to abandon the process of reading in a file of +function definitions or the evaluation of an expression. When the +interrupt key is detected, Gofer prints the string "{Interrupted!}" and +prints the "? " prompt so that further commands can be entered. + +.SH COMPILER +.PP +Compiling a program with gofc is very much like starting up the Gofer +interpreter. The compiler starts by reading the prelude and then +loads the script files specified by the command line. These scripts +must contain a definition for the value main :: Dialogue which will be +the dialogue expression that is evaluated when the compiled program is +executed. +.PP +For example, if the file apr1.gs contains the simple program: +.RS + main :: Dialogue + main = appendChan "stdout" "Hello, world\\n" exit done +.RE +then this can be compiled with the following command. +.RS + gofc apr1.gs +.RE +The output is written to the file apr1.c -- i.e. the name obtained by +removing the .gs suffix and replacing it with a .c suffix. Other +filename suffixes that are treated in a similar way are: +.RS + .prj .gp for Gofer project files + .prelude for Gofer prelude files + .gof .gs for Gofer scripts + .has .hs for Haskell scripts + .lhs .lit for literate scripts + .lgs .verb +.RE +If no recognized suffix is found then the name of the output file is +obtained simply by appending the .c suffix to the input name. +Be careful; if you take an input +file called `prog' and compile it to `prog.c' using gofc, make sure +that you do not compile the C program in such a way that the output is +also called `prog' since this will overwrite your original source code! +For this reason, you should always using file extensions such as .gs +if you are using gofc. +.PP +If you run gofc with multiple script files, then the name of the output +file is based on the last script file to be loaded. For example, the +command `gofc prog1.gs prog2.gs' produces an output file `prog2.c'. +.PP +The compiler gofc also works with project files, +using the name of the project file +to determine the name of the output file. For example, the miniProlog +interpreter can be compiled using: +.RS + gofc + miniProlog.prj +.RE +.PP +You can also specify Gofer command line options as part of the command +line used to run gofc. Think of it like this; use exactly the same +command line to start Gofc as you would have done to start Gofer (ok, +replacing the command `gofer' with `gofc') so that you could start your +program immediately by evaluating the main expression. + +.SH FILES +The files in \*(GL/lib contain various preludes and header files for +the Gofer compiler. + +.SH "SEE ALSO" +Documentation about how to run the system is in the directory +.RS + \*(GL/docs +.RE +For starters see the file ch03 in that directory. +See the file release.228 in that directory for more about the compiler. +.PP +sml(1) + +.SH AUTHOR +Gofer was written by Mark P. Jones and has benefited greatly +from suggestions, comments and bug reports from its users. This manual +page was prepared by Gary Leavens. + diff --git a/docs/gofer.c b/docs/gofer.c new file mode 100644 index 0000000..1b80478 --- /dev/null +++ b/docs/gofer.c @@ -0,0 +1,169 @@ +.\" *** The original version of this man page was prepared by Gary Leavens. +.TH GOFER 1 +.\" ***Local system maintainers should correct the following string def *** +.ds GL /usr/local/lib/Gofer +.SH NAME +gofer, gofc \- Gofer programming language interpreter and compiler + +.SH SYNOPSIS +.B gofer + +.B gofc [file] ... + +.SH DESCRIPTION +Gofer is an interactive functional programming environment (i.e. an +interpreter) supporting a language based on the draft report for Haskell +version 1.2, including the following features: +.PD 0 +.TP 10 + o Lazy functional language features such as +lazy evaluation, higher order functions, pattern matching, +etc. +.TP + o Wide range of built-in types +with provision for defining new free +datatypes and type synonyms. +.TP + o Polymorphic type system +with provision for overloading based on +a system of type classes. +.TP + o Full Haskell 1.2 expression and pattern syntax +including lambda, +case, conditional and let expressions, list comprehensions, operator +sections, and wildcard, as and irrefutable patterns. +.TP + o Partial implementation of Haskell 1.2 I/O +enabling +the use of simple interactive programs and programs reading and writing +text files. +.TP + o Constructor classes and overloaded monad comprehensions. +.TP + o Simple minded compiler/translator gofc +with runtime system for +generation of standalone applications. +.TP + o Runs on PC compatible computers, +but also works on Sun and other workstations. +.PP +Gofer is intended as an experimental language, particularly where type classes +are involved. Gofer extends the Haskell type class system in several ways: +.TP + o Type classes with multiple parameters. +.TP + o Instances of type classes +may be defined non-overlapping, +but otherwise arbitrary types. +.TP + o Predicates in contexts +may involve arbitrary type expressions, +not just type variables as in Haskell. +.TP + o Basic approach to dictionary construction is different, +based on the +approach described in a posting to the Haskell mailing list early in +Feburary 1991. The resulting system ensures that all dictionaries are +constructed before evaluation begins, avoiding repeated construction +and enabling the shared evaluation of overloaded constants in +dictionaries. +.PP +The most significant features of Haskell not currently supported are: +modules, arrays, overloaded numeric constants, default declarations, derived +instances, contexts in datatype definitions. + +.SH INTERPRETER +.PP +The Gofer interpreter is usually entered by giving the command `gofer'. +.PP +Most commands in Gofer take the form of a colon followed by one or more +characters which distinguish one command from another. There are two +commands which are particularly worth remembering: +.TP + o :q exits the Gofer interpreter. +On most systems, you can also +exit from Gofer by typing the end of file character (^D). +.TP + o :? prints a list of all the commands, +which can be useful if you +forget the name of the command that you want to use. +.PP +Note that the interrupt key (^C on most systems) can be used at any +time whilst using Gofer to abandon the process of reading in a file of +function definitions or the evaluation of an expression. When the +interrupt key is detected, Gofer prints the string "{Interrupted!}" and +prints the "? " prompt so that further commands can be entered. + +.SH COMPILER +.PP +Compiling a program with gofc is very much like starting up the Gofer +interpreter. The compiler starts by reading the prelude and then +loads the script files specified by the command line. These scripts +must contain a definition for the value main :: Dialogue which will be +the dialogue expression that is evaluated when the compiled program is +executed. +.PP +For example, if the file apr1.gs contains the simple program: +.RS + main :: Dialogue + main = appendChan "stdout" "Hello, world\\n" exit done +.RE +then this can be compiled with the following command. +.RS + gofc apr1.gs +.RE +The output is written to the file apr1.c -- i.e. the name obtained by +removing the .gs suffix and replacing it with a .c suffix. Other +filename suffixes that are treated in a similar way are: +.RS + .prj .gp for Gofer project files + .prelude for Gofer prelude files + .gof .gs for Gofer scripts + .has .hs for Haskell scripts + .lhs .lit for literate scripts + .lgs .verb +.RE +If no recognized suffix is found then the name of the output file is +obtained simply by appending the .c suffix to the input name. +Be careful; if you take an input +file called `prog' and compile it to `prog.c' using gofc, make sure +that you do not compile the C program in such a way that the output is +also called `prog' since this will overwrite your original source code! +For this reason, you should always using file extensions such as .gs +if you are using gofc. +.PP +If you run gofc with multiple script files, then the name of the output +file is based on the last script file to be loaded. For example, the +command `gofc prog1.gs prog2.gs' produces an output file `prog2.c'. +.PP +The compiler gofc also works with project files, +using the name of the project file +to determine the name of the output file. For example, the miniProlog +interpreter can be compiled using: +.RS + gofc + miniProlog.prj +.RE +.PP +You can also specify Gofer command line options as part of the command +line used to run gofc. Think of it like this; use exactly the same +command line to start Gofc as you would have done to start Gofer (ok, +replacing the command `gofer' with `gofc') so that you could start your +program immediately by evaluating the main expression. + +.SH FILES +The files in \*(GL/lib contain various preludes and header files for +the Gofer compiler. + +.SH "SEE ALSO" +Documentation about how to run the system is in the directory +.RS + \*(GL/docs +.RE +For starters see the file ch03 in that directory. +See the file release.228 in that directory for more about the compiler. +.PP +sml(1) + +.SH AUTHOR +Mark P. Jones + diff --git a/docs/goferdoc.tex b/docs/goferdoc.tex new file mode 100644 index 0000000..2b58bdf --- /dev/null +++ b/docs/goferdoc.tex @@ -0,0 +1,6927 @@ +\documentstyle[a4,fleqn]{report} +\begin{document} +\title{{\Huge\bf GOFER}} +\author{{\Large Mark P.\ Jones}} + +\newcommand{\I}[1]{\mbox{{\it #1}}} +\newcommand{\TT}[1]{\mbox{{\tt #1}}} +\newcommand{\T}[1]{\fbox{\rule[-0.5ex]{0ex}{2ex}\tt #1}} +%\newcommand{\T}[1]{\fbox{\tt #1}} +\newcommand{\sub}{[} +\newcommand{\bus}{]} + +\newcommand{\BQ}{\begin{quote}} +\newcommand{\EQ}{\end{quote}} +\newcommand{\BI}{\begin{itemize}} +\newcommand{\EI}{\end{itemize}} +\newcommand{\BSI}{\begin{simpleitemize}} +\newcommand{\ESI}{\end{simpleitemize}} +\newcommand{\IT}{\item} +\newcommand{\bottom}{\perp} + +\newenvironment{simpleitemize}{% +\begin{list}{$\bullet$}{ +\parsep = 0pt +\parskip = 0pt +\topsep = 0pt +\itemsep = 0pt +}}{\end{list}} + + +\maketitle + + +{ +\parskip=3pt +\parindent=0pt +\begin{verbatim} + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ +\end{verbatim} +\begin{center} +Functional programming environment, Version 2.20\\ +\copyright\ Copyright Mark P.\ Jones 1991. +\end{center} +\vspace{2cm} + +\begin{center} +{\large\bf An Introduction to Gofer}\\ +draft version only \\ +please report any errors, suggestions for improvements, \\ +extensions (or deletions!) to {\tt jones-mark@cs.yale.edu} \\[2em] +This version includes a number of small corrections \\ +made since the original release. +\end{center} + +\newpage + + Permission to use, copy, modify, and distribute this software and its + documentation for any personal or educational use without fee is hereby + granted, provided that: +\begin{itemize} +\item + This copyright notice is retained in both source code and + supporting documentation. + +\item + Modified versions of this software are redistributed only if + accompanied by a complete history (date, author, description) of + modifications made; the intention here is to give appropriate + credit to those involved, whilst simultaneously ensuring that any + recipient can determine the origin of the software. + +\item + The same conditions are also applied to any software system + derived either in full or in part from Gofer. +\end{itemize} + + The name `Gofer' is not a trademark, registered or otherwise, and + you are free to mention this name in published material, public and + private correspondence, or other documents without restriction or + obligation. + + Gofer is provided `as is' without express or implied warranty. + +This \LaTeX\ version of the manual was prepared +by Jeroen Fokker ({\tt jeroen@cs.ruu.nl}). +} + + +\tableofcontents + +\setlength{\parindent}{0pt} +\setlength{\parskip}{3pt} + + +% 1. INTRODUCTION. . . . . . . . . . . . . . . . . . . . . . . . . . 1 +% +% 2. BACKGROUND AND ACKNOWLEDGEMENTS . . . . . . . . . . . . . . . . 2 +% +% 3. STARTING GOFER. . . . . . . . . . . . . . . . . . . . . . . . . 4 +% +% 4. USING GOFER - A BASIC INTRODUCTION. . . . . . . . . . . . . . . 5 +% +% 5. STANDARD AND USER-DEFINED FUNCTIONS . . . . . . . . . . . . . . 6 +% +% 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS. . . . . . . . . . . 8 +% +% 7. BUILT-IN TYPES. . . . . . . . . . . . . . . . . . . . . . . . . 12 +% 7.1 Functions . . . . . . . . . . . . . . . . . . . . . . . . . . 12 +% 7.2 Booleans. . . . . . . . . . . . . . . . . . . . . . . . . . . 13 +% 7.3 Integers. . . . . . . . . . . . . . . . . . . . . . . . . . . 13 +% 7.4 Floating point numbers. . . . . . . . . . . . . . . . . . . . 14 +% 7.5 Characters. . . . . . . . . . . . . . . . . . . . . . . . . . 14 +% 7.6 Lists . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15 +% 7.7 Strings . . . . . . . . . . . . . . . . . . . . . . . . . . . 16 +% 7.8 Tuples and the unit type. . . . . . . . . . . . . . . . . . . 18 +% +% 8. ERRORS. . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19 +% 8.1 Errors detected on input. . . . . . . . . . . . . . . . . . . 19 +% 8.2 Errors during evaluation. . . . . . . . . . . . . . . . . . . 19 +% +% 9. MORE ABOUT VALUE DECLARATIONS . . . . . . . . . . . . . . . . . 21 +% 9.1 Simple pattern matching . . . . . . . . . . . . . . . . . . . 21 +% 9.2 Guarded equations . . . . . . . . . . . . . . . . . . . . . . 23 +% 9.3 Local definitions . . . . . . . . . . . . . . . . . . . . . . 24 +% 9.4 Recursion with integers . . . . . . . . . . . . . . . . . . . 24 +% 9.5 Recursion with lists. . . . . . . . . . . . . . . . . . . . . 26 +% 9.6 Lazy evaluation . . . . . . . . . . . . . . . . . . . . . . . 27 +% 9.7 Infinite data structures. . . . . . . . . . . . . . . . . . . 29 +% 9.8 Polymorphism. . . . . . . . . . . . . . . . . . . . . . . . . 30 +% 9.9 Higher-order functions. . . . . . . . . . . . . . . . . . . . 31 +% 9.10 Variable declarations . . . . . . . . . . . . . . . . . . . . 32 +% 9.11 Pattern bindings and irrefutable patterns . . . . . . . . . . 33 +% 9.12 Type declarations . . . . . . . . . . . . . . . . . . . . . . 35 +% +% 10. INCREASING YOUR POWER OF EXPRESSION. . . . . . . . . . . . . . 37 +% 10.1 Arithmetic sequences. . . . . . . . . . . . . . . . . . . . . 37 +% 10.2 List comprehensions . . . . . . . . . . . . . . . . . . . . . 38 +% 10.3 Lambda expressions. . . . . . . . . . . . . . . . . . . . . . 41 +% 10.4 Case expressions. . . . . . . . . . . . . . . . . . . . . . . 42 +% 10.5 Operator sections . . . . . . . . . . . . . . . . . . . . . . 43 +% 10.6 Explicitly typed expressions. . . . . . . . . . . . . . . . . 44 +% +% 11. USER-DEFINED DATATYPES AND TYPE SYNONYMS . . . . . . . . . . . 46 +% 11.1 Datatype definitions. . . . . . . . . . . . . . . . . . . . . 46 +% 11.2 Type synonyms . . . . . . . . . . . . . . . . . . . . . . . . 47 +% +% 12. DIALOGUES: INPUT AND OUTPUT. . . . . . . . . . . . . . . . . . 49 +% 12.1 Basic description . . . . . . . . . . . . . . . . . . . . . . 49 +% 12.2 Continuation style I/O. . . . . . . . . . . . . . . . . . . . 52 +% 12.3 Interactive programs. . . . . . . . . . . . . . . . . . . . . 55 +% +% 13. LAYOUT . . . . . . . . . . . . . . . . . . . . . . . . . . . . 57 +% 13.1 Comments. . . . . . . . . . . . . . . . . . . . . . . . . . . 57 +% 13.2 The layout rule . . . . . . . . . . . . . . . . . . . . . . . 57 +% +% 14. OVERLOADING IN GOFER . . . . . . . . . . . . . . . . . . . . . 61 +% 14.1 Type classes and predicates . . . . . . . . . . . . . . . . . 61 +% 14.2 The type class Eq . . . . . . . . . . . . . . . . . . . . . . 62 +% 14.2.1 Implicit overloading. . . . . . . . . . . . . . . . . . . . 62 +% 14.2.2 Instances of class Eq . . . . . . . . . . . . . . . . . . . 63 +% 14.2.3 Testing equality of represented values. . . . . . . . . . . 65 +% 14.2.4 Instance declarations without members . . . . . . . . . . . 66 +% 14.2.5 Equality on function types. . . . . . . . . . . . . . . . . 66 +% 14.2.6 Non-overlapping instances . . . . . . . . . . . . . . . . . 67 +% 14.3 Dictionaries. . . . . . . . . . . . . . . . . . . . . . . . . 68 +% 14.3.1 Superclasses. . . . . . . . . . . . . . . . . . . . . . . . 71 +% 14.3.2 Combining classes . . . . . . . . . . . . . . . . . . . . . 73 +% 14.3.3 Simplified contexts . . . . . . . . . . . . . . . . . . . . 74 +% 14.4 Other issues. . . . . . . . . . . . . . . . . . . . . . . . . 76 +% 14.4.1 Unresolved overloading. . . . . . . . . . . . . . . . . . . 76 +% 14.4.2 `Recursive' dictionaries. . . . . . . . . . . . . . . . . . 79 +% 14.4.3 Classes with multiple parameters. . . . . . . . . . . . . . 81 +% 14.4.4 Overloading and numeric values. . . . . . . . . . . . . . . 83 +% 14.4.5 Constants in dictionaries . . . . . . . . . . . . . . . . . 86 +% 14.4.6 The monomorphism restriction. . . . . . . . . . . . . . . . 88 +% +% APPENDIX A: SUMMARY OF GRAMMAR . . . . . . . . . . . . . . . . . . 93 +% +% APPENDIX B: CONTENTS OF STANDARD PRELUDE . . . . . . . . . . . . . 97 +% +% APPENDIX C: RELATIONSHIP WITH HASKELL 1.1. . . . . . . . . . . . .111 +% +% APPENDIX D: USING GOFER WITH BIRD+WADLER . . . . . . . . . . . . .115 +% +% APPENDIX E: PRIMITIVES . . . . . . . . . . . . . . . . . . . . . .117 +% +% APPENDIX F: INTERPRETER COMMAND SUMMARY. . . . . . . . . . . . . .119 +% +% APPENDIX G: BIBLIOGRAPHY . . . . . . . . . . . . . . . . . . . . .121 +% +% + +\chapter{Introduction} + +Gofer is a functional programming environment (in other words, an +interpreter) that I have implemented for my own personal use as part of +my research into `qualified types'. Nevertheless, the system is +sufficiently complete for me to believe that Gofer may be of interest +and use to others interested in the field of functional programming. + +These notes give a brief introduction to the Gofer system and include +some examples of Gofer programs. They are not the notes that I +originally intended to write, being somewhat longer and perhaps more +tutorial in nature. Nevertheless, you will not be able to learn +functional programming from this document alone. A number of useful +references are given in the reading list at the end of this document. +In particular, the book by Bird and Wadler [1] is particularly good as +a general introduction to the use, techniques and theory of functional +programming. Although their notation is a little different from the +language used by Gofer, it is a relatively straightforward task to +translate between the two, and some suggestions for this are given in a +appendix D. More importantly, the underlying semantics of Gofer do +correspond to those expected by the authors of [1]. + +Whereas the work involved in investigating and implementing the ideas +on which Gofer is based were motivated largely by my own program of +work, the writing of these notes has rather more to do with the hope +that Gofer will be useful to others. I would therefore be very +grateful for any feedback on any aspect of the these notes (or of the +Gofer system itself). Please let me know if you discover any errors, +or if you find particular sections of these notes rather hard to +follow. Suggestions for improvements or extensions are more than +welcome. + +\chapter{Background and acknowledgements} + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell [5]. My +principal task in the implementation of Gofer has therefore been to +decide which features I should omit and then to implement what +remains. Features common to both include: +\BSI +\item Non-strict semantics (lazy evaluation). +\item Higher-order functions. +\item Extended polymorphic type system with support for user-defined + overloading. +\item User-defined algebraic datatypes. +\item Pattern matching. +\item List comprehensions. +\item Facilities for I/O, whilst retaining referential transparency + within a program. +\ESI +For the benefit of readers familiar with Haskell, the following +features of Haskell are not supported in the standard version of Gofer: +\BSI +\IT Modules. +\IT Arrays. +\IT Defaults for unresolved overloading. +\IT Derived instances of standard classes. +\IT Contexts in datatype definitions. +\IT Full range of numeric types and classes. +\ESI +But Gofer is not just a partial implementation of Haskell; it also +includes a number of experimental features which extend the type system +in several ways: +\BSI +\IT An alternative approach to type classes which avoids the need for + construction of dictionaries during the evaluation of an + expression. +\IT Type classes may take multiple parameters. +\IT Instances of type classes may be defined at arbitrary + non-overlapping types. +\IT Contexts may include arbitrary type expressions. +\ESI +These extensions stem from my own research [8, 9, 10, 11, 12] and were +among the principal motivations for the development of Gofer. Full +details of the differences between Gofer and Haskell 1.1 are given in +appendix C. + +Gofer would not have been implemented without my original introduction +to functional programming using Orwell [6], and I am particularly +grateful to Quentin Miller for answering so many of my questions about +functional programming and about the Orwell system in particular. I +should also like to mention the influence of the Haskell B. compiler +from Lennart Augustsson and Thomas Johnsson and based on their earlier +LML compiler [7]. + +Right from the beginning, I wanted to be able to use Gofer on a range +of machines - and in particular, on the humble PC that I use at home. +With this in mind, Gofer was actually developed on that same PC using +Borland's Turbo C 1.5 and a public domain version of the yacc parser +generator that I picked up some time ago. Gofer was also written with +some degree of portability in mind and has subsequently been compiled +to run on Sun workstations. I hope it will also be possible to port it +to other platforms. It is my intention that Gofer be distributed +complete with source code and I hope that this will be of interest to +some users. + +Many of the ideas used in the back-end of the Gofer system (i.e.\ the +compiler and abstract machine) originate from the chapters of Simon +Peyton Jones textbook [2]; I very much doubt whether Gofer would have +been completed without frequent reference to that book. The +lambda-lifter used in Gofer is based on Thomas Johnsson's algorithm +described in [3]. + +On the theoretical side, I'm grateful to Phil Wadler for the +encouragement that he has given me with my work on qualified types. +Many of the basic ideas that I have used were inspired by his original +paper motivating the use of type classes [4]. + +\chapter{Starting Gofer} + +The Gofer interpreter is usually entered by giving the command {\tt gofer}, +after which a display something like the following will normally be +produced: +\begin{verbatim} + Gofer Version 2.20 + + Reading script file "/gofer/prelude": + Parsing........................................................ + Dependency analysis............................................ + Type checking.................................................. + Compiling...................................................... + + Gofer session for: + /gofer/prelude + Type :? for help + ? +\end{verbatim} +The file name \verb"/gofer/prelude" mentioned in the output above is the +name of a file of standard definitions which are loaded into Gofer each +time that the interpreter is started. By default, Gofer reads these +definitions from a file called \verb"prelude" in the current working +directory. Alternatively you can set the environment variable \verb"GOFER" to +the name of the standard prelude file, which will then be used, +whatever the current working directory might be. + +Most commands in Gofer take the form of a colon followed by one or more +characters which distinguish one command from another. There are two +commands which are particularly worth remembering: +\BI +\IT \verb":q" exits the Gofer interpreter. On most systems, you can also + exit from Gofer by typing the end of file character (\verb=^Z= on an + {\sc ms-dos} machine, usually \verb=^D= on a Unix based machine). +\IT \verb":?" prints a list of all the commands, which can be useful if you + forget the name of the command that you want to use. +\EI +The complete range of commands supported by the Gofer interpreter is +described in appendix F. + +Note that the interrupt key (\verb=^C= on most systems) can be used at any +time whilst using Gofer to abandon the process of reading in a file of +function definitions or the evaluation of an expression. When the +interrupt key is detected, Gofer prints the string \verb={Interrupted!}= and +prints the `\verb=? =' prompt so that further commands can be entered. + + +\chapter{Using Gofer} % - a basic introduction + +Using Gofer is rather like using a high-level programmable calculator; +Once the interpreter is loaded, the system prints a prompt \verb"?" and +waits for you to enter an expression, and then press the enter (return) +key. Once the input is complete, Gofer evaluates the expression and +prints its value on the terminal, before returning to the original +prompt and waiting for the next expression. For example: +\begin{verbatim} + ? (2+3)*8 + 40 + (5 reductions, 9 cells) + ? sum [1..10] + 55 + (91 reductions, 130 cells) + ? +\end{verbatim} +In the first example, the user entered the expression \verb"(2+3)*8", which +was evaluated by Gofer and the result \verb"40" printed on the terminal. At +the end of any calculation, Gofer displays the number of reductions (a +measure of the amount of work) and cells (a measure of the amount of +memory) that were used during the calculation. These figures can be +useful for comparing the performance of different ways of carrying out +the same calculation. + +In the second example, the user typed the expression \verb"sum [1..10]". +The notation \verb"[1..10]" represents the list of integers between 1 and 10 +inclusive, and \verb"sum" is a standard function which can be used to +determine the sum of a list of integers. Thus the result obtained by +Gofer is: +\[ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 = 55 +\] +We could have typed this sum into Gofer directly: +\begin{verbatim} + ? 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 55 + (10 reductions, 23 cells) + ? +\end{verbatim} +and this calculation is certainly more efficient as it uses only +$\frac{1}{9}$th of the number of reductions and +$\frac{1}{5}$th of the number of cells as the +original calculation. On the other hand, the original expression is +much shorter and you are much less likely to make a mistake typing in +the expression \verb"sum [1..200]" than you would be if you tried to enter +the sum of the integers from 1 to 200 directly. + +You will learn more about the kind of expressions that can be entered +into Gofer in the rest of this document. + + +\chapter{Standard and user-defined functions} + +The function \verb"sum" used in the examples above, and indeed the addition +and multiplication functions ($+$) and ($*$), are all standard functions +which are included as part of a large collection of functions called +the `standard prelude' which are loaded into the Gofer system each time +that you start the interpreter. Quite a number of useful calculations +can be carried out using these functions alone, but for more general +use you can also define your own functions and store the definitions in +a file so that these functions can be loaded and used by by the Gofer +system. For example, suppose that you create a file \verb"fact" containing +the following definition: +\begin{verbatim} + fact n = product [1..n] +\end{verbatim} +The \verb"product" function is another standard function which can be used +to calculate the product of a list of integers, and so the line above +defines a function \verb"fact" which calculates the factorial of its +argument. In standard mathematical notation, $\I{fact}\; n = n!$ which is +usually defined informally by an equation of the form: +\[ + n! = 1 * 2 * \cdots * (n-1) * n +\] +Once you become familiar with the notation used by Gofer, you will see +that the Gofer definition of the factorial function is really very +similar to this informal mathematical definition. + +In order to use this definition from the Gofer interpreter, we must +first load the definitions of the file into the interpreter. The +simplest way to do this uses the \verb":l" command: +\begin{verbatim} + ? :l fact + Reading script file "fact": + Parsing...................................................... + Dependency analysis.......................................... + Type checking................................................ + Compiling.................................................... + + Gofer session for: + /gofer/prelude + fact + ? +\end{verbatim} +Notice the list of filenames displayed after \verb"Gofer session for:"; this +tells you which files of definitions are currently being used by Gofer, +the first of which is the file containing the definitions for the +standard prelude. Since the file containing the definition of the +factorial function has now been loaded, we can make use of this +function in expressions entered to the interpreter: +\begin{verbatim} + ? fact 6 + 720 + (57 reductions, 85 cells) +\end{verbatim} +For another example, recall the standard mathematical formula which +tells us that the number of ways of choosing $r$ objects from a +collection of $n$ objects is given by $n! / (r! * (n-r)!)$. In Gofer, this +function can be defined by: +\begin{verbatim} + comb n r = fact n /(fact r * fact (n-r)) +\end{verbatim} +In order to use this function, we can either edit the file \verb"fact" which +contains the definition of the factorial function, adding the +definition of \verb"comb" on a new line, or we can include the definition as +part of an expression entered whilst using Gofer: +\begin{verbatim} + ? comb 5 2 where comb n r = fact n /(fact r * fact (n-r)) + 10 + (110 reductions, 161 cells) + ? +\end{verbatim} +The ability to define a function as part of an expression like this is +often quite useful. However, if the function \verb"comb" were likely to be +wanted on a number of occasions, it would be more sensible to add its +definition to the contents of the file \verb"fact", instead of having to +repeat the definition each time it is used. + +You will learn more about the functions defined in the standard prelude +and find out how to define your own functions in the following +sections. + +\chapter{Function names: identifiers and operators} + +As the examples of the previous section show, there are two kinds of +name that can be used for a function; identifiers such as \verb"sum" and +operator symbols such as \verb"+" and \verb"*". +Choosing the appropriate kind of +name for a particular function can often help to make expressions +involving that function easier to read. If for example the addition +function was represented by the name \verb"plus" rather than the operator +symbol \verb"+" then the sum of the integers from 1 to 5 would have to be +written as: +\begin{verbatim} + plus (plus (plus (plus 1 2) 3) 4) 5 +\end{verbatim} +In this particular case, another way of writing the same sum is: +\begin{verbatim} + plus 1 (plus 2 (plus 3 (plus 4 5))) +\end{verbatim} +Not only does the use of the identifier \verb"plus" make these expressions +larger and more difficult to read than the equivalent expressions using +\verb"+"; it also makes it very much harder to see that these two +expressions do actually have the same value. + +Gofer distinguishes between the two types of name according to the way +that they are written: +\BI +\IT An identifier begins with a letter of the alphabet optionally + followed by a sequence of characters, each of which is either a + letter, a digit, an apostrophe (\verb='=) or an underbar + (\verb=_=). + Identifiers representing functions or variables must begin with a + lower case letter (identifiers beginning with an upper case letter + are used to denote a special kind of function called a + `constructor function' described in section 11.1). The following + identifiers are examples of Gofer variable and function names: +\begin{verbatim} + sum f f'' integerSum african_queen do'until'zero +\end{verbatim} + The following identifiers are reserved words in Gofer and cannot + be used as the name of a function or variable: +\begin{verbatim} + case of where let in if + then else data type infix infixl + infixr primitive class instance +\end{verbatim} +\IT An operator symbol is written using one or more of the following + symbol characters: +\begin{verbatim} + : ! # $ % & * + . / < = > ? @ \ ^ | - +\end{verbatim} + In addition, the tilde character (\verb=~=) is also permitted, although + only in the first position of an operator name\footnote{Haskell + also makes the same restriction for the minus/dash character + (\verb=-=).}. Operator names beginning with a colon are used for + constructor functions in the same way as identifiers beginning + with a capital letter as mentioned above. In addition, the + following operator symbols have special uses in Gofer: +\begin{verbatim} + :: = .. @ \ | <- -> ~ => +\end{verbatim} + All other operator symbols can be used as variables or function + names, including each of the following examples: +\begin{verbatim} + + ++ && || <= == /= // . + ==> $ @@ -*- \/ /\ ... ? +\end{verbatim} + Note that each of the symbols in the first line is used in the + standard prelude. If you are interested in using Gofer to develop + programs for use with a Haskell compiler, you might also want to + avoid using the operator symbols \verb":=", + \verb"!", \verb":+" and \verb":%" which are used to + support features in Haskell not currently provided by the Gofer + standard prelude. +\EI +Gofer provides two simple mechanisms which make it possible to use an +identifier as an operator symbol, or an operator symbol as an +identifier: +\BI +\IT Any identifier will be treated as an operator symbol if it is + enclosed in backquotes (\verb=`=) -- for example, the expressions using + the \verb"plus" function above are a little easier to read using this + technique: +\begin{verbatim} + (((1 `plus` 2) `plus` 3) `plus` 4) `plus` 5 +\end{verbatim} + In general, an expression of the form \verb"x `op` y" is equivalent to + the corresponding expression \verb"op x y", whilst an expression such + as \verb"f x y z" can also be written as \verb"(x `f` y) z".% + \footnote{For those using Gofer on a PC, you may find that your + keyboard does not have a backquote key! In this case you should + still be able to enter a backquote by holding down the key marked + ALT, pressing the keys `9' and then `6' on the numeric keypad and + then releasing the ALT key.} +\IT Any operator symbol can be treated as an identifier by enclosing + it in parentheses. For example, the addition function denoted by + the operator symbol \verb"+" is often written as \verb"(+)". + Any expression + of the form \verb"x + y" can also be written in the form \verb"(+) x y". +\EI +There are two more technical problems which have to be dealt with when +working with operator symbols: +\BI +\IT Precedence: Given operator symbols $(+)$ and + $(*)$, should $2*3+4$ + be treated as either $(2*3)+4$ or $2*(3+4)$? + + This problem is solved by assigning each operator a precedence + value (an integer in the range 0 to 9). In a situation such as + the above, we simply compare the precedence values of the + operators involved, and carry out the calculation associated + with the highest precedence operator first. The standard + precedence values for $(+)$ and $(*)$ + are 6 and 7 respectively so that + the expression above will actually be treated as $(2*3)+4$. + +\IT Grouping: The above rule is only useful when the operator symbols + involved have distinct precedences. For example, should the + expression $1-2-3$ be treated as either + $(1-2)-3$ giving a + result of $-4$, or as $1-(2-3)$ giving a result of $2$? + + This problem is solved by giving each operator a `grouping' + (sometimes called its associativity). An operator symbol $(\oplus)$ is + said to: + \BI + \IT group to the left if $x \oplus y \oplus z$ + is treated as $(x \oplus y) \oplus z$ + \IT group to the right if $x \oplus y \oplus z$ + is treated as $x \oplus (y \oplus z)$ + \EI + A third possibility is that an expression of the form + $x \oplus y \oplus z$ + is to be treated as ambiguous and will be flagged as a syntax + error. In this case we say that the operator $(\oplus)$ is + non-associative. + + The standard approach in Gofer is to treat $(-)$ as grouping to the + left so that $1 - 2 - 3$ will actually be treated as $(1-2)-3$. +\EI +By default, every operator symbol in Gofer is treated as +non-associative with precedence 9. These values can be changed by a +declaration of one of the following forms: +\BQ +\begin{tabular}{ll} + {\tt infixl digit ops} & to declare operators which group to the left\\ + {\tt infixr digit ops} & to declare operators which group to the right\\ + {\tt infix digit ops} & to declare non-associative operators +\end{tabular} +\EQ +In each of these declarations \verb"ops" represents a list of one or more +operator symbols separated by commas and \verb"digit" is an integer between 0 +and 9 which gives the precedence value for each of the listed operator +symbols. The precedence digit may be omitted in which case a value of +9 is assumed. There are a number of restrictions on the use of these +declarations: +\BI +\IT Operator declarations can only appear in files of function + definitions which are loaded into Gofer; they cannot be entered + directly whilst using the Gofer interpreter. + +\IT At most one operator declaration is permitted for any particular + operator symbol (even if repeated declarations all specify the + same precedence and grouping as the original declaration). + +\IT Any file containing a declaration for an operator precedence and + grouping must also contain a (top-level) declaration for that + operator. +\EI +In theory, it is possible to use an operator declaration at any point +in a file of definitions. In practice, it is sensible to ensure that +each operator is declared before the symbol is used. One way to +guarantee this is to place all operator declarations at the beginning +of the file [this condition is enforced in Haskell]. Note that until +an operator declaration for a particular symbol is encountered, any +occurrence of that symbol will be treated as a non-associative operator +with precedence 9. + +The following operator declarations are taken from the standard prelude: +\begin{verbatim} + -- Operator precedence table + + infixl 9 !! + infixr 9 . + infixr 8 ^ + infixl 7 * + infix 7 /, `div`, `rem`, `mod` + infixl 6 +, - + infix 5 \\ + infixr 5 ++, : + infix 4 ==, /=, <, <=, >=, > + infix 4 `elem`, `notElem` + infixr 3 && + infixr 2 || +\end{verbatim} +and their use is illustrated by the following examples: +\BQ +\begin{tabular}{llp{6cm}} + Expression: & Equivalent to: & Reasons: \\ + \verb"1 + 2 - 3" & \verb"(1 + 2) - 3" & \verb"(+)" and \verb"(-)" + have the same precedence + and group to the left. \\ + \verb"x : ys ++ zs" & \verb"x : (ys ++ zs)" & \verb"(:)" and + \verb"(++)" have the same precedence + and group to the right.\\ + \verb"x == y || z" & \verb"(x == y) || z" & \verb"(==)" has higher + precedence than \verb"(||)".\\ + \verb"3 * 4 + 5" & \verb"(3 * 4) + 5" & \verb"(*)" has higher + precedence than \verb"(+)".\\ + \verb"y `elem` z:zs" & \verb"y `elem` (z:zs)" & \verb"(:)" has higher + precedence than \verb"elem". \\ + \verb"12 / 6 / 3" & syntax error & ambiguous use of \verb"(/)"; + could mean + either \verb"(12/6)/3" or \verb"12/(6/3)". +\end{tabular} +\EQ +Note that function application always binds more tightly than any infix +operator symbol. For example, the expression \verb"f x + g y" is equivalent +to \verb"(f x) + (g y)". Another example which often causes problems is the +expression \verb"f x + 1", +which is treated as \verb"(f x) + 1" and not as +\verb"f (x+1)" as is sometimes expected. + + +\chapter{Built-in types} + +An important part of Gofer is the type system which is used to detect +errors in expressions and function definitions. Starting with +primitive expressions such as numeric constants, Gofer assigns a type +to each expression that describes the kind of value represented by the +expression. + +In general we write \I{object} \verb"::" \I{type} +to indicate that a particular +expression has the indicated type. For example: +\BQ +\begin{tabular}{lp{8cm}} + \verb"42 :: Int" & indicating that 42 is an integer + (\verb"Int" is the + name for the type of integer values).\\ + \verb"fact :: Int -> Int" & indicating that \verb"fact" + is a function which + takes an integer argument and returns an + integer value (its factorial). +\end{tabular} +\EQ +The most important property of the type system is that it is possible +to determine the type of an expression without having to evaluate it. +For example, the information given above is sufficient to determine +that \verb"fact 42 :: Int" without needing to calculate $42!$ first. + +Gofer has a wide range of built-in types, described in the following +sections. In addition, Gofer also includes facilities for defining new +types as well as types acting as abbreviations for complicated type +expressions as described in section 11. + + +\section{Functions} +If \verb"t1" and \verb"t2" are types then \verb"t1 -> t2" +is the type of a function which, +given an argument of type \verb"t1" produces a result of type \verb"t2". +A function +of type \verb"t1 -> t2" is said to have argument type \verb"t1" +and result type \verb"t2". + +In mathematics, the result of applying a function $f$ to an argument $x$ is +traditionally written as $f(x)$. In many situations, these parentheses +are unnecessary and may be omitted when using Gofer. +For example, if \verb"f :: t1 -> t2" and \verb"x :: t1" +then \verb"f x" is the result of applying +\verb"f" to \verb"x" and has type \verb"t2". + + +If $t_1$, $t_2$,\dots , $t_n$ are type expressions then: +\[ + t_1 \to t_2 \to \dots \to t_n +\] +can be used as an abbreviation for the type: +\[ + t_1 \to (t_2 \to ( \dots \to t_n) \dots ) +\] +In a similar way, an expression of the form +$f\; x_1\; x_2 \dots x_n$ is simply an +abbreviation for the expression +$(\dots ((f\; x_1)\; x_2) \dots x_n)$. + +These two conventions allow us to deal with functions taking more than +one argument rather elegantly. For example, the type of the addition +function \verb"(+)" is: +\begin{verbatim} + Int -> Int -> Int +\end{verbatim} +In other words, \verb"(+)" is a function which takes an integer argument and +returns a value of type \verb"(Int -> Int)". For example, +\verb"(+) 5" is the +function which takes an integer value $n$ and returns the value of the +integer $n$ plus 5. Hence \verb"(+) 5 4", which is equivalent to +\verb"5 + 4", +evaluates to the integer 9 as expected. + + +\section{Booleans} +Represented by the type \verb"Bool", there are two boolean values written as +\verb"True" and \verb"False". +The standard prelude includes several useful +functions for manipulating boolean values: +\BI +\IT \verb"(&&), (||) :: Bool -> Bool -> Bool" + + The value of the expression \verb"b && d" is \verb"True" + if and only if both + \verb"b" and \verb"d" are \verb"True". + If \verb"b" is \verb"False" then \verb"d" is not evaluated. + + The value of the expression \verb"b || d" is \verb"True" + if either of \verb"b" or \verb"d" + is \verb"True". If \verb"b" is \verb"True" then \verb"d" + is not evaluated. + +\IT \verb"not :: Bool -> Bool" + + The value of the expression \verb"not b" is the opposite boolean value + to that of \verb"b"; \verb"not True = False", \verb"not False = True". +\EI +Gofer includes a special form of `conditional expression' which enables +an expression to select between two alternatives according to the value +of a boolean expression: +\begin{verbatim} + if b then t else f +\end{verbatim} +is an expression which is equivalent to \verb"t" if \verb"b" +evaluates to \verb"True", or to +\verb"f" if \verb"b" evaluates to \verb"False". +Note that an expression of this form is +only acceptable if \verb"b" is an expression of type \verb"Bool" +and if the types of +\verb"t" and \verb"f" are the same, +in which case the whole expression also has that +type. + + +\section{Integers} +Represented by the type \verb"Int", the integer type includes both positive +and negative integers such as $-273$, $0$ and $383$. Like many computer +systems, the range of integer values that can be used is restricted and +calculations using large positive or negative numbers may lead to +(undetected) overflow. + +A wide range of operators and functions are defined in the standard +prelude for use with integers: +\BQ +\begin{tabular}{ll} + \verb"(+)"& addition\\ + \verb"(*)"& multiplication\\ + \verb"(-)"& subtraction\\ + \verb"(^)"& raise to power\\ + \verb"negate"& unary negation\\ + \verb"(/)"& integer division\\ + \verb"div"& integer division\\ + \verb"rem"& remainder\\ + \verb"mod"& modulo\\ + \verb"odd"& returns \verb"True" if argument is odd, + \verb"False" otherwise\\ + \verb"even"& returns \verb"True" if argument is even, + \verb"False" otherwise\\ + \verb"gcd"& returns the greatest common divisor of its two arguments\\ + \verb"lcm"& returns the least common multiple of its two arguments\\ + \verb"abs"& returns the absolute value of its argument\\ + \verb"signum"& returns $-1$, $0$ or $1$ indicating that its argument + is \\ + & negative, zero or positive respectively +\end{tabular} +\EQ +An expression of the form \verb"-x" is treated +as the expression \verb"negate x". +`Remainder' is related to integer division by the law: +\begin{verbatim} + (x `div` y)*y + (x `rem` y) == x +\end{verbatim} +`Modulo' is like remainder except that the modulo has the same +sign as the divisor. +The less familiar operators are illustrated by the following +identities: +\begin{verbatim} + 3^4 == 81, 7 `div` 3 == 2, even 23 == False + 7 `rem` 3 == 1, -7 `rem` 3 == -1, 7 `rem` -3 == 1 + 7 `mod` 3 == 1, -7 `mod` 3 == 2, 7 `mod` -3 == -2 + gcd 32 12 == 4, abs (-2) == 2, signum 12 == 1 +\end{verbatim} + +\section{Floating point numbers} +Represented by the type \verb"Float", elements of this type can be used to +represent fractional values as well as very large or very small +quantities. Such values are however usually only accurate to a fixed +number of digits and rounding errors may occur in some calculations +making significant use of floating point quantities. A numeric value +in an input expression will only be treated as a floating point number +if it either includes a decimal point such as $3.14159$, or if the number +is too large to be stored as a value of type Int. Scientific notation +may also be used to enter floating point quantities; for example \verb"1.0e3" +is equivalent to $1000.0$, whilst \verb"5.0e-2" is equivalent to $0.05$. +Floating point numbers are not included in all implementations of +Gofer. + + +\section{Characters} +Represented by the type \verb"Char", elements of this type represent +individual characters such as those entered at a keyboard. Character +values are written as single characters enclosed by apostrophe +characters: e.g.\ \verb='a'=, \verb='0'=, \verb='Z'=. +Some special characters must be +entered using an `escape code'; each of these begins with a backslash +character `\verb=\=', followed by one or more characters to select the +required character. Some of the most useful escape codes are: +\BQ +\begin{tabular}{ll} + \verb=\\= & backslash\\ + \verb=\'= & apostrophe\\ + \verb=\"= & double quote\\ + \verb=\n= & newline\\ + \verb=\b= or \verb=\BS= & backspace\\ + \verb=\DEL= & delete\\ + \verb=\t= or \verb=\HT= & tab\\ + \verb=\a= or \verb=\BEL= & alarm (bell)\\ + \verb=\f= or \verb=\FF= & formfeed +\end{tabular} +\EQ +Additional escape characters include: +\BQ +\begin{tabular}{lp{10cm}} + \verb=\^=\I{c} &control character, where \I{c} is replaced by + one of the characters: + \verb"@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" + For example, \verb"'\^A'" represents control-A.\\ + \verb=\=\I{number} &representing the character with {\sc ascii} value + specified by the given decimal \I{number}.\\ + \verb=\o=\I{number}&representing the character with {\sc ascii} value + specified by the given octal \I{number}.\\ + \verb=\x=\I{number}&representing the character with {\sc ascii} value + specified by the given hexadecimal \I{number}.\\ + \verb=\=\I{name} &named {\sc ascii} control character, where + \I{name} is replaced by one of the standard + {\sc ascii} names e.g.\ \verb"'\DC3'". +\end{tabular} +\EQ +In contrast with some common languages (such as C, for example) +character values are quite distinct from integers; however the standard +prelude does include functions: +\begin{verbatim} + ord :: Char -> Int + chr :: Int -> Char +\end{verbatim} +which enable you to map a character to its corresponding {\sc ascii} value, +or from an {\sc ascii} value to the corresponding character: +\begin{verbatim} + ? ord 'a' + 97 + (2 reductions, 6 cells) + ? chr 65 + 'A' + (2 reductions, 7 cells) + ? +\end{verbatim} + +\section{Lists} +If \verb"t" is a type then \verb"[t]" +is the type whose elements are lists of values +of type \verb"t". +There are several ways of writing list expressions: +\BI +\IT The simplest list of any type is the empty list, written \verb"[]". +\IT Non-empty lists can be constructed either by explicitly listing + the members of the list (for example: \verb"[1,3,10]") or by adding a + single element onto the front of another list using the \verb"(:)" + operator (pronounced `cons'). These notations are equivalent: +\begin{verbatim} + [1,3,10] = 1 : [3,10] = 1 : 3 : [10] = 1 : 3 : 10 : [] +\end{verbatim} + (the \verb"(:)" operator groups to the right so + \verb"1:3:10:[]" is + equivalent to \verb"(1:(3:(10:[])))" -- a list whose first element is 1, + second element is 3 and last element is 10). +\EI +The standard prelude includes a wide range of functions for +calculations involving lists. For example: +\BSI +\IT \verb"length xs" returns the number of elements in the list \verb"xs". +\IT \verb"xs ++ ys" returns the list of elements in \verb"xs" followed by the + elements in \verb"ys" +\IT \verb"concat xss" returns the list of elements in each of the lists in + \verb"xss" +\IT \verb"map f xs" returns the list of values obtained by applying the + function \verb"f" to each of the values in the + list \verb"xs" in turn. +\ESI +Here are some examples using these functions: +\begin{verbatim} + ? length [1,3,10] + 3 + (15 reductions, 28 cells) + + ? [1,3,10] ++ [2,6,5,7] + [1, 3, 10, 2, 6, 5, 7] + (19 reductions, 77 cells) + + ? concat [[1], [2,3], [], [4,5,6]] + [1, 2, 3, 4, 5, 6] + (29 reductions, 93 cells) + + ? map ord ['H', 'e', 'l', 'l', 'o'] + [72, 101, 108, 108, 111] + (22 reductions, 73 cells) + + ? +\end{verbatim} +Note that all of the elements in a list must be of the same type, so +that an expression such as \verb"['a', 2, False]" is not permitted. + +At this point it might be useful to mention an informal +convention that is used by a number of functional programmers when +choosing names for variables representing elements of lists, lists +themselves, lists of lists and so on. If for example, a typical +element of a list is called \verb"x", then it is often useful to use the name +\verb"xs" for a list of such values, suggesting that a list contains a number +of `\verb"x"'s. Similarly, a list of lists might be called +\verb"xss". Once you +have understood this convention it is much easier to remember the +relationship between the variables in the expression \verb"(x:xs)" than it +would be if different names had been used such as \verb"(a:b)". + +\section{Strings} +A string is treated as a list of characters and the type \verb"String" is +simply an abbreviation for the type \verb"[Char]". Strings are written as +sequences of characters enclosed between speech marks. All of the +escape codes that can be used for characters may also be used in a +string: +\begin{verbatim} + ? "hello, world" + hello, world + (0 reductions, 13 cells) + + ? "hello\nworld" + hello + world + (0 reductions, 12 cells) + ? +\end{verbatim} +In addition, strings may contain the escape sequence \verb"\&" which can be +used to separate otherwise ambiguous pairs of characters within a +string, e.g.: +\BQ +\begin{tabular}{ll} + \verb"\123h" &represents the string \verb"['\123', 'h']"\\ + \verb"\12\&3h" &represents the string \verb"['\12', '3', 'h']" +\end{tabular} +\EQ +A string expression may be spread over a number of lines using a gap -- +a non-empty sequence of space, tab and new line characters enclosed by +backslash characters: +\begin{verbatim} + ? "hell\ \o" + hello + (0 reductions, 6 cells) + ? +\end{verbatim} +Notice that strings are printed differently from other values, which +gives the programmer complete control over the format of the output +produced by a program. The only values that Gofer can in fact display +on the terminal are strings. If the type of an expression entered into +Gofer is equivalent to String then the expression is printed directly +by evaluating and printing each character in the list in sequence. +Otherwise, the expression to be evaluated, \verb"e", is replaced by the +expression \verb"show' e" where \verb"show'" +is a built-in function (defined as part +of the standard prelude) which converts any value to a printable +representation. The only way of printing a string value in the same +way as any other value is by explicitly using the \verb"show'" function: +\begin{verbatim} + ? show' "hello" + "hello" + (7 reductions, 24 cells) + ? +\end{verbatim} +The careful reader may have been puzzled by the fact the number of +reductions used in the first three examples above was zero. This is in +fact quite correct since these expressions are constants and no further +evaluation can be carried out. For constant expressions of any other +type there will always be at least one reduction needed to print the +value since the constant must first be translated to a printable +representation using the \verb"show'" function. + +Because strings are represented as lists of characters, all of the +standard prelude functions for manipulating lists can also be used with +strings: +\begin{verbatim} + ? length "Hello" + 5 + (22 reductions, 36 cells) + + ? "Hello, " ++ "world" + Hello, world + (8 reductions, 37 cells) + + ? concat ["super","cali","fragi","listic"] + supercalifragilistic + (29 reductions, 101 cells) + + ? map ord "Hello" + [72, 101, 108, 108, 111] + (22 reductions, 69 cells) +\end{verbatim} + +\section{Tuples and the unit type} +If $t_1$, $t_2$, \dots, $t_n$ are types and $n\geq 2$, +then there is a type of $n$-tuples +written $(t_1, t_2, \dots, t_n)$ whose elements are also written in the form +$(x_1, x_2, \dots, x_n)$ where the expressions $x_1$, $x_2$, \dots, $x_n$ +have types $t_1$, +$t_2$, \dots, $t_n$ respectively. For example, +\begin{verbatim} + (1, [2], 3) :: (Int, [Int], Int) + ('a', False) :: (Char, Bool) + ((1,2),(3,4)) :: ((Int, Int), (Int, Int)) +\end{verbatim} +Note that, unlike lists, the elements in a tuple may have different +types, although the number of elements in the tuple is fixed. + +The unit type is written \verb"()" and has a single element which is also +written as \verb"()". The unit type is of particular interest in theoretical +treatments of the type system of Gofer, although you may occasionally +find a use for it in practical programs. + + +\chapter{Errors} + +\section{Errors detected on input} +After an expression has been entered, but before any attempt is made to +evaluate it, Gofer carries out a number of checks to make sure that the +expression that you typed does not contain any errors. Here are some +examples of the kind of problem that might occur: +\BI +\IT Syntax errors. The most common situation in which this happens is + when you make a typing mistake, either leaving out some + characters, or perhaps pressing the wrong keys instead. In the + following example, the user has missed out a `\verb"["' character: +\begin{verbatim} + ? sum 1..100] + ERROR: Syntax error in input (unexpected `..') +\end{verbatim} +\IT Undefined variables. This happens when you enter an expression + using a variable or function name that is not defined in any of + the files of definitions loaded into Gofer. This can often mean + that you have misspelt the name of a function, or that the files + defining a function have not yet been loaded. For example: +\begin{verbatim} + ? sum [1..n] + ERROR: Undefined variable "n" +\end{verbatim} +\IT Type errors. Certain expressions are sensible only when the + functions used in those expressions are applied to values of the + appropriate type. For example, whilst the factorial function can + be used to calculate the factorial of an integer, it is clearly + meaningless to try to determine the factorial of a character + value. This kind of problem can be detected using the types of + the components of an expression. In the expression \verb"fact 'A'", we + can see that the argument \verb"'A'" has type \verb"Char" + which does not match + the argument type Int of the factorial function. This error will + be detected by Gofer if you try to evaluate the expression: +\begin{verbatim} + ? fact 'A' + ERROR: Type error in application + *** expression : fact 'A' + *** term : 'A' + *** type : Char + *** does not match : Int +\end{verbatim} +\EI + +\section{Errors during evaluation} +If no errors are detected in an input expression, Gofer then begins to +evaluate that expression. Despite all of the checks that are carried +out before the evaluation begins, it is still possible for an error to +occur during the evaluation of an expression. A typical example of +this is an attempt to divide a number by zero. In this case, Gofer +prints the part of the expression being evaluated that caused the +error, surrounded by braces `\verb"{"' and `\verb"}"': +\begin{verbatim} + ? 3/0 + {primDivInt 3 0} + (4 reductions, 30 cells) + ? +\end{verbatim} +The function \verb"primDivInt" which appears here is a primitive function +used to divide one integer (its first argument) by another (the +second). If an error occurs in just one part of an expression, +only the part causing the problem will be displayed: +\begin{verbatim} + ? 4 + (5/0) + {primDivInt 5 0} + (5 reductions, 32 cells) + ? +\end{verbatim} +A standard function called \verb"error" is defined in the standard prelude +which is often useful for ensuring that appropriate error messages are +produced when an error occurs: +\begin{verbatim} + ? error "Problem has occurred" + {error "Problem has occurred"} + (23 reductions, 99 cells) + ? +\end{verbatim} + +\chapter{More about value declarations} + +\section{Simple pattern matching} +Although the Gofer standard prelude includes many useful functions, you +will usually need to define a collection of new functions for specific +problems and calculations. The declaration of a function \verb"f" usually +takes the form of a number of equations of the form: +\[ + \TT{f}\; \I{pat}_1\; \I{pat}_2\; \dots\; \I{pat}_n \;\TT{=}\; \I{rhs} +\] +(or an equivalent expression, if \verb"f" is written as by an operator +symbol). Each of the expressions +$\I{pat}_1$, $\I{pat}_2$, \dots, $\I{pat}_n$ +represents an argument to the function \verb"f" and is called a `pattern'. +The number of such arguments is called the arity of \verb"f". +If \verb"f" is +defined by more than one equation then they must be entered together +and each one must give the same arity for \verb"f". + +When a function is defined by more than one equation, it will usually +be necessary to evaluate one or more of the arguments to the function +to determine which equation applies. This process is called +`pattern-matching'. In all of the previous examples we have used only +the simplest kind of pattern -- a variable. As an example, consider +the factorial function defined in section 5: +\begin{verbatim} + fact n = product [1..n] +\end{verbatim} +If we then wish to evaluate the expression \verb"fact 6" we first match the +expression \verb"6" against the pattern \verb"n" +and then evaluate the expression +obtained from \verb"product [1..n]" by replacing +the variable \verb"n" with the +expression \verb"6". The process of matching the arguments of a function +against the patterns in its definition and obtaining another expression +to be evaluated is called a `reduction'. Using Gofer, it is easy to +verify that the evaluation of \verb"fact 6" takes one more reduction than +that of \verb"product [1..6]": +\begin{verbatim} + ? fact 6 + 720 + (57 reductions, 85 cells) + ? product [1..6] + 720 + (56 reductions, 85 cells) + ? +\end{verbatim} +Many kinds of constants such as the boolean values True and False can +also be used in patterns, as in the following definition of the +function \verb"not" taken from the standard prelude: +\begin{verbatim} + not True = False + not False = True +\end{verbatim} +In order to determine the value of an expression of the form \verb"not b", +we must first evaluate the expression \verb"b". If the result is \verb"True" +then we use the first equation and the value of \verb"not b" will be +\verb"False". If the value of \verb"b" is \verb"False", then the second equation is +used and the value of \verb"not b" will be \verb"True". +Other constants, including integers, characters and strings may also be +used in patterns. For example, if we define a function \verb"hello" by: +\begin{verbatim} + hello "Mark" = "Howdy" + hello name = "Hello " ++ name ++ ", nice to meet you!" +\end{verbatim} +then: +\begin{verbatim} + ? hello "Mark" + Howdy + (1 reduction, 12 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? +\end{verbatim} +Note that the order in which the equations are written is very +important because Gofer always uses the first applicable equation. If +instead we had defined the function with the equations: +\begin{verbatim} + hello name = "Hello " ++ name ++ ", nice to meet you!" + hello "Mark" = "Howdy" +\end{verbatim} +then the results obtained using this function would have been a little +different: +\begin{verbatim} + ? hello "Mark" + Hello Mark, nice to meet you! + (13 reductions, 66 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? +\end{verbatim} +There are a number of other useful kinds of pattern, some of which are +illustrated by the following examples: +\BQ +\begin{tabular}{llp{8cm}} + Wildcard: & \verb"_" & matches any value at all; it is like a + variable pattern, except that there is no + way of referring to the matched value.\\ + Tuples: & \verb"(x,y)" & matches a pair whose first and second + elements are called \verb"x" and \verb"y" + respectively.\\ + Lists: & \verb"[x]" & matches a list with precisely one element + called \verb"x".\\ + & \verb"[_,2,_]"& matches a list with precisely three + elements, the second of which is the + integer 2.\\ + & \verb"[]" & matches the empty list.\\ + & \verb"(x:xs)"& matches a non-empty list with + head \verb"x" and + tail \verb"xs".\\ + As patterns:& \verb"p@(x,y)"& matches a pair whose first and second + components are called \verb"x" + and \verb"y". The + complete pair can also be referred to + directly as \verb"p".\\ + (n+k) patterns:& \verb"(m+1)" & matches an integer value greater than or + equal to 1. The value referred to by the + variable \verb"m" is one less than the value + matched. +\end{tabular} +\EQ +A further kind of pattern (called an irrefutable pattern) is introduced +in section 9.11. + +Note that no variable name can be used more than once on the left hand +side of each equation in a function definition. The following example: +\begin{verbatim} + areTheyTheSame x x = True + areTheyTheSame _ _ = False +\end{verbatim} +will not be accepted by the Gofer system, but should instead be defined +using the notation of guards introduced in the next section: +\begin{verbatim} + areTheyTheSame x y + | x==y = True + | otherwise = False +\end{verbatim} + +\section{Guarded equations} +Each of the equations in a function definition may contain `guards' +which require certain conditions on the values of the function's +arguments to be met. As an example, here is a function which uses the +standard prelude function \verb"even :: Int -> Bool" to determine whether its +argument is an even integer or not, and returns the string +\verb="even"= or +\verb="odd"= as appropriate: +\begin{verbatim} + oddity n | even n = "even" + | otherwise = "odd" +\end{verbatim} +In general, an equation using guards takes the form: +\begin{verbatim} + f x1 x2 ... xn | condition1 = e1 + | condition2 = e2 + . + . + | conditionm = em +\end{verbatim} +This equation is used by evaluating each of the conditions in turn +until one of them evaluates to \verb"True", in which case the value of the +function is given by the corresponding expression e on the right hand +side of the `\verb"="' sign. In Gofer, the variable +\verb"otherwise" is defined to +be equal to +\verb"True", so that writing +\verb"otherwise" as the condition in a +guard means that the corresponding expression will always be used if no +previous guard has been satisfied. + +As an aside: in the notation of [1], the above examples would be written as: +\begin{verbatim} + oddity n = "even", if even n + = "odd", otherwise + f x1 x2 ... xn = e1, if condition1 + = e2, if condition2 + . + . + = em, if conditionm +\end{verbatim} +Translation between the two notations is relatively straightforward. + + +\section{Local definitions} +Function definitions may include local definitions for variables which +can be used both in guards and on the right hand side of an equation. +Consider the following function which calculates the number of distinct +real roots for a quadratic equation of the form $a*x^2+b*x+c=0$: +\begin{verbatim} + numberOfRoots a b c | discr>0 = 2 + | discr==0 = 1 + | discr<0 = 0 + where discr = b*b - 4*a*c +\end{verbatim} +The operator \verb"(==)" is used to test whether two values are equal +or not. You should take care not to confuse this with the single \verb"=" +sign used in function definitions. + +Local definitions can also be introduced at an arbitrary point in an +expression using an expression of the form: +\BQ + \TT{let} \I{decls} \TT{in} \I{expr} +\EQ +For example: +\begin{verbatim} + ? let x = 1 + 4 in x*x + 3*x + 1 + 41 + (8 reductions, 15 cells) + ? let p x = x*x + 3*x + 1 in p (1 + 4) + 41 + (7 reductions, 15 cells) + ? +\end{verbatim} + +\section{Recursion with integers} +Recursion is a particularly important and powerful technique in +functional programming which is useful for defining functions involving +a wide range of datatypes. In this section, we describe one particular +application of recursion to give an alternative definition for the +factorial function from section 5. + +Suppose that we wish to calculate the factorial of a given integer $n$. +We can split the problem up into two special cases: +\BSI +\IT If $n$ is zero then the value of $n!$ is 1. +\IT Otherwise, $n! = 1 * 2 * \dots * (n\!-\!1) * n = (n\!-\!1)! * n$ + and so we + can calculate the value of $n!$ by + calculating the value of $(n\!-\!1)!$ + and then multiplying it by $n$. +\ESI +This process can be expressed directly in Gofer using a conditional +expression: +\begin{verbatim} + fact1 n = if n==0 then 1 else n * fact1 (n-1) +\end{verbatim} +This definition may seem rather circular; in order to calculate the +value of $n!$, we must first calculate $(n-1)!$, and unless $n$ is 1, this +requires the calculation of $(n-2)!$ etcetera \dots +However, if we start with +some positive value for the variable $n$, then we will eventually reach +the case where the value of $0!$ is required -- and this does not require +any further calculation. The following diagram illustrates how $6!$ is +evaluated using \verb"fact1": +\begin{verbatim} + fact1 6 ==> 6 * fact1 5 + ==> 6 * (5 * fact1 4) + ==> 6 * (5 * (4 * fact1 3)) + ==> 6 * (5 * (4 * (3 * fact1 2))) + ==> 6 * (5 * (4 * (3 * (2 * fact1 1)))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * fact1 0))))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * 1))))) + ==> 6 * (5 * (4 * (3 * (2 * 1)))) + ==> 6 * (5 * (4 * (3 * 2))) + ==> 6 * (5 * (4 * 6)) + ==> 6 * (5 * 24) + ==> 6 * 120 + ==> 720 +\end{verbatim} +Incidentally, there are several other ways of writing the recursive +definition of \verb"fact1" above in Gofer. For example, using guards: +\begin{verbatim} + fact2 n + | n==0 = 1 + | otherwise = n * fact2 (n-1) +\end{verbatim} +or using pattern matching with an integer constant: +\begin{verbatim} + fact3 0 = 1 + fact3 n = n * fact3 (n-1) +\end{verbatim} +Which of these you use is largely a matter of personal taste. + +Yet another style of definition uses the \verb=(n+k)= patterns mentioned in +section 9.1: +\begin{verbatim} + fact4 0 = 1 + fact4 (n+1) = (n+1) * fact4 n +\end{verbatim} +which is equivalent to: +\begin{verbatim} + fact5 n | n==0 = 1 + | n>=1 = n * fact5 (n-1) +\end{verbatim} +Although each of the above definitions gives the same result +as the original \verb"fact" function for each non-negative integer, the +functions can still be distinguished by the values obtained when they +are applied to negative integers: +\BSI +\IT \verb"fact (-1)" evaluates to the integer 1. +\IT \verb"fact1 (-1)" causes Gofer to enter an infinite loop, which is only + eventually terminated when Gofer runs out of `stack space'. +\IT \verb"fact4 (-1)" causes an evaluation error and prints the + message \verb"{fact4 (-1)}" on the screen. +\ESI +To most people, this suggests that the definition of \verb"fact4" is perhaps +preferable to that of either \verb"fact" or \verb"fact1" +as it neither gives the +wrong answer without allowing this to be detected nor causes a +potentially non-terminating computation. + + +\section{Recursion with lists} +The same kind of technique that can be used to define recursive +functions with integers can also be used to define recursive functions +on lists. As an example, suppose that we wish to define a function to +calculate the length of a list. As the standard prelude already +includes such a function called \verb"length", we will call the function +developed here \verb"len" to avoid any conflict. Now suppose that we wish +to find the length of a given list. There are two cases to consider: +\BSI +\IT If the list is empty then it has length 0 +\IT Otherwise, it is non-empty and can be written in the form \verb"(x:xs)" + for some element \verb"x" and some list \verb"xs". + Thus the original list is + one element longer than \verb"xs", and so has length \verb"1+len xs". +\ESI +Writing these two cases out leads directly to the following definition: +\begin{verbatim} + len [] = 0 + len (x:xs) = 1 + len xs +\end{verbatim} +The following diagram illustrates the way that this function can be +used to determine the length of the list \verb"[1,2,3,4]" (remember that this +is just an abbreviation for \verb"1:2:3:4:[])": +\begin{verbatim} + len [1,2,3,4] ==> 1 + len [2,3,4] + ==> 1 + (1 + len [3,4]) + ==> 1 + (1 + (1 + len [4])) + ==> 1 + (1 + (1 + (1 + len []))) + ==> 1 + (1 + (1 + (1 + 0))) + ==> 1 + (1 + (1 + 1)) + ==> 1 + (1 + 2) + ==> 1 + 3 + ==> 4 +\end{verbatim} +As further examples, you might like to look at the following +definitions which use similar ideas to define the functions product and +map introduced in earlier sections: +\begin{verbatim} + product [] = 1 + product (x:xs) = x * product xs + map f [] = [] + map f (x:xs) = f x : map f xs +\end{verbatim} + +\section{Lazy evaluation} +Gofer evaluates expressions using a technique sometimes described as +`lazy evaluation' which means that: +\BSI +\IT No expression is evaluated until its value is needed. +\IT No shared expression is evaluated more than once; if the + expression is ever evaluated then the result is shared between all + those places in which it is used. +\ESI +The first of these ideas is illustrated by the following function: +\begin{verbatim} + ignoreArgument x = "I didn't need to evaluate x" +\end{verbatim} +Since the result of the function \verb"ignoreArgument" doesn't depend on the +value of its argument \verb"x", that argument will not be evaluated: +\begin{verbatim} + ? ignoreArgument (1/0) + I didn't need to evaluate x + (1 reduction, 31 cells) + ? +\end{verbatim} +In some situations, it is useful to be able to force Gofer to evaluate +the argument to a function before the function is applied. This can be +achieved using the function \verb"strict" defined in the standard prelude; +An expression of the form \verb"strict f x" is evaluated by first evaluating +the argument \verb"x" and then applying the function \verb"f" to the result: +\begin{verbatim} + ? strict ignoreArgument (1/0) + {primDivInt 1 0} + (4 reductions, 29 cells) + ? +\end{verbatim} +The second basic idea behind lazy evaluation is that no shared +expression should be evaluated more than once. For example, the +following two expressions can be used to calculate $3*3*3*3$: +\begin{verbatim} + ? square * square where square = 3 * 3 + 81 + (3 reductions, 9 cells) + ? (3 * 3) * (3 * 3) + 81 + (4 reductions, 11 cells) + ? +\end{verbatim} +Notice that the first expression requires one less reduction than the +second. Excluding the single reduction step needed to convert each +integer into a string, the sequences of reductions that will be used in +each case are as follows: +\begin{verbatim} + square * square where square = 3 * 3 + -- calculate the value of square by reducing 3 * 3 ==> 9 + -- and replace each occurrence of square with this result + ==> 9 * 9 + ==> 81 + + (3 * 3) * (3 * 3) -- evaluate first (3 * 3) + ==> 9 * (3 * 3) -- evaluate second (3 * 3) + ==> 9 * 9 + ==> 81 +\end{verbatim} +Lazy evaluation is a very powerful feature of programming in a language +like Gofer, and means that only the minimum amount of calculation is +used to determine the result of an expression. The following example +is often used to illustrate this point. + +Consider the task of finding the smallest element of a list of +integers. The standard prelude includes a function \verb"minimum" which can +be used for this very purpose: +\begin{verbatim} + ? minimum [100,99..1] + 1 + (809 reductions, 1322 cells) + ? +\end{verbatim} +(The expression \verb"[100,99..1]" denotes the list of integers from 1 to 100 +arranged in decreasing order, as described in section 10.1). + +A rather different approach involves sorting the elements of the list +into increasing order (using the function \verb"sort" defined in the +standard prelude) and then take the element at the head of the +resulting list (using the standard function \verb"head"). Of course, +sorting the list in its entirety is likely to require significantly +more work than the previous approach: +\begin{verbatim} + ? sort [100,99..1] + [1, 2, 3, 4, 5, 6, 7, 8, ... etc ..., 99, 100] + (10712 reductions, 21519 cells) + ? +\end{verbatim} +However, thanks to lazy-evaluation, calculating just the first element +of the sorted list actually requires less work in this particular case +than the first solution using \verb"minimum": +\begin{verbatim} + ? head (sort [100,99..1]) + 1 + (713 reductions, 1227 cells) + ? +\end{verbatim} +Incidentally, it is probably worth pointing out that this example +depends rather heavily on the particular algorithm used to \verb"sort" a +list of elements. The results are rather different if we compare the +same two approaches used to calculate the maximum value in the list: +\begin{verbatim} + ? maximum [100,99..1] + 100 + (812 reductions, 1225 cells) + ? last (sort [100,99..1]) + 100 + (10612 reductions, 20732 cells) + ? +\end{verbatim} +This difference is caused by the fact that each element in the list +produced by \verb"sort" is only known once the values of all of the +preceding elements are also known. Thus the complete list must be +sorted in order to obtain the last element. + + +\section{Infinite data structures} +One particular benefit of lazy evaluation is that it makes it possible +for functions in Gofer to manipulate `infinite' data structures. +Obviously we cannot hope either to construct or store an infinite +object in its entirety -- the advantage of lazy evaluation is that it +allows us to construct infinite objects piece by piece as necessary +(and to reuse the storage space used by parts of the object when they +are no longer required). + +As a simple example, consider the following function which can be used +to produce infinite lists of integer values: +\begin{verbatim} + countFrom n = n : countFrom (n+1) +\end{verbatim} +If we evaluate the expression \verb"countFrom 1", Gofer just prints the list +of integer values beginning with 1 until it is interrupted. Once each +element in the list has been printed, the storage used to hold that +element can be reused to hold later elements in the list. Evaluating +this expression is equivalent to using an `infinite' loop to print the +list of integers in an imperative programming language: +\begin{verbatim} + ? countFrom 1 + [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,^C{Interrupted!} + (53 reductions, 160 cells) + ? +\end{verbatim} +For practical applications, we are usually only interested in using a +finite portion of an infinite data structure (just as loops in an +imperative programming language are usually terminated after finitely +many iterations). For example, using \verb"countFrom" together with the +function \verb"take" defined in the standard prelude, we can repeat the +calculation from section 4 to find the sum of the integers 1 to 10: +\begin{verbatim} + ? sum (take 10 (countFrom 1)) + 55 + (62 reductions, 119 cells) + ? +\end{verbatim} +The expression \verb"take n xs" evaluates to a list containing the +first \verb"n" elements of the list \verb"xs" (or to \verb"xs" +itself if the list contains +fewer than n elements). Thus \verb"countFrom 1" generates the infinite list +of integers, \verb"take 10" ensures that only the first ten elements are +calculated, and \verb"sum" calculates the sum of those integers as before. + +A particular advantage of using infinite data structures is that it +enables us to describe an object without being tied to one particular +application of that object. Consider the following definition for the +infinite list of powers of two [1, 2, 4, 8, \dots]: +\begin{verbatim} + powersOfTwo = 1 : map double powersOfTwo + where double n = 2*n +\end{verbatim} +This list be used in a variety of ways; using the operator \verb"(!!)" defined +in the standard prelude (\verb"xs!!n" evaluates to the \verb"n"th +element of the list +\verb"xs"), we can define a function to find the $n$th power of 2 for +any given +integer $n$: +\begin{verbatim} + twoToThe n = powersOfTwo !! n +\end{verbatim} +Alternatively, we can use the list \verb"powersOfTwo" to define a function +mapping lists of bits (represented by integers 0 and 1) to the +corresponding decimal number: simply reverse the order of the digits, +multiply each by the corresponding power of two and calculate the sum. +Using functions from the standard prelude, this translates directly +into the definition: +\begin{verbatim} + binToDec ds = sum (zipWith (*) (reverse ds) powersOfTwo) +\end{verbatim} +For example: +\begin{verbatim} + ? twoToThe 12 + 4096 + (15 reductions, 21 cells) + ? binToDec [1,0,1,1,0] + 22 + (40 reductions, 85 cells) + ? +\end{verbatim} + +\section{Polymorphism} +Given the definition of \verb"product" in section 9.5, it is easy to see +that product takes a single argument which is a list of integers and +returns a single integer value -- the product of the elements of the +list. In other words, \verb"product" has type \verb"[Int] -> Int". +On the other +hand, it is not immediately clear what the type of the function \verb"map" +should be. Clearly the first argument of \verb"map" must be a function and +both the second argument and the result are lists, so that the type of +\verb"map" must be of the form: +\[ + \underbrace{(a\to b)}_{\mbox{type of argument {\tt f}}} + \to\underbrace{[c]}_{\mbox{type of argument {\tt xs}}} + \to\underbrace{[d]}_{\mbox{type of result {\tt map f xs}}} +\] +But what can be said about the types $a$, $b$, $c$ and $d$? One possibility +would be to choose $a = b = c = d = \TT{Int}$ which would be acceptable for +expressions such as \verb"map fact [1,2,3,4]", but this would not be +suitable in an expression such as \verb"map chr [65,75,32]" because the +\verb"chr" function does not have type \verb"Int -> Int". + +Notice however that the argument type of \verb"f" must be the same as the +type of elements in the second argument (i.e.\ $a=c$) since \verb"f" is +applied to each element in that list. Similarly, the result type of +\verb"f" must be the same as the type of elements in the result list (i.e.\ $b += d$) since each element in this list is obtained as a result of +applying the function \verb"f" to some value. It is therefore reasonable to +treat the \verb"map" function as having any type of the form: +\[ + (a \to b) \to [a] \to [b] +\] +The letters $a$ and $b$ used in this type expression represent +arbitrary types and are called type variables. An object whose type +includes one or more type variables can be thought of as having many +different types and is often described as having a `polymorphic type' +(literally: its type has `many shapes'). + +The ability to define and use polymorphic functions in Gofer turns out +to be very useful. Here are the types of some of the other polymorphic +functions which have been used in previous examples which illustrate +this point: +\begin{verbatim} + length :: [a] -> Int + (++) :: [a] -> [a] -> [a] + concat :: [[a]] -> [a] +\end{verbatim} +Thus we can use precisely the same \verb"length" function to determine both +the length of a list of integers as well as finding the length of a +string: +\begin{verbatim} + ? length [1..10] + 10 + (98 reductions, 138 cells) + ? length "Hello" + 5 + (22 reductions, 36 cells) + ? +\end{verbatim} + +\section{Higher-order functions} +In Gofer, function values are treated in much the same way as any other +kind of value; in particular, they can be used both as arguments to, +and results of other functions. + +Functions which manipulate other functions in this way are often +described as `higher-order functions'. Consider the following example, +taken from the standard prelude: +\begin{verbatim} + (.) :: (b -> c) -> (a -> b) -> (a -> c) + (f . g) x = f (g x) +\end{verbatim} +As indicated by the type declaration, we think of the \verb"(.)" operator as a +function taking two function arguments and returning another function +value as its result. If \verb"f" and \verb"g" +are functions of the appropriate +types, then \verb"(f . g)" +is a function called the composition of \verb"f" with \verb"g". +Applying \verb"(f . g)" to a value is equivalent to applying \verb"g" +to that value, +and then applying \verb"f" to the result (as described, far more eloquently, +by the second line of the declaration above!). + +Many problems can often be described very elegantly as a composition of +other functions. Consider the problem of calculating the total number +of characters used in a list of strings. A simple recursive function +provides one solution: +\begin{verbatim} + countChars [] = 0 + countChars (w:ws) = length w + countChars ws + + ? countChars ["super","cali","fragi","listic"] + 20 + (96 reductions, 152 cells) + ? +\end{verbatim} +An alternative approach is to notice that we can calculate the total +number of characters by first combining all of the words in the +argument list into a single word (using concat) and then finding the +length of that word: +\begin{verbatim} + ? (length . concat) ["super","cali","fragi","listic"] + 20 + (113 reductions, 211 cells) + ? +\end{verbatim} +Another solution is to first find the length of each word in the list +(using the \verb"map" function to apply \verb"length" +to each word) and then +calculate the sum of these individual lengths: +\begin{verbatim} + ? (sum . map length) ["super","cali","fragi","listic"] + 20 + (105 reductions, 172 cells) + ? +\end{verbatim} + +\section{Variable declarations} +A variable declaration is a special form of function definition, +almost always consisting of a single equation of the form: +\BQ + \I{var} \TT{=} \I{rhs} +\EQ +(i.e.\ a function declaration of arity 0). Whereas the values defined +by function declarations of arity $>0$ are guaranteed to be functions, the +values defined by variable declarations may or may not be functions: +\begin{verbatim} + odd = not . even -- if an integer is not even then it must be odd + val = sum [1..100] +\end{verbatim} +Note that variables defined like this at the top level of a file of +definitions will be evaluated using lazy evaluation. The first time we +refer to the variable \verb"val" defined above (either directly or +indirectly), Gofer evaluates the sum of the integers from 1 to 100 and +overwrites the definition of \verb"val" with this number. This calculation +can then be avoided for each subsequent use of \verb"val" (unless the file +containing the definition of \verb"val" is reloaded). +\begin{verbatim} + ? val + 5050 + (809 reductions, 1120 cells) + + ? val + 5050 + (1 reduction, 7 cells) + + ? +\end{verbatim} +Because of this behaviour, we should probably try to avoid using variable +declarations where the resulting value will require a lot of storage +space. If we load a file of definitions including the line: +\begin{verbatim} + longList = [1..10000] +\end{verbatim} +and then evaluate the expression \verb"length longList" (eventually +obtaining the expected result of 10000), then Gofer will evaluate the +definition of \verb"longList" and replace it with the complete list of +integers from 1 upto 10000. Unlike other memory used during a +calculation, it will not be possible to reuse this space for other +calculations without reloading the file defining \verb"longList", or loading +other files instead. + + +\section{Pattern bindings and irrefutable patterns} +Another useful way of defining variables uses `pattern bindings' which +are equations of the form: +\BQ + \I{pat} \TT{=} \I{rhs} +\EQ +where the expression on the left hand side is a pattern as described in +section 9.1. As a simple example of pattern bindings, here is one +possible definition for the function \verb"head" which returns the first +element in a list of values: +\begin{verbatim} + head xs = x where (x:ys) = xs +\end{verbatim} +The definition \verb"head (x:_) = x" used in the standard prelude is +slightly more efficient, but otherwise equivalent. + +Note that pattern bindings are treated quite differently from +function bindings (of which the variable declarations described in the +last section are a special case). There are two situations in which an +ambiguity may occur; i.e.\ if the left hand side of an equation is a +simple variable or an \verb"(n+k)" pattern of the kind described in section +9.1. In both cases, these are treated as function bindings, the former +being a variable declaration whilst the latter will be treated as a +definition for the operator symbol \verb"(+)". + +Pattern bindings are often useful for defining functions which we might +think of as `returning more than one value' -- although they are +actually packaged up in a single value such as a tuple. As an example, +consider the function \verb"span" defined in the standard prelude. +\begin{verbatim} + span :: (a -> Bool) -> [a] -> ([a],[a]) +\end{verbatim} +If \verb"xs" is a list of values and \verb"p" +is a predicate, then \verb"span p xs" returns +the pair of lists \verb"(ys,zs)" such that \verb"ys++zs == xs", +all of the elements +in \verb"ys" satisfy the predicate \verb"p" +and the first element of \verb"zs" does not +satisfy \verb"p." A suitable definition, using a pattern binding to obtain +the two lists resulting from the recursive call to \verb"span" is as +follows: +\begin{verbatim} + span p [] = ([],[]) + span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +\end{verbatim} +For consistency with the lazy evaluation strategy used in Gofer, the +right hand side of a pattern binding is not evaluated until the value +of one of the variables bound by that pattern is required. The +definition: +\begin{verbatim} + (0:xs) = [1,2,3] +\end{verbatim} +will not cause any errors when it is loaded into Gofer, but will cause +an error if we attempt to evaluate the variable \verb"xs": +\begin{verbatim} + ? xs + {v120 [1, 2, 3]} + (11 reductions, 46 cells) + ? +\end{verbatim} +The variable name \verb"v120" appearing in this expression is the name of a +function called a `conformality check' which is defined automatically +by Gofer to ensure that the value on the right hand side of the pattern +binding conforms with the pattern on the left. + +Compare this with the behaviour of pattern matching in function +definitions such as: +\begin{verbatim} + ? example [1] where example (0:xs) = "Hello" + {v126 [1]} + (4 reductions, 22 cells) + ? +\end{verbatim} +where the equivalent of the conformality check is carried out +immediately even if none of the values of the variables in the pattern +are actually required. The reason for this difference is that the +arguments supplied to a function must be evaluated to determine which +equation in the definition of the function should be used. The error +produced by the example above was caused by the fact that the argument +[1] does not match the pattern used in the equation defining \verb"example" +(represented by an internal Gofer function called \verb"v126"). + +A different kind of behaviour can be obtained using a pattern of the +form \verb"~pat", +known as an irrefutable (or lazy) pattern. This pattern can +initially be matched against any value, delaying the check that this +value does indeed match \verb"pat" until the value of one of the variables +appearing in it is required. The basic idea (together with the method +used to implement irrefutable patterns in Gofer) is illustrated by the +identity: +\BQ + \verb"f ~"\I{pat} \verb"=" \I{rhs} ~~~is equivalent to~~~ + \verb"f v = "\I{rhs} \verb"where "\I{pat} \verb"= v" +\EQ +The following examples, based very closely on those given in the +Haskell report [5], illustrate the use of irrefutable patterns. The +variable \verb"undefined" used in these examples is included in the standard +prelude and causes a run-time error each time it is evaluated +(technically speaking, it represents the $\bottom$ element of the relevant +semantic domain, and is the only value having all possible types): +\begin{verbatim} + (\ (x,y) -> 0) undefined = {undefined} + (\~(x,y) -> 0) undefined = 0 + + (\ [x] -> 0) [] = {v113 []} + (\~[x] -> 0) [] = 0 + + (\~[x, (a,b)] -> x) [(0,1),undefined] = {undefined} + (\~[x,~(a,b)] -> x) [(0,1),undefined] = (0,1) + + (\ (x:xs) -> x:x:xs) undefined = {undefined} + (\~(x:xs) -> x:x:xs) undefined = {undefined}:{undefined}:{undefined} +\end{verbatim} +Irrefutable patterns are not used very frequently, although they are +particularly convenient in some situations (see section 12 for some +examples). Be careful not to use irrefutable patterns where they are +not appropriate. An attempt to define a map function \verb"map'" using: +\begin{verbatim} + map' f ~(x:xs) = f x : map' f xs + map' f [] = [] +\end{verbatim} +turns out to be equivalent to the definition: +\begin{verbatim} + map' f ys = f x : map f xs where (x:xs) = ys +\end{verbatim} +and will not behave as you might have intended: +\begin{verbatim} + ? map' ord "abc" + [97, 98, 99, {v124 []}, {v124 []}, {v^C{Interrupted!} + (35 reductions, 159 cells) + ? +\end{verbatim} + +\section{Type declarations} +The type system used in Gofer is sufficiently powerful to enable Gofer +to determine the type of any function without the need to declare the +types of its arguments and the return value as in some programming +languages. Despite this, Gofer allows the use of type declarations of +the form: +\BQ + $\I{var}_1$, \dots $\I{var}_n$ \verb"::" \I{type} +\EQ +which enable the programmer to declare the intended types of the +variables $\I{var}_1$, \dots $\I{var}_n$ +defined in either function or pattern +bindings. There are a number of benefits of including type +declarations of this kind in a program: +\BI +\IT Documentation: The type of a function often provides useful + information about the way in which a function is to be used -- + including the number and order of its arguments. +\IT Restriction: In some situations, the type of a function inferred + by Gofer is more general than is required. As an example, + consider the following function, intended to act as the identity + on integer values: +\begin{verbatim} + idInt x = x +\end{verbatim} + Without an explicit type declaration, Gofer treats \verb"idInt" as a + polymorphic function of type \verb"a -> a" and the expression \verb"idInt 'A'" + does not cause a type error. This problem can be solved + by using an explicit type declaration to restrict the type of + \verb"idInt" to a particular instance of the polymorphic + type \verb"a -> a": +\begin{verbatim} + idInt :: Int -> Int +\end{verbatim} + Note that a declaration such as: +\begin{verbatim} + idInt :: Int -> a +\end{verbatim} + is not a valid type for the function \verb"idInt" (the value of the + expression \verb"idInt 42" is an integer and cannot be treated as + having an arbitrary type, depending on the value of the type + variable \verb"a"), and hence will not be accepted by Gofer. +\IT Consistency check: As illustrated above, declared types are always + checked against the definition of a value to make sure that they + are compatible. Thus Gofer can be used to check that the + programmer's intentions (as described by the types assigned to + variables in type declarations) are consistent with the + definitions of those values. +\IT Overloading: Explicit type declarations can be used to solve a + number of problems associated with overloaded functions and + values. See section 14 for further details. +\EI + +\chapter{Increasing your power of expression} + +This section describes a number of useful extensions to the basic range +of expressions used in the previous sections. None of these add any +extra computational power to Gofer -- anything that can be done with +these constructs could also be done with the constructs already +described. They are however included in Gofer because they allow many +expressions and function definitions to be written more clearly and +concisely than the equivalent expressions without these notations. + +\section{Arithmetic sequences} +A number of useful lists can be generated using the notation of +arithmetic sequences (so named because of their similarity to +arithmetic progressions in mathematics). The following list summarises +the four forms of sequence expression that can be used in Gofer, +together with their translation using the standard functions \verb"enumFrom", +\verb"enumFromTo", \verb"enumFromThen" and \verb"enumFromThenTo": +\BQ +\begin{tabular}{llp{6cm}} + \verb"[ n .. ]"& \verb"enumFrom n" & + Produces the (potentially infinite) list of values + starting with the value of \verb"n" and increasing in + single steps.\\ + \verb"[ n .. m ]"& \verb"enumFromTo n m"& + Produces the list of elements from \verb"n" upto and + including \verb"m" in single steps. + If \verb"m" is less than \verb"n" + then the list is empty.\\ + \verb"[ n, m .. ]"& \verb"enumFromThen n m"& + Produces the (potentially infinite) list of values + whose first two elements are given by the values \verb"n" + and \verb"m". If \verb"m" + is greater than \verb"n" then the following + elements of the list are increasing in steps of + the same size. A similar result is obtained if \verb"m" + is less than \verb"n" in which case the elements of + \verb"[n,m..]" will be decreasing. + If \verb"n" and \verb"m" are equal + then \verb"[n,m..]" is an infinite list in which each + element is equal to \verb"n".\\ + \verb"[ n, n' .. m ]"& \verb"enumFromThenTo n n' m"& + Produces the list of elements from \verb"[n,n'..]" upto + the limit value \verb"m". + If \verb"m" is less than \verb"n" and + \verb"[n,n'..]" is increasing, or \verb"m" + is greater than \verb"n" and + \verb"[n,n'..]" is decreasing the resulting list will be + empty. +\end{tabular} +\EQ +Examples: +\BQ +\begin{tabular}{lcl} + {\tt [1..] }& = & {\tt [1, 2, 3, 4, 5, 6, 7, 8, 9,} etc\dots\\ + {\tt [-3..3] }& = & {\tt [-3, -2, -1, 0, 1, 2, 3]}\\ + {\tt [1..1] }& = & {\tt [1]}\\ + {\tt [9..0] }& = & {\tt []}\\ + {\tt [1,3..] }& = & {\tt [1, 3, 5, 7, 9, 11, 13,} etc\dots\\ + {\tt [0,0..] }& = & {\tt [0, 0, 0, 0, 0, 0, 0,} etc\dots\\ + {\tt [5,4..] }& = & {\tt [5, 4, 3, 2, 1, 0, -1,} etc\dots\\ + {\tt [1,3..12]}& = & {\tt [1, 3, 5, 7, 9, 11]}\\ + {\tt [0,0..10]}& = & {\tt [0, 0, 0, 0, 0, 0, 0,} etc\dots\\ + {\tt [5,4..1] }& = & {\tt [5, 4, 3, 2, 1]} +\end{tabular} +\EQ +In the standard prelude, the functions \verb"enumFrom", +\verb"enumFromTo", +\verb"enumFromThen" and \verb"enumFromThenTo" +are overloaded and may also be used to +enumerate lists of characters or floating point values: +\begin{verbatim} + ? ['0'..'9'] ++ ['A'..'Z'] + 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ + (397 reductions, 542 cells) + + ? [1.2, 1.35 .. 2.00] + [1.2, 1.35, 1.5, 1.65, 1.8, 1.95] + (56 reductions, 133 cells) +\end{verbatim} +Arithmetic sequences such as those described above play the same role +in functional programming languages as the iterative `for' constructs +in traditional imperative languages. A good example of this is the +example in section 4 used to calculate the sum of the integers from 1 +upto 10 -- \verb"sum [1..10]". An equivalent program in an imperative +language might look something like (especially if you think of C!): +\begin{verbatim} + int i; + int total=0; + for (i=1; i<=10; i++) + total = total + i; + return total; +\end{verbatim} +The advantages of the functional notation in this case are clear: +\BSI +\IT It is more compact. +\IT It separates the task of generating the sequence of integers + \verb"[1..10]" from the task of finding their sum. +\IT It does not require the declaration or use of auxiliary variables + such as \verb"i" and \verb"total" in the above. +\ESI + + +\section{List comprehensions} +List comprehensions provide another very powerful and compact notation +for describing certain kinds of list expression. The basic form of a +list comprehension is: +\BQ + \verb"[" \I{expr} \verb"|" \I{qualifiers} \verb"]" +\EQ +There are three kinds of qualifier that can be used in Gofer: +\BI +\IT Generators: A qualifier of the form \I{pat} \verb"<-" \I{exp} + is used to extract + each element that matches the pattern pat from the list exp in the + order that they elements appear in that list. A simple example of + this is the expression \verb"[x*x | x<-[1..10]]" which denotes the list + of the squares of the integers between 1 and 10 inclusive and + evaluates to [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] as expected. + + Formally, we can define the meaning of a list comprehension with a + single generator by the equation: +\begin{verbatim} + [ e | pat <- exp ] = loop exp + where loop [] = [] + loop (pat:xs) = e : loop xs + loop (_:xs) = loop xs +\end{verbatim} + If \verb"pat" is an irrefutable pattern (for example, a variable) then + this is equivalent to: +\begin{verbatim} + [ e | pat <- exp ] = map f exp + where f pat = e +\end{verbatim} + The full definition is needed for those cases where the pattern + pat may not match all of the elements in the list exp. This is + the case in expressions such as \verb"[ y | (3,y)<-[(1,2),(3,4),(5,6)] ]" + which evaluates to the singleton list \verb"[4]". +\IT Filters: A boolean valued expression may also be used as a + qualifier in which case it is often called a filter. We can + define the meaning of a list comprehension with a single filter by + the equation: +\begin{verbatim} + [ e | condition ] = if condition then [e] else [] +\end{verbatim} + Whilst this form of list comprehension is occasionally useful as + it stands, it is more common to use filters in conjunction with + generators as described below. +\IT Local definitions: A qualifier of the form \I{pat} \verb"=" \I{expr} + can be used to + introduce a local definition within a list comprehension. Its + meaning can be defined formally using the equation: +\begin{verbatim} + [ e | pat = exp ] = [ let pat=exp in e ] +\end{verbatim} + As in the case of filters, local definitions are more commonly + used within lists of more than one qualifier as described below. + Particular care should be taken to distinguish a filter of the + form \I{pat}\verb"=="\I{expr} + from a local definition of the form \I{pat}\verb"="\I{expr}. + + (I originally suggested this form of qualifier in a message + sent to the Haskell mailing list, only to discover that a similar + (and more comprehensive) suggestion had been made by Kevin Hammond + almost a year earlier. There was a certain amount of controversy + surrounding the choice of an appropriate syntax and semantics for + the construct and consequently, this feature is not currently part + of the Haskell standard. The syntax and semantics above is + implemented by Gofer in the hope that it will give functional + programmers an opportunity to experiment with this facility in + their own programs.) +\EI +The real power of this notation is that it is possible to use several +qualifiers, separated by commas on the right of the vertical bar `\verb"|"' +symbol in a list comprehension. Formally, if \verb"qs1" and \verb"qs2" +are two such +lists of qualifiers, then we can define the meaning of multiple +qualifiers using: +\begin{verbatim} + [ e | qs1, qs2 ] = concat [ [ e | qs2 ] | qs1 ] +\end{verbatim} +The following examples illustrate how this definition works in +practice: +\BI +\IT Variables generated by later qualifiers vary more quickly than + those generated by earlier qualifiers: +\begin{verbatim} + ? [ (x,y) | x<-[1..3], y<-[1..2] ] + [(1,1), (1,2), (2,1), (2,2), (3,1), (3,2)] + (107 reductions, 246 cells) + ? +\end{verbatim} +\IT Later qualifiers may use the values generated by earlier ones: +\begin{verbatim} + ? [ (x,y) | x<-[1..3], y<-[1..x]] + [(1,1), (2,1), (2,2), (3,1), (3,2), (3,3)] + (107 reductions, 246 cells) + + ? [ x | x<-[1..10], even x ] + [2, 4, 6, 8, 10] + (108 reductions, 171 cells) + ? +\end{verbatim} +\IT Variables defined in later qualifiers hide those introduced by + earlier ones. The following expressions are valid list + comprehensions, but this style of definition in which names are + reused can result in programs which are difficult to understand, + and is not recommended: +\begin{verbatim} + ? [ x | x<-[[1,2],[3,4]], x<-x ] + [1, 2, 3, 4] + (18 reductions, 53 cells) + + ? [ x | x<-[1,2], x<-[3,4] ] + [3, 4, 3, 4] + (18 reductions, 53 cells) + ? +\end{verbatim} +\IT Changing the order of qualifiers has a direct effect on + efficiency. The following two examples produce the same result, + but the first uses more reductions and cells because it repeats + the evaluation of \verb"even x" for each possible value of \verb"y". +\begin{verbatim} + ? [ (x,y) | x<-[1..3], y<-[1..2], even x ] + [(2,1), (2,2)] + (110 reductions, 186 cells) + ? [ (x,y) | x<-[1..3], even x, y<-[1..2] ] + [(2,1), (2,2)] + (62 reductions, 118 cells) + ? +\end{verbatim} + The following example illustrates a similar kind of behaviour with + local definitions; in the first case the expression \verb"fact x" is + evaluated twice for each possible value of \verb"x", whilst the second + expression uses a local definition to ensure that the evaluation + is not repeated: +\begin{verbatim} + ? [ fact x + y | x<-[1..3], y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (246 reductions, 398 cells) + + ? [ factx + y | x<-[1..3], factx = fact x, y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (173 reductions, 294 cells) + ? +\end{verbatim} +\EI + +\section{Lambda expressions} +In addition to named function definitions, Gofer also allows the +definition and use of unnamed functions using a `lambda expression' of +the form: +\BQ + \verb"\" \I{atomicPatterns} \verb"->" \I{expr} +\EQ +This is a slight generalisation of the form of lambda +expression used in most theoretical treatments of functional +programming and dating back to the pioneering work of logicians +including Alonzo Church and Haskell Curry, from whom the programming language +takes its name. The `\verb"\"' character used at the beginning of a Gofer +lambda expression has been chosen for its resemblance to the greek +letter $\lambda$ (lambda) +that might be used if the standard character set were a +little larger. + +This expression denotes a function taking a number of parameters (one +for each pattern) and producing the result specified by the expression +to the right of the \verb"->" symbol. For example, \verb"(\x->x*x)" +represents the +function which takes a single integer argument \verb'x' and produces the +square of that number as its result. Another example is the lambda +expression \verb"(\x y->x+y)" which takes two integer arguments and outputs +their sum; this expression is in fact equivalent to the \verb"(+)" operator: +\begin{verbatim} + ? (\x y->x+y) 2 3 + 5 + (3 reductions, 7 cells) + ? +\end{verbatim} +A lambda expression of the form illustrated above is equivalent to the +following expression using a local definition: +\begin{verbatim} + (let newName = in newName) +\end{verbatim} +where \verb"newName" is a new variable name, chosen to avoid conflicts with +other variables that are already in use. This name will be printed if +you enter an expression involving a lambda expression without supplying +the full number of parameters for that function: +\begin{verbatim} + ? (\x y -> x+y) 42 + v117 42 + (2 reductions, 14 cells) + ? +\end{verbatim} +Lambda expressions are particularly useful for certain styles of +functional programming; an example of this is the continuation-based +approach to I/O described in section 12. + + +\section{Case expressions} +A case expression can be used to evaluate an expression and, depending +on the result, return one of a number of possible values. As such, +case statements are a straightforward generalisation of conditional +expressions. Indeed, an expression of the form \verb"if e then t else f" is +in fact equivalent to the case expression: +\begin{verbatim} + case e of + True -> t + False -> f +\end{verbatim} +In general, a case expression takes the form \verb"case exp of alts" where +\verb"exp" is the expression to be evaluated and \verb"alts" +is a list of +alternatives, each of which is of the form: +\begin{verbatim} + pat -> rhs +\end{verbatim} +for a simple alternative +\begin{verbatim} + pat | condition1 -> rhs1 + | condition2 -> rhs2 + . + . + | conditionn -> rhsn +\end{verbatim} +using guard expressions as described in section 9.2 +for function definitions. + +In Gofer, a case expression of the form \verb"case e of alts" is implemented +by choosing a new function name \verb"newName" as in the previous section +and using the alternatives in alts to construct an appropriate +definition for this function (essentially by replacing each `\verb"->"' symbol +with a `\verb"="' symbol). The complete case expression is then treated as +being equivalent to the expression \verb"newName e". A simple example of +this is the \verb"scanl" function whose definition in the standard prelude: +\begin{verbatim} + scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) +\end{verbatim} +is equivalent to: +\begin{verbatim} + scanl f q xs = q : scanl' xs + where scanl' [] = [] + scanl' (x:xs) = scanl f (f q x) xs +\end{verbatim} +This latter form is precisely the definition used in [1] (but using the +name \verb"scan" where Gofer uses \verb"scanl"). + +Evaluating a case expression in which none of the alternatives match +the value of the discriminant results in an error such as the +following: +\begin{verbatim} + ? case [1,2] of [] -> "empty list" + {v117 [1, 2]} + (6 reductions, 31 cells) + ? +\end{verbatim} +The function name \verb"v117" which appears here is the name of the function +which is used internally by Gofer to implement the case expression +whilst the expression \verb"[1, 2]" gives the discriminant value which could +not be matched. + +By combining case expressions with the lambda expressions introduced in +the previous section, any function declaration can be translated into a +single equation of the form \verb"functionName = expr". For example, the +standard function \verb"map" whose definition is usually written as: +\begin{verbatim} + map f [] = [] + map f (x:xs) = f x : map f xs +\end{verbatim} +can also be defined by the equation: +\begin{verbatim} + map = \f xs -> case xs of + [] -> [] + (y:ys) -> f y : map f ys +\end{verbatim} +This kind of translation is used in the implementation of many +functional programming languages, including Gofer. See Simon Peyton +Jones book [2] for more details of this. + + +\section{Operator sections} +As we have seen, most functions in Gofer taking more than one argument +are treated as a function of a single argument, whose result is a +function which can then be applied to the remaining arguments. Thus +\verb"(+) 1" denotes the function which takes an integer +argument \verb"n" and +returns the integer value \verb"1+n". Functions of this kind involving +operator symbols are sufficiently common that Gofer provides a special +syntax for them. Using $e$ to denote an atomic expression and the symbol +$\oplus$ to represent an arbitrary infix operator, there are functions +$(e\oplus)$ +and $(\oplus e)$, known as `sections of the operator $(\oplus)$' defined by: +\begin{verbatim} + (e *) x = e * x + (* e) x = x * e +\end{verbatim} +or, using lambda expressions as introduced in section 10.3: +\begin{verbatim} + (e *) = \x -> e * x + (* e) = \x -> x * e +\end{verbatim} +For example: +\BQ +\begin{tabular}{lp{8cm}} + \verb"(1+)"& is the successor function which returns the value + of its argument plus 1,\\ + \verb"(1.0/)"& is the reciprocal function,\\ + \verb"(/2)"& is the halving function,\\ + \verb"(:[])"& is the function which maps any value to the + singleton list containing that element. +\end{tabular} +\EQ + +In Gofer, the expressions \verb"(e *)" and \verb"(* e)" +are actually treated as +abbreviations for \verb"(*) e" and \verb"flip (*) e" respectively, +where \verb"flip" +is the function defined by: +\begin{verbatim} + flip :: (a -> b -> c) -> b -> a -> c + flip f x y = f y x +\end{verbatim} +There is an important special case which occurs with an expression of +the form $(- e)$; this is interpreted as \verb"negate e" and not as the +section which subtracts the value of \verb"e" from its argument. The latter +function can be written as the section \verb"(+ (- e))" or as +\verb"subtract e" +where \verb"subtract" is the function defined in the standard prelude using: +\begin{verbatim} + subtract = flip (-) +\end{verbatim} + +\section{Explicitly typed expressions} +As described in section 9.12, it is often useful to be able to declare +the type of a variable defined in a function or pattern binding. For +much the same reasons, Gofer allows expressions of the form: +\begin{verbatim} + expr :: type +\end{verbatim} +so that the type of an expression can be specified explicitly. Note +that the \verb":t" command can be used to find the type of a particular +expression that is inferred by Gofer: +\begin{verbatim} + ? :t \x -> [x] + \x -> [x] :: a -> [a] + + ? :t sum . map length + sum . map length :: [[a]] -> Int +\end{verbatim} +The types inferred in each case can be modified by including explicit +types in these expressions: +\begin{verbatim} + ? :t (\x -> [x]) :: Char -> String + \x -> [x] :: Char -> String + + ? :t sum . map (length :: String -> Int) + sum . map length :: [String] -> Int +\end{verbatim} +Note that an error occurs if the type declared in an explicitly typed +expression is not compatible with the type inferred by Gofer: +\begin{verbatim} + ? :t (\x -> [x]) :: Int -> a + ERROR: Declared type too general + *** Expression : \x -> [x] + *** Declared type : Int -> a + *** Inferred type : Int -> [Int] +\end{verbatim} +Explicitly typed expressions are most commonly used together with +overloaded functions and values as described in section 14. + + +\chapter{User-defined datatypes and type synonyms} + +\section{Datatype definitions} +In addition to the wide range of built-in datatypes described in +section 7, Gofer also allows the definition of new datatypes using +declarations of the form: +\BQ + {\tt data} \I{Datatype} $a_1$ \dots $a_n$ {\tt =} + $\I{constr}_1$ {\tt|} \dots {\tt|} $\I{constr}_m$ +\EQ +where \I{Datatype} is the name of a new +type constructor of arity $n\geq 0$, +$a_1$, \dots, $a_n$ are distinct +type variables representing the arguments of +\I{DatatypeName} and $\I{constr}_1$, \dots, +$\I{constr}_m$ $(m\geq 1)$ describe the way in which +elements of the new datatype are constructed. Each \I{constr} can take one +of two forms: +\BI +\IT \I{Name} $\I{type}_1$ \dots $\I{type}_r$ + where \I{Name} is a previously unused constructor + function name (i.e.\ an identifier beginning with a capital + letter). This declaration introduces \I{Name} as a new constructor + function of type: +\[ + \I{type}_1 \to \dots \to \I{type}_r \to \I{Datatype}\;a_1 \dots a_n +\] +\IT $\I{type}_1 \oplus \I{type}_2$ where $\oplus$ + is a previously unused constructor + function operator (i.e.\ an operator symbol beginning with a + colon). This declaration introduces $(\oplus)$ as a new constructor + function of type: +\[ + \I{type}_1 \to \I{type}_2 \to \I{Datatype}\;a_1 \dots a_n +\] +\EI +Only the type variables $a_1$, \dots, $a_n$ +may appear in the type expressions +in each \I{constr} in the definition of \I{Datatype}. + + +As a simple example, the following definition introduces a new type \verb"Day" +with elements \verb"Sun", \verb"Mon", \verb"Tue", \verb"Wed", \verb"Thu", \verb"Fri" and \verb"Sat": +\begin{verbatim} + data Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat +\end{verbatim} +Simple functions manipulating elements of type \verb"Day" can be defined using +pattern matching: +\begin{verbatim} + what_shall_I_do Sun = "relax" + what_shall_I_do Sat = "go shopping" + what_shall_I_do _ = "looks like I'll have to go to work" +\end{verbatim} +Another example uses a pair of constructors to provide a representation +for temperatures which may be given using either of the centigrade or +fahrenheit scales: +\begin{verbatim} + data Temp = Centigrade Float | Fahrenheit Float + + freezing :: Temp -> Bool + freezing (Centigrade temp) = temp <= 0.0 + freezing (Fahrenheit temp) = temp <= 32.0 +\end{verbatim} +The following example uses a type variable on the left hand side of the +datatype definition to implement a \verb"Set" type constructor for +representing sets using a list of values: +\begin{verbatim} + data Set a = Set [a] +\end{verbatim} +For example, \verb"Set [1,2,3]" is an element of type \verb"Set Int", +representing +the set of integers $\{1, 2, 3\}$ whilst +\verb"Set ['a']" represents a singleton +set of type \verb"Set Char". As this example shows, it is possible to use the +same name simultaneously as both a type constructor and as a +constructor function. + +Datatype definitions may also be recursive, using the name of the +datatype being defined on the right hand side of the datatype +definition (mutually recursive datatype definitions are also +permitted). The following example is taken from the Haskell report [5] +and defines a type representing binary trees with values of a +particular type at their leaves: +\begin{verbatim} + data Tree a = Lf a | Tree a :^: Tree a +\end{verbatim} +For example, +\begin{verbatim} + (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10 +\end{verbatim} +has type \verb"Tree Int" +and represents the binary tree: +\BQ +\setlength{\unitlength}{1mm} +\begin{picture}(70,20) +\put(0,5){\line(1,0){20}} +\put(20,0){\line(1,0){10}} +\put(20,15){\line(1,0){10}} +\put(30,20){\line(1,0){10}} +\put(30,10){\line(1,0){10}} +\put(40,7.5){\line(1,0){10}} +\put(40,12.5){\line(1,0){10}} + +\put(20,0){\line(0,1){15}} +\put(30,10){\line(0,1){10}} +\put(40,7.5){\line(0,1){5}} + +\put(32,0){\makebox(0,0)[l]{10}} +\put(52,7.5){\makebox(0,0)[l]{13}} +\put(52,12.5){\makebox(0,0)[l]{23}} +\put(42,20){\makebox(0,0)[l]{12}} +\end{picture} +% ,--- 12 +% ,--| +% | | ,--- 23 +% | `--| +% | `--- 13 +% --| +% `--- 10 +\EQ +As an example of a function defined on trees, here are two definitions +using recursion and pattern matching on tree valued expressions which +calculate the list of elements at the leaves of a tree traversing the +branches of the tree from left to right. The first definition uses a +simple definition, whilst the second uses an `accumulating parameter' +giving a more efficient algorithm: +\begin{verbatim} + leaves, leaves' :: Tree a -> [a] + + leaves (Lf l) = [l] + leaves (l:^:r) = leaves l ++ leaves r + + leaves' t = leavesAcc t [] + where leavesAcc (Lf l) = (l:) + leavesAcc (l:^:r) = leavesAcc l . leavesAcc r +\end{verbatim} +Using the binary tree above as an example: +\begin{verbatim} + ? leaves ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (24 reductions, 73 cells) + ? leaves' ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (20 reductions, 58 cells) + ? +\end{verbatim} +\section{Type synonyms} +Type synonyms are used to provide convenient abbreviations for type +expressions. A type synonym is introduced by a declaration of the +form: +\BQ + \verb"type" \I{Name} $a_1$ \dots $a_n$ \verb"=" \I{expansion} +\EQ +where \I{Name} is the name of a new type constructor of arity +$n\geq 0$, +$a_1$, \dots, $a_n$ are distinct type variables +representing the arguments of \I{Name} +and \I{expansion} is a type expression. Note that the only type variables +permitted in the expansion type are those on the left hand side of the +synonym definition. Using this declaration any type expression of the +form: +\BQ + \I{Name} $\I{type}_1$ \dots $\I{type}_n$ +\EQ +is treated as an abbreviation of the type expression obtained from +expansion by replacing each of the type variables +$a_1$, \dots, $a_n$ with the +corresponding type $\I{type}_1$, \dots, $\I{type}_n$. + +The most frequently used type synonym is almost certainly the \verb"String" +type which is a synonym for \verb"[Char]": +\begin{verbatim} + type String = [Char] +\end{verbatim} +(This definition is actually built in to the Gofer system, but +the effect is the same as if this declaration were included in the +standard prelude.) + +Note that the types of expressions inferred by Gofer will not usually +contain any type synonyms unless an explicit type signature is given, +either using an explicitly typed expression (section 10.6) or a type +declaration (section 9.12): +\begin{verbatim} + ? :t ['c'] + ['c'] :: [Char] + ? :t ['c'] :: String + ['c'] :: String + ? +\end{verbatim} +Unlike the datatype declarations described in the previous section, +recursive (and mutually recursive) synonym declarations are not +permitted. This rules out examples such as: +\begin{verbatim} + type BadSynonym = [BadSynonym] +\end{verbatim} +and ensures that the process of expanding all of the type synonyms used +in any particular type expression will always terminate. The same +property does not hold for the illegal definition above, in which any +attempt to expand the type BadSynonym would lead to the non-terminating +sequence: +\begin{verbatim} + BadSynonym ==> [BadSynonym] ==> [[BadSynonym]] ==> .... +\end{verbatim} + + + + +\chapter{Dialogues: input and output} + +The Gofer system implements a subset of the facilities for programs +involving I/O described in the Haskell report [5]. In particular, this +makes it possible for Gofer programs to be run interactively, and to +make limited use of text files for both reading and writing. A +significant factor in the design of the Haskell I/O facilities is that +it allows the use of such programs without loss of referential +transparency. + +\section{Basic description} +Programs using the I/O facilities in Gofer are modelled by functions of +type Dialogue, defined by the type synonym: +\begin{verbatim} + type Dialogue = [Response] -> [Request] +\end{verbatim} +In other words, a Gofer program produces a list of output values, each +of which may be thought of as a request for some particular input or +output action, and obtains the corresponding list of operating system +responses as its input. Note that the input list of responses will be +evaluated lazily; i.e.\ we can ensure that we do not attempt to obtain +the response to a given request until that request has been completed. + +The current range of requests supported by Gofer is described by the +following datatype definition, taken from the standard prelude: +\begin{verbatim} + data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool +\end{verbatim} +Each response is an element of the type defined by the following +datatype definition, using an auxiliary datatype \verb"IOError" to describe a +variety of error conditions that may occur: +\begin{verbatim} + data Response = Success + | Str String + | Failure IOError + + data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String +\end{verbatim} +The following list describes the kind of I/O behaviour specified by +each form of Request and indicates the possible Response values that +may be obtained in each case: +\BI +\IT \verb"ReadFile string": Read contents of file named by + \verb"string". + Possible responses to this request are: + \BI + \IT \verb"Str contents" if the request is successful, + where \verb"contents" is + a string (evaluated lazily) containing the contents of the + file specified by the \verb"ReadFile" request. + \IT \verb"Failure (SearchError name)" occurs if file \verb"name" + cannot be + accessed. + \IT \verb"Failure (ReadError name)" occurs if some other error occurs + whilst opening the file \verb"name". + \EI +\IT \verb"WriteFile name string": Write the given + \verb"string" to the file + \verb"name". If the file does not already exist, it is created before + attempting to write the value to file. If the file already exists + then it will be truncated to zero length before the write begins. + No response is obtained until the string argument has been fully + evaluated and its contents written to file. Possible responses + are: + \BI + \IT \verb"Success" if the write to file was completed successfully. + \IT \verb"Failure (WriteError msg)" if an error was detected whilst + trying to perform the output. If the problem occurred whilst + attempting to open the specified file, then \verb"msg" contains + the filename, otherwise it contains a printable + representation of the evaluation error which occurred. + \EI +\IT \verb"AppendFile name string": + Similar to the \verb"WriteFile" request except + that the value of the given \verb"string" is appended onto the file + \verb"name" if that file already exists. The responses that may be + obtained from this request are the same as those for \verb"WriteFile". +\IT \verb"ReadChan name": Read from the input stream \verb"name". + Note that + it is an error to attempt to read from the same channel more than + once in the same program. Possible responses are: + \BI + \IT \verb"Str contents" if the request is successful, + where \verb"contents" + is a string (evaluated lazily) containing the list of + characters entered on the input stream. + \IT \verb"Failure (SearchError name)" if the named channel cannot be + found. The only input channel known to Gofer is the standard + input channel \verb"stdin". For convenience, the standard prelude + defines the variable stdin bound to this string. + \IT \verb"Failure (ReadError name)" if a \verb"ReadChan" + request for the named + channel has already been given by a previous request. + \EI +\IT \verb"AppendChan name string": + Output \verb"string" on channel \verb"name". No + response is obtained until the string has been fully evaluated and + written to the named channel. Possible responses are: + \BI + \IT \verb"Success" if the append to channel was completed successfully. + \IT \verb"Failure (SearchError name)" if the named channel cannot be + found. The only output channels known to Gofer are \verb"stdout", + \verb"stderr" and \verb"stdecho" + (which is actually just another name + for \verb"stdout" in Gofer). For convenience, the standard + prelude defines variables \verb"stdout", \verb"stderr" + and \verb"stdecho" bound to + the corresponding string values. + \IT \verb"Failure (WriteError msg)" if an error is detected whilst + trying to perform the output. The string \verb"msg" contains a + printable representation of the evaluation error which + occurred. + \EI +\IT \verb"Echo status": Set the echo status on the standard input channel + stdin to the given boolean value. If the echo status is \verb"True", + then user input will be echoed onto the screen as it is typed + and the usual line editing facilities (such a backspace or delete) + provided by the host system can be used to edit the input lines as + they are entered. If the echo status is False, then individual + characters may be read from the standard input channel without any + echo or line editing features. + + Note that at most one \verb"Echo" request can be used in a program, and + must precede any \verb"ReadChan" request for \verb"stdin". + If not set by an + explicit \verb"Echo" request, + the echo status defaults to \verb"True". Possible + responses are: + \BI + \IT \verb"Success" if the request was completed successfully. + \IT \verb"Failure (OtherError msg)" if the request could not be + completed either because a \verb"readChannel" request for + \verb"stdin" has + already been processed, or because a previous \verb"Echo" request + has already been given. The corresponding values of \verb"msg" + are {\tt stdin already in use} and + {\tt repeated Echo request} + respectively. + \EI +\EI +A simple example of a program using these facilities to output a short +message on the standard output stream is: +\begin{verbatim} + helloWorld :: Dialogue + helloWorld resps = [AppendChan stdout "hello, world"] +\end{verbatim} +Any expression entered into Gofer of type \verb"Dialogue" will be treated as +a Gofer program using I/O and will be executed accordingly: +\begin{verbatim} + ? helloWorld + hello, world + (1 reduction, 28 cells) + ? +\end{verbatim} +Notice that without the explicit type declaration, the type that would +be inferred for \verb"helloWorld" would +be \verb"a -> [Request]", and hence +\verb"helloWorld" would not be executed as a \verb"Dialogue" program. This point can +be illustrated using lambda expressions: +\begin{verbatim} + ? \resps -> [AppendChan stdout "hello, world"] + v128 + (1 reduction, 7 cells) + ? (\resps -> [AppendChan stdout "hello, world"]) :: Dialogue + hello, world + + (1 reduction, 28 cells) + ? +\end{verbatim} +In many cases the structure of an expression is enough to fully +determine its type as \verb"Dialogue" (or equivalently as +\verb"[Response] -> [Request]"), +in which case no explicit types are required to ensure that +the expression is treated as a Gofer program using I/O: +\begin{verbatim} + ? \~[Success] -> [AppendChan stdout "hello, world"] + hello, world + (1 reduction, 29 cells) + ? +\end{verbatim} +Note the use of the irrefutable pattern \verb"~[Success]" for the lambda +expression in the last example; without this, the usual rules of +pattern matching as described in section 9 would force Gofer to try to +match the pattern \verb"[Success]" against the list of responses, before the +corresponding request had been produced: +\begin{verbatim} + ? \ [Success] -> [AppendChan stdout "hello, world"] + + Aborting Dialogue: + {error "Attempt to read response before request complete"} + (50 reductions, 229 cells) + ? +\end{verbatim} +The next example takes a single string as a parameter and displays the +contents of the corresponding file: +\begin{verbatim} + showFile :: String -> Dialogue + showFile name ~(read:_) = [ReadFile name, AppendChan stdout result] + where result = case read of Str contents -> contents + Failure _ -> "Can't open " ++ name +\end{verbatim} +With a few modifications, we can implement a similar program which +prompts for, and reads, a filename from the standard input and then +reads and displays the contents of that file as before. This program +is based on a similar example in the Haskell report [5]: +\begin{verbatim} + main ~(Success : ~(Str userInput : ~(r3 : _))) + = [ AppendChan stdout "Please type a filename: ", + ReadChan stdin, + ReadFile name, + AppendChan stdout (case r3 of Str contents -> contents + Failure _ -> "Can't open " + ++ name) + ] where (name : _) = lines userInput +\end{verbatim} + + + + +\section{Continuation style I/O} +As an alternative to the `stream-based' approach to programs using the +I/O facilities in Gofer, the standard prelude defines a family of +functions which enables such programs to be written in a `continuation' +style. The basic idea is to define a function corresponding to each +different kind of request, whose parameters include the values required +to make the request together with two continuations. The continuations +are functions describing `what to do next', one of which is used if the +request is successful, the other if the request fails. + +As an example, the \verb"ReadFile" request is represented by the function +\verb"readFile" whose definition is equivalent to: +\begin{verbatim} + readFile name fail succ ~(r:rs) = ReadFile name : rest rs + where rest = case r of Str s -> succ s + Failure ioerror -> fail ioerror +\end{verbatim} +The first thing to happen when a dialogue expression of the form +\verb"readFile name fail succ" is evaluated is that the corresponding +request \verb"ReadFile name" is added to the list of I/O requests. A new +dialogue value \verb"rest" is chosen, depending on the response to the +ReadFile request, and the program continues by passing the remaining +part of the response list to \verb"rest". +The functions \verb"succ" and \verb"fail" +(called the success and failure continuations respectively) describe +the way in which the new dialogue \verb"rest" is obtained. + +The following example (edited a little to fit within the margins of this +document) shows how the readFile function described above can be used to +print the contents of a file called \verb"test" on the display: +\begin{verbatim} + ? readFile "test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + This is a test message + + (4 reductions, 52 cells) + ? +\end{verbatim} +The success continuation \verb"(\s resps->[AppendChan stdout s])" used here +receives the contents of the file \verb"test" in the the parameter \verb"s" and +uses an \verb"AppendChan" request to output that string on the display. As +this example shows, the stream based approach of the previous section +can be combined with the continuation based style of I/O without any +difficulty. The failure continuation \verb"(\ioerror resps -> [])" ignores +the error condition \verb"ioerror" which caused the request to fail and +gives a dialogue which terminates immediately without any action. For +example, assuming that the file \verb"Test" cannot be found: +\begin{verbatim} + ? readFile "Test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + + (4 reductions, 24 cells) + ? +\end{verbatim} +In practice, it is usually a good idea to produce some kind of +diagnostic message when an error occurs: +\begin{verbatim} + ? readFile "Test" + (\ioerror resps -> [AppendChan stdout (show' ioerror)]) + (\s resps -> [AppendChan stdout s]) + SearchError "Test" + (11 reductions, 59 cells) + ? +\end{verbatim} +In each of the examples above, the failure continuation has type +\verb"FailCont" as defined by the following type synonym in the standard +prelude: +\begin{verbatim} + type FailCont = IOError -> Dialogue +\end{verbatim} +Similarly, the success continuation, which takes a string representing +an input string and produces a new Dialogue has type \verb"StrCont": +\begin{verbatim} + type StrCont = String -> Dialogue +\end{verbatim} +A third kind of continuation is needed for those requests which return +a response of the form \verb"Success" if successful (e.g.\ output +requests). In this case the continuation is simply another dialogue: +\begin{verbatim} + type SuccCont = Dialogue +\end{verbatim} +The following list gives the type of each of the six functions +corresponding to the six different kinds of I/O request described in +the previous section. Full definitions for each of these functions are +given in appendix B: +\begin{verbatim} + readFile :: String -> FailCont -> StrCont -> Dialogue + writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue + appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue + readChan :: String -> FailCont -> StrCont -> Dialogue + appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue + echo :: Bool -> FailCont -> SuccCont -> Dialogue +\end{verbatim} +As an illustration of the use of these functions, we show how each of +the example programs from the previous section can be rewritten using +the continuation based style of I/O, starting with the program +\verb"helloWorld": +\begin{verbatim} + helloWorld :: Dialogue + helloWorld = appendChan stdout "hello, world" abort done +\end{verbatim} +In this case, the explicit type declaration is not actually required +since the type of the expression is completely determined by the type +of \verb"appendChan". The failure continuation +\verb"abort" is equivalent to the +function \verb"(\ioerror resps -> [])" described above and terminates the +program if an error occurs without any further action. In a similar +way, \verb"done" is the trivial dialogue which terminates immediately +without any action. Both of these values are defined in the standard +prelude: +\begin{verbatim} + done :: Dialogue + done resps = [] + abort :: FailCont + abort ioerror = done +\end{verbatim} +Using the same approach, the \verb"showFile" and \verb"main" programs from the +previous section are written as: +\begin{verbatim} + showFile :: String -> Dialogue + showFile name + = readFile name (\ioerror -> appendChan stdout + ("Can't open " ++ name) abort done) + (\contents-> appendChan stdout contents abort done) + + main :: Dialogue + main = appendChan stdout "Please type a filename: " abort + (readChan stdin abort + (\userInput -> let (name : _) = lines userInput in + readFile name + (\ioerror -> appendChan stdout ("Can't open " ++ name) + abort done) + (\contents -> appendChan stdout contents abort done))) +\end{verbatim} + +\section{Interactive programs} +One of the principal motivations for including facilities for I/O in +Gofer programs was to provide a way of using interactive programs as +described in [1]. An interactive program is represented by a function +of type \verb"String -> String" mapping an input string of characters entered +at the keyboard into an output string to be displayed on the screen. + +There are two functions defined in the standard prelude which can be +used to `execute' functions of this kind as interactive programs: +\BI +\IT \verb"interact f" executes + \verb"f::String->String" as an interactive program + with echo on. This means that characters are read from the + keyboard a line at a time. The usual editing characters such as + backspace can be used to correct mistakes which are noticed before + the return key is pressed at the end of each line. The input + stream can be terminated by typing an end of file character at the + beginning of a line: +\begin{verbatim} + ? interact (map toUpper) + This text was entered using the interact function + THIS TEXT WAS ENTERED USING THE INTERACT FUNCTION + ^Z + (874 reductions, 1037 cells) + ? +\end{verbatim} +\IT \verb"run f" behaves like + \verb"interact f" except that echo is turned off. + In this case, the only way of terminating the input stream without + reaching the end of the string produced by \verb"f" is to use the + interrupt key: +\begin{verbatim} + ? run (map toUpper) + ALTHOUGH THIS IS ENTERED IN LOWER CASE, IT STILL + APPEARS IN UPPER CASE ! + {Interrupted!} + + (1227 reductions, 1463 cells) + ? +\end{verbatim} +\EI +(Of these two functions, only \verb"interact" is also included in the +standard prelude for Haskell, although \verb"run" may also be added to a +Haskell system using the definition below.) + +The definitions of \verb"interact" and \verb"run" +provide further examples of +Gofer programs using simple I/O facilities: +\begin{verbatim} + interact :: (String -> String) -> Dialogue + interact f = readChan stdin abort + (\s -> appendChan stdout (f s) abort done) + + run :: (String -> String) -> Dialogue + run f = echo False abort (interact f) +\end{verbatim} +(Exercise for the interested reader: construct alternative definitions +for these functions using the stream based approach from section 12.1.) + +\chapter{Layout} + +\section{Comments} +Comments provide an informal but useful way of annotating a program +with a description of its purpose, structure and development. +Following the definition of Haskell, two styles of comment are +supported by Gofer: +\BI +\IT A one line comment begins with the two characters \verb"--" and is + terminated at the end of the same line. Note that an operator + symbol cannot begin with \verb"--" as this will be treated as the + beginning of a comment. It is however possible to use the two + characters \verb"--" at any other position within an operator symbol. + Thus a line such as: +\begin{verbatim} + (xs ++ ys) -- xs +\end{verbatim} + includes a comment and will actually be treated as if the line had + been written: +\begin{verbatim} + (xs ++ ys) +\end{verbatim} + Whereas the line: +\begin{verbatim} + xs >--> ys >--> zs +\end{verbatim} + does not contain any comments (although it will cause an error + unless \verb">-->" has been defined using an + appropriate \verb"infixl" or + \verb"infixr" declaration). +\IT A nested comment begins with the characters \verb"{-", ends with the + characters \verb"-}" and may span any number of lines. The + initial \verb"{-" string + cannot overlap with the terminating \verb"-}" + string so that the shortest possible nested comment is \verb"{--}", and + not \verb"{-}". An unterminated nested comment will be treated as an + error. + + As the name suggests, comments of this kind may be nested so that +\begin{verbatim} + {- {- ... -} ... {- ... -} -} +\end{verbatim} + is treated as a single comment. + This makes nested comments particularly convenient for enclosing + parts of a program which may already contain other nested + comments. +\EI +Both kinds of comment may be used in expressions entered directly into +the Gofer system, or more usually, in files of definitions loaded into +Gofer. The two styles of comment may be mixed within the same +expression or program, remembering that the string \verb"--" has no special +significance within a nested comment and that the strings \verb"{-" +and \verb"-}" +have no special significance in a single line comment. Thus: +\begin{verbatim} + [ 2, -- {- [ 2, {- + 3, -- -} -- -} 3, + 4 ] 4 ] +\end{verbatim} +are both equivalent to the list expression \verb"[2,3,4]". + +\section{The layout rule} +In a tradition dating back at least a quarter of a century to Landin's +ISWIM family of languages, most Gofer programs use indentation to +indicate the structure of a program. For example, in a definition such +as: +\begin{verbatim} + f x y = g (x + w) + where g u = u + v + where v = u * u + w = 2 + y +\end{verbatim} +it is clear from the layout that the definition of w is intended to be +local to f rather than to g. Another example where layout plays an +important role is in distinguishing the two definitions: +\begin{verbatim} + example x y z = a + b example x y z = a + b + where a = f x y where a = f x + b = g z y b = g z +\end{verbatim} +There are three situations in Gofer where indentation is typically used +to determine the structure of a program: +\BSI +\IT At the top-level of a file of definitions. +\IT In a group of local declarations following either of the keywords + \verb"let" or \verb"where". +\IT In a group of alternatives in a case expression, following the + keyword \verb"of". +\ESI +In each case, Gofer actually expects to find a list of items enclosed +between braces `\verb"{"' and `\verb"}"' +with individual items separated from one +another by semicolons `\verb";"'. However, if the leading brace is not found +then Gofer uses the layout rule described below to arrange for +`\verb"{"', `\verb"}"' +and `\verb";"' tokens to be inserted into the input stream automatically +according to the indentation of each line. + +In this way, the first example above will in fact be treated as if the +user had entered: +\begin{verbatim} + f x y = g (x + w) + where {g u = u + v + where {v = u * u + }; w = 2 + y + } +\end{verbatim} +or, equivalently, just: +\begin{verbatim} + f x y = g (x + w) where {g u = u + v where {v = u * u}; w = 2 + y} +\end{verbatim} +where the additional punctuation using +the `\verb"{"', `\verb"}"' and `\verb";"' characters +makes the intended grouping clear, regardless of indentation. + +The layout rule used in Gofer is the same as that of Haskell, and can +be described as follows: +\BI +\IT An opening brace `\verb"{"' is inserted in front of the first token at + the beginning of a file or following one of the keywords \verb"where", + \verb"let" or \verb"of", unless that token is itself an opening brace. +\IT A `\verb";"' token is inserted in front of the first token in any subsequent + line with exactly the same indentation as the token in front of + which the opening brace was inserted. +\IT The layout rule ends and a `\verb"}"' token is inserted in front of the + first token in a subsequent line whose indentation is strictly + less than that of the token in front of which the opening brace + was inserted. +\IT A closing brace `\verb"}"' will also be inserted at any point where an + otherwise unexpected token is encountered. This part of the rule + makes it possible to use expressions such as: +\begin{verbatim} + let a = fact 12 in a+a +\end{verbatim} + without needing to use the layout characters explicitly as in: +\begin{verbatim} + let {a = fact 12} in a+a. +\end{verbatim} +\IT Lines containing only whitespace (blanks and tabs) and comments do + not affect the use of the layout rule. +\IT For the purposes of determining the indentation of each line in a + file, tab stops are assumed to be placed every 8 characters, with + the leftmost tab stop in column 9. Each tab character inserts one + or more spaces as necessary to move to the next tab stop. +\IT The indentation of the end of file token is zero. +\EI +The following (rather contrived) program, is based on an example in the +Haskell report [5], and provides an extended example of the use of the +layout rule. A file containing the following definitions: +\begin{verbatim} + data Stack a = Empty + | MkStack a (Stack a) + + push :: a -> Stack a -> Stack a + push x s = MkStack x s + + size :: Stack a -> Int + size s = length (stkToList s) where + stkToList Empty = [] + stkToList (MkStack x s) = x:xs where xs = stkToList s + + pop :: Stack a -> (a, Stack a) + pop (MkStack x s) = (x, case s of r -> i r where i x = x) + + top :: Stack a -> a + top (MkStack x s) = x +\end{verbatim} +will be treated by Gofer as if it has been written: +\begin{verbatim} + {data Stack a = Empty + | MkStack a (Stack a) + + ;push :: a -> Stack a -> Stack a + ;push x s = MkStack x s + + ;size :: Stack a -> Int + ;size s = length (stkToList s) where + {stkToList Empty = [] + ;stkToList (MkStack x s) = x:xs where {xs = stkToList s + + }};pop :: Stack a -> (a, Stack a) + ;pop (MkStack x s) = (x, case s of {r -> i r where {i x = x}}) + + ;top :: Stack a -> a + ;top (MkStack x s) = x + } +\end{verbatim} +Note that some of the more sophisticated forms of expression cannot be +written on a single line (and hence entered directly into the Gofer +system) without explicit use of the layout characters +`\verb"{"', `\verb"}"' and `\verb";"': +\begin{verbatim} + ? len [1..10] where len [] = 0; len (x:xs) = 1 + len xs + 10 + (81 reductions, 108 cells) + + ? f True where f x = case x of True->n where {n=not x}; False->True + False + (4 reductions, 11 cells) + + ? +\end{verbatim} +One situation in which the layout rule can cause problems is with +top-level definitions. For example, the two lines: +\begin{verbatim} + f x = 1 + x + g y = 1 - y +\end{verbatim} +will be treated as a single line +\begin{verbatim} + f x = 1 + x g y = 1 - y +\end{verbatim} +which will +cause a syntax error. This kind of problem becomes rather more +difficult to spot if the two definitions are not on subsequent lines, +particularly if they are separated by several lines of comments. For +this reason, it is usually a good idea to ensure that all of the +top-level definitions in a file start in the same column (the first +column is usually the most convenient). {\sc Cobol} and Fortran programmers +are not likely to find this problem too distressing :--) + +\chapter{Overloading in Gofer} + +One of the biggest differences between Gofer and most other programming +languages (with the exception of Haskell) is the approach to +overloading; enabling the definition and use of functions in which the +meaning of a function symbol may depend on the types of its arguments. + +Like Haskell, overloading in Gofer is based around a system of type +classes which allow overloaded functions to be grouped together into +related groups of functions. Whilst the precise details of the +approach to type classes used by Gofer are quite different from those of +Haskell, both rely on the same basic ideas and use a similar syntax for +defining and using type classes. It would therefore seem possible that +experience gained with the overloading system in one language can +readily by applied to the other. + +The differences embodied in the Gofer system of classes stem from my +own, theoretically based investigations into `qualified types' some of +which is detailed in references [8-12]. In my personal opinion, the +Gofer system has some significant advantages over the Haskell approach +(see [12] for details) and one of the principal motivations behind the +implementation to Gofer was to provide a way of testing such claims. +One fact which I believe has already been established using Gofer is +that the use and implementation of overloaded functions need not have +the significant effect on performance that was anticipated with early +implementations of Haskell. + +This section outlines the system of type classes used in Gofer, +indicating briefly how they can be used and how they are implemented. + + +\section{Type classes and predicates} +A type class can be thought of as a family of types (or more generally +as a family of tuples of types) whose elements are called instances of +the class. If $C$ is the name of an $n$-parameter type class then an +expression of the form $C\; t_1\; t_2 \dots t_n$ +where $t_1$, $t_2$, \dots, $t_n$ are type +expressions is called a predicate and represents the assertion that the +specified tuple of types is an instance of the class~$C$. + +Given a polymorphic function (e.g.\ \verb"map::(a->b)->[a]->[b]"), we are free +to use the function at any type which can be obtained by substituting +arbitrary types for each of the type variables in its type. In Gofer, +a type expression may be qualified by one or more predicates which +restrict the range of types at which a value can be used. +For example, a function of type +\verb"C a => a -> a -> a" can be treated as a function +of type \verb"t -> t -> t" for any instance \verb"t" of the class \verb"C". + +The predicate \verb"C a" in the type expression in the previous example is +called the context of the type. Contexts may contain more than one +predicate in which case the predicates involved must be separated by +commas and the context enclosed in parentheses as in \verb"(C a, D b)". The +empty context is written \verb"()" and any type expression \verb"t" +is equivalent to +the qualified type \verb"() => t". For uniformity, a context with only one +element may also be enclosed by parentheses. +For technical reasons, type synonyms are not currently permitted in +predicates. This is consistent with the use of predicates in Haskell, +but may be relaxed, at least in certain cases, in later versions of +Gofer. + + +\section{The type class Eq} +The type class \verb"Eq" is a simple and useful example, whose instances are +precisely those types whose elements can be tested for equality. The +declaration of this class given in the standard prelude is as follows: +\begin{verbatim} + + class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) +\end{verbatim} +There are three parts in any class declaration. For this particular +example we have: +\BI +\IT The first line (called the `header') of the declaration introduces + a name \verb"Eq" for the class and indicates that it has a single + parameter, represented by the type variable \verb"a". + +\IT The second line of the declaration (the `signature part') + indicates that there are functions denoted by the operator symbols + \verb"(==)" and \verb"(/=)" of type \verb"a -> a -> Bool" + for each instance a of class + \verb"Eq". Using the notation introduced in the previous section, both + of these operators have type: +\begin{verbatim} + Eq a => a -> a -> Bool +\end{verbatim} + These functions are called the `members' (or `member functions') + of the class. (This terminology, taken from Haskell, is rather + unfortunate; thinking of a type class as a set of types, the + elements of the class are called `instances', whilst the `members' + of the class correspond more closely to the instance variables + that are used in the terminology of object-oriented programming.) + + The intention is that the \verb"(==)" function will be used to implement + an equality test for each instance of the class, with the \verb"(/=)" + operator providing the corresponding inequality function. The + ability to include related groups of functions within a single + type class in this way is a useful tool in program design. + +\IT The third line of the class declaration (the `default + definitions') provides a default definition of the \verb"(/=)" operator + in terms of the \verb"(==)" operator. Thus it is only necessary to give + a definition for the \verb"(==)" operator in order to define all of the + member functions for the class \verb"Eq". It is possible to override + default member definitions by giving an alternative definition as + appropriate for specific instances of the class. +\EI +\subsection{Implicit overloading} +Member functions are clearly marked as overloaded functions by their +definition as part of a class declaration, but this is not the only way +in which overloaded functions occur in Gofer; the restriction to +particular instances of a type class is also carried over into the type +of any function defined either directly or indirectly in terms of the +member functions of that class. For example, the types inferred for +the following two functions: +\begin{verbatim} + x `elem` xs = any (x==) xs + xs `subset` ys = all (`elem` ys) xs +\end{verbatim} +are: +\begin{verbatim} + elem :: Eq a => a -> [a] -> Bool + subset :: Eq a => [a] -> [a] -> Bool +\end{verbatim} +(On the other hand, if none of the functions used in a +particular expression or definition are overloaded then there will not +be any overloading in the corresponding value. Gofer does not support +the concept of implicit overloading used in some languages where a +value of a particular type might automatically be coerced to a value of +some supertype. An example of this would be the automatic translation +of a badly typed expression \verb"1.0 == 1" to a well-typed expression of +the form \verb"1.0 == float 1" for some (potentially overloaded) coercion +function \verb"float" mapping numeric values to elements of type Float.) + +Note also that the types appearing in the context of a qualified type +reflect the types at which overloaded functions are used. Thus: +\begin{verbatim} + f x ys = [x] == ys +\end{verbatim} +has type \verb"Eq [a] => a -> [a] -> Bool", +and not \verb"Eq a => a -> [a] -> Bool", +which is the type that would be assigned to \verb"f" in a Haskell system. + + +\subsection{Instances of class Eq} +Instances of a type class are defined using declarations similar to +those used to define the corresponding type class. The following +examples, taken from the standard prelude, give the definitions for a +number of simple instances of the class \verb"Eq": +\begin{verbatim} + instance Eq Int where (==) = primEqInt + + instance Eq Bool where + True == True = True + False == False = True + _ == _ = False + + instance Eq Char where c == d = ord c == ord d + + instance (Eq a, Eq b) => Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + + instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys +\end{verbatim} +The interpretation of these declarations is as follows: +\BI +\IT The first declaration makes \verb"Int" an instance of + class \verb"Eq". The + function \verb"primEqInt" is a primitive Gofer function which tests the + equality of two integer values and has type \verb"Int->Int->Bool" + which tests the equality of two integer values. + +\IT The second declaration makes \verb"Bool" an + instance of class \verb"Eq" with a + simple definition involving pattern matching. + +\IT The third declaration makes \verb"Char" + an instance of class \verb"Eq". This + definition indicates that a pair of characters are equal if they + have the same {\sc ascii} value, + which is obtained using the \verb"ord" + function. Note that the two occurrences of the symbol \verb"(==)" in the + equation: +\begin{verbatim} + c == d = ord c == ord d +\end{verbatim} + have different meanings; the first denotes equality between + characters (elements of type \verb"Char"), whilst the second denotes + equality between integers (elements of type \verb"Int"). + +\IT The fourth declaration provides an equality operation on pairs. + Given two elements \verb"(x,y)" and \verb"(u,v)" + of type \verb"(a,b)" for some \verb"a", \verb"b", it + must be possible to check that both \verb"x==u" and \verb"y==v" + before we can be + sure that the two pairs are indeed equal. In other words, both \verb"a" + and \verb"b" must also be instances of \verb"Eq" + in order to make \verb"(a,b)" an + instance of \verb"Eq". This requirement is described by the first line + in the instance declaration using the expression: +\begin{verbatim} + (Eq a, Eq b) => Eq (a,b) +\end{verbatim} + +\IT The fifth declaration makes \verb"[a]" an instance of \verb"Eq", + whenever \verb"a" is + itself an instance of \verb"Eq" in a similar way to the previous + example. The context \verb"Eq" a is used in the last equation in the + declaration: +\begin{verbatim} + (x:xs) == (y:ys) = x==y && xs==ys +\end{verbatim} + which contains three occurrences of the \verb"(==)" operator; the first + and third are used to compare lists of type \verb"[a]", whilst the second + is used to compare elements of type \verb"a", using the + instance \verb"Eq a". +\EI +Combining these five declarations, we obtain definitions for \verb"(==)" on an +infinite family of types including +\verb"Int", \verb"Char", \verb"Bool", \verb"(Int,Bool)", +\verb"(Char,Int)", \verb"[Char]", +\verb"(Bool,[Int])", \verb"[(Bool,Int)]", etc.: +\begin{verbatim} + ? 2 == 3 -- using Eq Int + False + (2 reductions, 10 cells) + ? (["Hello"],3) == (["Hello"],3) -- using Eq ([[Char]],Int) + True + (31 reductions, 65 cells) + ? +\end{verbatim} +On the other hand, any attempt to use \verb"(==)" to compare elements of some +type not covered by a suitable instance declaration will result in an +error. For example, the standard prelude does not define the equality +operation on triples of values: +\begin{verbatim} + ? (1,2,3) == (1,2,3) + ERROR: Cannot derive instance in expression + *** Expression : (==) d125 (1,2,3) (1,2,3) + *** Required instance : Eq (Int,Int,Int) + ? +\end{verbatim} +This can be solved by including an instance declaration of the following form +into a file of definitions loaded into Gofer: +\begin{verbatim} + instance (Eq a, Eq b, Eq c) => Eq (a,b,c) where + (x,y,z) == (u,v,w) = x==u && y==v && z==w +\end{verbatim} +Giving: +\begin{verbatim} + ? (1,2,3) == (1,2,3) + True + (6 reductions, 20 cells) + ? +\end{verbatim} +In general, an instance declaration has the form: +\BQ + \verb"instance" \I{context} \verb"=>" \I{predicate} \verb"where"\\ + {\em definitions of member functions} +\EQ + +The context part of the declaration gives a list of predicates which +must be satisfied for the predicate on the right hand side of the `\verb"=>"' +sign to be valid. Constant predicates (i.e.\ predicates not involving +any type variables) required by an instance declaration (such as the +predicate \verb"Eq Int" required by the third declaration) need not be +included in the context. If the resulting context is empty (as in the +first three declarations above) then it may be omitted, together with +the corresponding `\verb"=>"' symbol. + + +\subsection{Testing equality of represented values} +Instances of \verb"Eq" can also be defined for other types, including +user-defined datatypes, and unlike the instances described above, the +definition of \verb"(==)" need not be used to determine whether the values +being compared have the same structure; it is often more useful to +check that they represent the same value. As an example, suppose that +we introduce a type constructor Set for representing sets of values, +using a list to store the values held in the set: +\begin{verbatim} + data Set a = Set [a] +\end{verbatim} +As usual, we say that two sets are equal if they have the same members, +ignoring any repetitions or differences in the ordering of the elements +in the lists representing the sets. This is achieved using the +following instance declaration: +\begin{verbatim} + instance Eq a => Eq (Set a) where + Set xs == Set ys = xs `subset` ys && ys `subset` xs + where xs `subset` ys = all (`elem` ys) xs +\end{verbatim} +A couple of examples illustrate the use of this definition: +\begin{verbatim} + ? Set [1,2,3] == Set [3,4,1] + False + (49 reductions, 89 cells) + ? Set [1,2,3] == Set [1,2,2,2,1,3] + True + (157 reductions, 240 cells) + ? +\end{verbatim} + +\subsection{Instance declarations without members} +It is possible to give an instance declaration without specifying any +definitions for the member functions of the class. For example: +\begin{verbatim} + instance Eq () +\end{verbatim} +In this case, the definition of \verb"(==)" for the instance \verb"Eq ()" +is left +completely undefined, and hence so is the definition of \verb"(/=)", which is +defined in terms of \verb"(==)": +\begin{verbatim} + ? () == () + {undefined_member (==)} + (3 reductions, 34 cells) + ? () /= () + {undefined_member (==)} + (4 reductions, 36 cells) + ? +\end{verbatim} + +\subsection{Equality on function types} +If an expression requires an instance of a class which cannot be +obtained using the rules in the given instance declarations, then an +error message will be produced when the expression is type-checked. +For example, in general there is no sensible way to determine when a +pair of functions are equal, and the standard prelude does not include +a definition for an instance of the form \verb"Eq (a -> b)" for any +types \verb"a" +and \verb"b": +\begin{verbatim} + ? (1==) == (\x->1==x) + ERROR: Cannot derive instance in expression + *** Expression : (==) d148 ((==) {dict} 1) (\x->(==) {dict} 1 x) + *** Required instance : Eq (Int -> Bool) + ? +\end{verbatim} +If for some reason, you would prefer this kind of error to produce an +error message when an expression is evaluated, rather than when it is +type-checked, you can use an instance declaration to specify the +required behaviour. For example: +\begin{verbatim} + instance Eq (a -> b) where + (==) = error "Equality not defined between functions" +\end{verbatim} +Evaluating the previous expression once this instance declaration has +been included now produces the following result: +\begin{verbatim} + ? (1==) == (\x->1==x) + {error "Equality not defined between functions"} + (42 reductions, 173 cells) + ? +\end{verbatim} +A limited form of equality can be defined for functions of type \verb"(a->b)" +if \verb"a" has only finitely many elements, such as the boolean +type \verb"Bool": +\begin{verbatim} + instance Eq a => Eq (Bool -> a) where + f == g = f False == g False && f True == g True +\end{verbatim} +(This instance declaration would not be accepted in a Haskell +program which insists that the predicate on the right of the `\verb"=>"' +symbol contains precisely one type constructor symbol.) + +Using this instance declaration once for each argument, we can now test +two functions taking boolean arguments for equality (assuming of course +that their result type is also an instance of \verb"Eq"). +\begin{verbatim} + ? (&&) == (||) + False + (9 reductions, 21 cells) + ? not == (\x -> if x then False else True) + True + (8 reductions, 16 cells) + ? (&&) == (\x y-> if x then y else False) + True + (16 reductions, 30 cells) + ? +\end{verbatim} + +\subsection{Non-overlapping instances} +Other instance declarations for types of the form \verb"a->b" can be used at +the same time, so long as no pair of declarations overlap. For +example, adding the following instance declaration +\begin{verbatim} + instance Eq a => Eq (() -> a) where f == g = f () == g () +\end{verbatim} +enables us to evaluate expressions such as: +\begin{verbatim} + ? (\()->"Hello") == const "Hello" + True + (30 reductions, 55 cells) + ? +\end{verbatim} +If however, we try to use instance declarations for types of the form +\verb"(a->b)" and \verb"(Bool->a)" +at the same time, then Gofer produces an error +message similar to the following: +\begin{verbatim} + ERROR "file" (line 37): Overlapping instances for class "Eq" + *** This instance : Eq (a -> b) + *** Overlaps with : Eq (Bool -> a) + *** Common instance : Eq (Bool -> a) + ? +\end{verbatim} +indicating that, given the task of testing two values of type \verb"(Bool->a)" +for equality, there are (at least) two definitions of \verb"(==)" that could +be used, with potentially different results being obtained in each +case. + +Here is a further example of the use of non-overlapping instances of a +class to define a function \verb"cat" (inspired by the Unix command of +the same name) which uses the I/O facilities of Gofer to print the +contents of one or more files on the terminal: +\begin{verbatim} + class Cat a where cat :: a -> Dialogue + instance Cat [Char] where cat n = showFile n done + instance Cat [[Char]] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) +\end{verbatim} +Given these declarations, an expression of the form: +\begin{verbatim} + cat "file" +\end{verbatim} +can be used to display the contents of the named file, whilst a list of +files can be printed one after the other using an expression of the +form: +\begin{verbatim} + cat ["file1", "file2", ..., "filen"]. +\end{verbatim} + +\section{Dictionaries} +In order to understand some of the messages produced by Gofer, as well +as some of the more subtle problems associated with overloaded +functions, it is useful to have a rough idea of the way in which +overloaded functions are implemented. + +The basic idea is that a function with a qualified type \verb"context => type" +where \verb"context" is a non-empty list of predicates is implemented by a +function which takes an extra argument for each predicate in the +context. When the function is used, each of these parameters is filled +by a `dictionary' which gives the values of each of the member +functions in the appropriate class. None of these extra parameters is +entered by the programmer. Instead, they are inserted automatically +during type-checking. + +For the class \verb"Eq", each dictionary has at least two elements containing +definitions for each of the functions \verb"(==)" and +\verb"(/=)". A dictionary for +an instance of \verb"Eq" can be depicted by a diagram of the form: +\BQ +% +--------+--------+--------- +% | | | +% | (==) | (/=) | ..... +% | | | +% +--------+--------+--------- +\setlength{\unitlength}{1mm} +\begin{picture}(60,10) +\put(0,0){\line(1,0){60}} +\put(0,10){\line(1,0){60}} +\put(0,0){\line(0,1){10}} +\put(20,0){\line(0,1){10}} +\put(40,0){\line(0,1){10}} +\put(10,5){\makebox(0,0){{\tt (==)}}} +\put(30,5){\makebox(0,0){{\tt (/=)}}} +\put(50,5){\makebox(0,0){{\dots}}} +\end{picture} +\EQ +In order to produce useful error messages and indicate the way in which +dictionary expressions are being used, Gofer uses a number of special +notations for printing expressions involving dictionaries: +\BQ +\begin{tabular}{lp{10cm}} + \verb"(#1" \I{d}\verb")" & + selects the first element of the dictionary \I{d}\\ + \verb"(#2" \I{d}\verb")" & + selects the second element of the dictionary \I{d}\\ + \verb"(#"\I{n} \I{d}\verb")" & + selects the \I{n}th element of the dictionary \I{d} + (note that \verb"(#0 d)" is equivalent to the dictionary \I{d}).\\ + \verb"{"\I{dict}\verb"}" & + denotes a specific dictionary (the contents are not + displayed).\\ + \verb"d"\I{nnn} & + a dictionary variable representing an unknown dictionary is + printed as a lower case letter `\verb"d"' followed by an integer; + e.g.\ \verb"d231". +\end{tabular} +\EQ +Note that, whilst these notations are used in output produced by Gofer +and in the following explanations, they cannot be entered directly into +Gofer expressions or programs -- even if you use a variable such as +\verb"d1" in an expression, Gofer will not confuse this with a dictionary +variable with the same name (although Gofer might confuse you by using +the same name in two different contexts!). + +Using these notations, the member functions \verb"(==)" and \verb"(/=)" +of the class +\verb"Eq" behave as if they were defined by the expressions: +\begin{verbatim} + (==) d1 = (#1 d1) + (/=) d1 = (#2 d1) +\end{verbatim} +To understand how these definitions work, we need to take a look at a +specific dictionary. Following the original instance declaration used +for \verb"Eq Int", the corresponding dictionary is: +\BQ +% d :: Eq Int +% +------------+------------+ +% | | | +% | primEqInt | defNeq d | +% | | | +% +------------+------------+ +% +\setlength{\unitlength}{1mm} +\begin{picture}(60,14) +\put(0,0){\line(1,0){40}} +\put(0,10){\line(1,0){40}} +\put(0,0){\line(0,1){10}} +\put(20,0){\line(0,1){10}} +\put(40,0){\line(0,1){10}} +\put(10,5){\makebox(0,0){{\tt primEqInt}}} +\put(30,5){\makebox(0,0){{\tt defNeq d}}} +\put(0,11){\makebox(0,0)[bl]{{\tt d :: Eq Int}}} +\end{picture} +\EQ +Note that the dictionary variable \verb"d" is used as a name for the +dictionary in this diagram, indicating how values within a dictionary +can include references to the same dictionary. + +It turns out that predicates play a very similar role for +dictionaries as types play for normal values. This motivates our use +of the notation \verb"d :: Eq Int" to indicate that \verb"d" +is a dictionary for the +instance \verb"Eq Int". One difference between these, particularly important +for theoretical work, is that dictionary values are uniquely determined +by predicates; if \verb"d1::p" and \verb"d2::p" +for some predicate \verb"p", then \verb"d1 = d2". + +The value held in the first element of the dictionary is the primitive +equality function on integers, \verb"primEqInt". The following diagram +shows how the dictionary is used to evaluate the expression \verb"2 == 3". +Note that this expression will first be translated to \verb"(==) d 2 3" by +the type checker. The evaluation then proceeds as follows: +\begin{verbatim} + (==) d 2 3 ==> (#1 d) 2 3 + ==> primEqInt 2 3 + ==> False +\end{verbatim} +The second element of the dictionary is a little more interesting +because it uses the default definition for \verb"(/=)" given in the original +class definition which, after translation, is represented by the +function \verb"defNeq" defined by: +\begin{verbatim} + defNeq d1 x y = not ((==) d1 x y) +\end{verbatim} +Notice the way in which the extra dictionary parameter is used to +obtain the appropriate overloading. For example, evaluation of the +expression \verb"2 /= 3", which becomes \verb"(/=) d 2 3" +after translation, +proceeds as follows: +\begin{verbatim} + (/=) d 2 3 ==> (#2 d) 2 3 + ==> defNeq d 2 3 + ==> not ((==) d 2 3) + ==> not ((#1 d) 2 3) + ==> not (primEqInt 2 3) + ==> not False + ==> True +\end{verbatim} +(Clearly there is some scope for optimisation here; whilst the actual +reduction sequences used by Gofer are equivalent to those illustrated +above, the precise details are a little different.) + +If an instance is obtained from an instance declaration with a +non-empty context, then the basic two element dictionary used in the +examples above is extended with an extra dictionary value for each +predicate in the context. As an example, the diagram below shows the +dictionaries that will be created from the instance definitions in +section 14.2.2 for the instance \verb"Eq (Int, [Int])". The functions +\verb"eqPair" and \verb"eqList" +which are used in these dictionaries are obtained +from the definitions of \verb"(==)" given in the +instance declarations for \verb"Eq" +\verb"(a,b)" and \verb"Eq [a]" respectively: +\begin{verbatim} + eqPair d (x,y) (u,v) = (==) (#3 d) x u && (==) (#4 d) y v + + eqList d [] [] = True + eqList d [] (y:ys) = False + eqList d (x:xs) [] = False + eqList d (x:xs) (y:ys) = (==) (#3 d) x y && (==) d xs ys +\end{verbatim} +The dictionary structure for \verb"Eq (Int, [Int])" is as follows. Note that +the Gofer system ensures that there is at most one dictionary for a +particular instance of a class, and that the dictionary \verb"d1 :: Eq Int" in +this system is automatically shared between \verb"d2" and \verb"d3": +\BQ +\setlength{\unitlength}{1mm} +\begin{picture}(120,40) +\put(20,0){\line(1,0){40}} +\put(20,8){\line(1,0){40}} +\put(60,12){\line(1,0){60}} +\put(60,20){\line(1,0){60}} +\put(0,28){\line(1,0){80}} +\put(0,36){\line(1,0){80}} +\put(20,0){\line(0,1){8}} +\put(40,0){\line(0,1){8}} +\put(60,0){\line(0,1){8}} +\put(60,12){\line(0,1){8}} +\put(80,12){\line(0,1){8}} +\put(100,12){\line(0,1){8}} +\put(120,12){\line(0,1){8}} +\put(0,28){\line(0,1){8}} +\put(20,28){\line(0,1){8}} +\put(40,28){\line(0,1){8}} +\put(60,28){\line(0,1){8}} +\put(80,28){\line(0,1){8}} +\put(50,32){\vector(0,-1){24}} +\put(90,32){\vector(0,-1){12}} +\put(110,4){\vector(-1,0){48}} +\put(110,16){\line(0,-1){12}} +\put(70,32){\line(1,0){20}} +\put(50,32){\circle*{1.5}} +\put(70,32){\circle*{1.5}} +\put(110,16){\circle*{1.5}} +\put(30,4){\makebox(0,0){{\tt primEqInt}}} +\put(50,4){\makebox(0,0){{\tt defNeq d1}}} +\put(70,16){\makebox(0,0){{\tt eqList d2}}} +\put(90,16){\makebox(0,0){{\tt defNeq d2}}} +\put(10,32){\makebox(0,0){{\tt eqPair d3}}} +\put(30,32){\makebox(0,0){{\tt defNeq d3}}} +\put(20,9){\makebox(0,0)[bl]{{\tt d1::Eq Int}}} +\put(60,21){\makebox(0,0)[bl]{{\tt d2::Eq [Int]}}} +\put(0,37){\makebox(0,0)[bl]{{\tt d3::Eq (Int,[Int])}}} +\end{picture} +\EQ +% d3 :: Eq (Int, [Int]) +% +------------+------------+------------+------------+ +% | | | | | +% | eqPair d3 | defNeq d3 | d1::Eq Int |d2::Eq [Int]| +% | | | | | +% +------------+------------+-----+------+-----+------+ +% | | +% +--------------+ | +% | | +% | d2 :: Eq [Int] V +% | +------------+------------+------------+ +% | | | | | +% | | eqList d2 | defNeq d2 | d1::Eq Int | +% | | | | | +% | +------------+------------+-----+------+ +% | | +% d1 :: Eq Int V | +% +------------+------------+ | +% | | | | +% | primEqInt | defNeq d1 |<--------------------------+ +% | | | +% +------------+------------+ +% +Once again, it may be useful to see how these definitions are used to +evaluate the expression \verb"(2,[1]) == (2,[1,3])" which, after +translation, becomes \verb"(==) d3 (2,[1]) (2,[1,3])": +\begin{verbatim} + (==) d3 (2,[1]) (2,[1,3]) + ==> (#1 d3) (2,[1]) (2,[1,3]) + ==> eqPair d3 (2,[1]) (2,[1,3]) + ==> (==) (#3 d3) 2 2 && (==) (#4 d3) [1] [1,3] + ==> (==) d1 2 2 && (==) (#4 d3) [1] [1,3] + ==> (#1 d1) 2 2 && (==) (#4 d3) [1] [1,3] + ==> primEqInt 2 2 && (==) (#4 d3) [1] [1,3] + ==> True && (==) (#4 d3) [1] [1,3] + ==> (==) (#4 d3) [1] [1,3] + ==> (==) d2 [1] [1,3] + ==> (#1 d2) [1] [1,3] + ==> eqList d2 [1] [1,3] + ==> (==) (#3 d2) 1 1 && (==) d2 [] [3] + ==> (==) d1 1 1 && (==) d2 [] [3] + ==> (#1 d1) 1 1 && (==) d2 [] [3] + ==> primEqInt 1 1 && (==) d2 [] [3] + ==> True && (==) d2 [] [3] + ==> (==) d2 [] [3] + ==> False +\end{verbatim} + +\subsection{Superclasses} +In general, a type class declaration has the form: +\BQ + \verb"class" \I{context} \verb"=>" + \I{Class} $a_1$ \dots $a_n$ \verb"where" \\ + {\em type declarations for member functions} \\ + {\em default definitions of member functions} +\EQ +where \I{Class} is the name of the new type class which takes $n$ arguments, +represented by distinct type variables $a_1$, \dots, $a_n$. As in the case of +instance declarations, the context that appears on the left hand side +of the `\verb"=>"' symbol specifies a list of predicates that must be +satisfied in order to construct any instance of \I{Class}. + +The predicates in the \I{context} part of a class declaration are called +the superclasses of \I{Class}. This terminology is taken from Haskell +where all classes have a single parameter and each of the predicates in +the context part of a class declaration has the form $C\; a_1$; in this +situation, any instance of \I{Class} must also be an instance of each class +$C$ named in the context. +In other words, each such $C$ contains a +superset of the types in \I{Class}. + +As an example of a class declaration with a non-empty context, consider +the following declaration from the standard prelude which introduces a +class Ord whose instances are types with both strict \verb"(<)", +\verb"(>)" and +non-strict \verb"(<=)", \verb"(>=)" +versions of an ordering defined on their +elements: +\begin{verbatim} + class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y +\end{verbatim} +Notice that this definition provides default definitions for all of the +member functions except \verb"(<=)", so that in general only this single +function needs to be defined to construct an instance of class \verb"Ord". + +There are two reasons for defining \verb"Eq" as a superclass of \verb"Ord": +\BI +\IT The default definition for \verb"(<)" relies on the use of + \verb"(/=)" taken + from class \verb"Eq". In order to guarantee that this is always valid we + must ensure that every instance of \verb"Ord" must also be an instance of + \verb"Eq". + +\IT Given the definition of a non-strict ordering \verb"(<=)" on the elements + of a type, it is always possible to construct a definition for the + \verb"(==)" operator (and hence for \verb"(/=)") using the equation: +\begin{verbatim} + x==y = x<=y && y<=x +\end{verbatim} + There will therefore be no loss in generality by requiring \verb"Eq" to + be a superclass of \verb"Ord", and conversely, no difficulty in defining + an instance of \verb"Eq" to accompany any instance of \verb"Ord" + for which an + instance of \verb"Eq" has not already be provided. + + As an example, the following definitions provide an alternative + way to implement the equality operation on elements of the \verb"Set" + datatype described in section 14.2.3, in terms of the subset + ordering defined in class \verb"Ord": +\begin{verbatim} + instance Ord (Set a) => Eq (Set a) where + x == y = x <= y && y <= x + + instance Eq a => Ord (Set a) where + Set xs <= Set ys = all (`elem` ys) xs +\end{verbatim} + This definition is in fact no less efficient or effective than the + original version. +\EI +Dictionaries for superclasses are dealt with in much the same way as +the instance specific dictionaries described above. For example, the +general layout of a dictionary for an instance of \verb"Ord" is illustrated in +the following diagram: +\BQ +\begin{tabular}{|c|c|c|c|c|c|c|c} +\hline + \verb"(<)" & \verb"(<=)" & \verb"(>)" & \verb"(>=)" & + \verb"max" & \verb"min" & \verb"Eq a" & \dots \\ +\hline +\end{tabular} +\EQ +% +--------+--------+--------+--------+--------+--------+--------+----- +% | | | | | | | | +% | (<) | (<=) | (>) | (>=) | max | min | Eq a | ..... +% | | | | | | | | +% +--------+--------+--------+--------+--------+--------+--------+----- +% +Note the use of the seventh element of this dictionary which points to +the dictionary for the appropriate instance of \verb"Eq". This is used in the +translation of the default definition for \verb"(<)" which is equivalent to: +\begin{verbatim} + defLessThan d x y = (<=) d x y && (/=) (#7 d) x y +\end{verbatim} + +\subsection{Combining classes} +In general, a dictionary is made up of three separate parts: +\BQ +\begin{tabular}{|c|c|c|} +\hline +Implementation & Superclass & Instance specific \\ +of class members & dictionaries & dictionaries \\ +\hline +\end{tabular} +\EQ +% +-------------------+-------------------+-------------------+ +% | Implementation | Superclass | Instance specific | +% | of class members | Dictionaries | Dictionaries | +% | | | | +% +-------------------+-------------------+-------------------+ +% +Each of these may be empty. We have already seen examples in which +there are no superclass dictionaries (e.g.\ instances of \verb"Eq") and in +which there are no instance specific dictionaries (e.g.\ \verb"Eq Int"). +Classes with no member functions (corresponding to dictionaries with no +member functions) are sometimes useful as a convenient abbreviation for +a list of predicates. For example: +\begin{verbatim} + class C a where cee :: a -> a + class D a where dee :: a -> a + + class (C a, D a) => CandD a +\end{verbatim} +makes \verb"CandD" a an abbreviation for the context \verb"(C a, D a)". +Thinking of +single parameter type classes as sets of types, the type class \verb"CandD" +corresponds to the intersection of classes \verb"C" and \verb"D". + +Just as the type inferred for a particular function definition or +expression does not involve type synonyms unless explicit type signatures +are used, the Gofer type system will not use a single predicate of the +form \verb"CandD" a instead of the two predicates \verb"C a" +and \verb"D a" unless explicit +signatures are used: +\begin{verbatim} + ? :t dee . cee + \d129 d130 -> dee d130 . cee d129 :: (C a, D a) => a -> a + ? :t dee . cee :: CandD a => a -> a + \d129 -> dee (#2 d129) . cee (#1 d129) :: CandD a => a -> a + ? +\end{verbatim} +In Haskell, all instances of a class such as \verb"CandD" must have +explicit declarations, in addition to the corresponding declarations +for instances for \verb"C" and \verb"D". +This problem can be avoided by using the +more general form of instance declaration permitted in Gofer; a single +instance declaration: +\begin{verbatim} + instance CandD a +\end{verbatim} +is all that is required to ensure that any instance of \verb"CandD" can be +obtained, so long as corresponding instances for \verb"C" and \verb"D" +can be found. + + +\subsection{Simplified contexts} +Consider the function defined by the following equation: +\begin{verbatim} + eg1 x = [x] == [x] || x == x +\end{verbatim} +This definition does not restrict the type of \verb"x" in any way except that, +if \verb"x::a", then there must be instances \verb"Eq [a]" +and \verb"Eq a" which are used +for the two occurrences of the \verb"(==)" operator in the equation. We might +therefore expect the type of \verb"eg1" to be: +\begin{verbatim} + (Eq [a], Eq a) => a -> Bool +\end{verbatim} +with translation: +\begin{verbatim} + eg1 d1 d2 x = (==) d1 [x] [x] || (==) d2 x x +\end{verbatim} +However, as can be seen from the case where \verb"a=Int" illustrated in +section 14.3, given \verb"d1::Eq [a]" +we can always find a dictionary for \verb"Eq a" +by taking the third element of \verb"d1" i.e.\ +\verb"(#3 d1)::Eq a". Since it is more +efficient to select an element from a dictionary than to complicate +both type and translation with extra parameters, the type assigned to +\verb"eg1" by default is: +\begin{verbatim} + Eq [a] => a -> Bool +\end{verbatim} +with translation: +\begin{verbatim} + eg1 d1 x = (==) d1 [x] [x] || (==) (#3 d1) x x +\end{verbatim} +In general, given a set of predicates corresponding to the instances +required by an expression, Gofer will always attempt to find the +smallest possible subset of these predicates such that all of the +required dictionaries can still be obtained, whilst minimising the +number of dictionary parameters that are used. + +The original type and translation for eg1 given above can be produced +by including an explicit type signature in the file containing the +definition of \verb"eg1": +\begin{verbatim} + eg1 :: (Eq [a], Eq a) => a -> Bool + eg1 x = [x] == [x] || x == x +\end{verbatim} +But even with this definition, Gofer will still always try to minimise +the number of dictionaries used in any particular expression: +\begin{verbatim} + ? :t eg1 + \d153 -> eg1 d153 (#3 d153) :: Eq [a] => a -> Bool + ? +\end{verbatim} +As another example, consider the expression \verb"(\x y-> x==x || y==y)". +The type and translation assigned to this term can be found directly +using Gofer: +\begin{verbatim} + ? :t (\x y-> x==x || y==y) + \d121 d122 x y -> (==) d122 x x || + (==) d121 y y + :: (Eq b, Eq a) => a -> b -> Bool + ? +\end{verbatim} +Note that the translation has two dictionary parameters \verb"d121" +and \verb"d122" +corresponding to the two predicates \verb"Eq a" +and \verb"Eq b" respectively. Since +both of these dictionaries can be obtained from a dictionary for the +predicate \verb"Eq (a,b)", we can use an explicit type signature to produce a +translation which needs only one dictionary parameter: +\begin{verbatim} + ? :t (\x y-> x==x || y==y) :: Eq (a,b) => a -> b -> Bool + \d121 x y -> (==) (#3 d121) x x || + (==) (#4 d121) y y + :: Eq (a,b) => a -> b -> Bool + ? +\end{verbatim} + +\section{Other issues} + +\subsection{Unresolved overloading} +Consider the use of the \verb"(==)" operator in the following three +situations: +\BI +\IT In the expression \verb"2==3", it is clear that the appropriate value + for the equality operator in this case is \verb"primIntEq" as defined by + the instance declaration for \verb"Eq Int". The expression can therefore + be translated to \verb"primEqInt 2 3". + +\IT In the function definition \verb"f x = x==x", we cannot completely + determine the appropriate value for \verb"(==)" because it depends on the + type assigned to the variable \verb"x", which may itself vary with + different uses of the function \verb"f". It is however possible to add + an extra parameter to the definition, giving \verb"f d x = (==) d x x" + and taking the type of \verb"f" to be \verb"Eq a => a -> Bool". + + In this way, the problem of finding the appropriate definition for + the \verb"(==)" operator is deferred until the function is actually used. + +\IT In the expression \verb"[]==[]", + the appropriate value for \verb"(==)" must be + obtained from the dictionary for some instance of the form \verb"Eq [a]", + but there is not sufficient information in the expression to + determine what the value of the type variable a should be. + + Looking back to the instance declaration for \verb"Eq [a]", we find that + the definition of \verb"(==)" depends on the value of the dictionary for + the instance \verb"Eq a". In this particular case, it is clear that the + expression will always evaluate to \verb"True", regardless of the value + of this dictionary. Unfortunately, the only way that this can be + detected is by evaluating the expression to see if the calculation + can be completed without reference to the dictionary value (see + the comments in the aside at the end of this section). + + Attempting to evaluate this expression in Gofer will therefore + result in an error message indicating that the expression does not + contain sufficient information to resolve the use of overloading + in the expression: +\begin{verbatim} + ? [] == [] + ERROR: Unresolved overloading + *** type : Eq [a] => Bool + *** translation : \d129 -> (==) d129 [] [] + ? +\end{verbatim} + Note that the expression has been converted into a lambda + expression using the dictionary variable \verb"d129" to represent the + dictionary for the unknown instance \verb"Eq [a]". + + One simple way to resolve the overloading in an expression of this + kind is to use an explicit type signature. For example, if we + specify that the second empty list is an empty list of type \verb"[Int]": +\begin{verbatim} + ? [] == ([]::[Int]) + True + (2 reductions, 9 cells) + ? +\end{verbatim} +\EI +The same problem occurs in Haskell, where it is described using the +idea of an `ambiguous type' -- i.e.\ a type expression of the form +\verb"context => type" where one or more of the type variables appearing in +the given context do not appear in the remaining part of the type +expression. + +Further examples of unresolved overloading occur with other classes. +As an example consider the class \verb"Reader" defined by: +\begin{verbatim} + class Reader a where + parse :: String -> a + unparse :: a -> String +\end{verbatim} +whose member functions provide methods for obtaining the string +representation of an element of an instance type, and for converting +such representations back into the original values. (The standard +Haskell \verb"Text" class contains similar functions.) Now consider the +expression \verb"parse . unparse" which maps values from some instance of +Reader to values of another instance via an intermediate string +representation. +\begin{verbatim} + ? parse . unparse + ERROR: Unresolved overloading + *** type : (Reader a, Reader b) => a -> b + *** translation : \d129 d130 -> parse d130 . unparse d129 + ? +\end{verbatim} +One of the first things that might surprise the reader here is that the +value produced by \verb"parse.unparse" does not have to be of the same +type as the argument; for example, we would not usually expect to have +any sensible interpretation for a floating point number obtained from +the string representation of a boolean value! + +This can be fixed by using an explicit type declaration, although the +expression still produces unresolved overloading: +\begin{verbatim} + ? (parse . unparse) :: Reader a => a -> a + ERROR: Unresolved overloading + *** type : Reader a => a -> a + *** translation : \d130 -> parse d130 . unparse d130 + ? +\end{verbatim} +Notice however that the type of this expression is not ambiguous so +that the unresolved overloading in this example can be eliminated when +the function is actually used: +\begin{verbatim} + ? ((parse . unparse) :: Reader a => a -> a) 'a' + 'a' + (4 reductions, 11 cells) + ? +\end{verbatim} +A more serious problem occurs with the expression \verb"unparse . parse" +which maps string values to string values via some intermediate type. +Clearly this will lead to a problem with unresolved overloading: +\begin{verbatim} + ? unparse . parse + ERROR: Unresolved overloading + *** type : Reader a => String -> String + *** translation : \d130 -> unparse d130 . parse (#0 d130) + ? +\end{verbatim} +Notice that the type obtained in this case is ambiguous; the type +variable \verb"a" which appears in the predicate +\verb"Reader" a does not appear in +the type \verb"String -> String". There are a number of ways of resolving +this kind of ambiguity: +\BI +\IT Using an explicitly typed expression: Assuming for example that + \verb"Char" is an instance of \verb"Reader", we can write: +\begin{verbatim} + ? unparse . (parse :: String -> Char) + v113 {dict} . v112 {dict} + (5 reductions, 42 cells) + ? +\end{verbatim} + without any ambiguity. If such type signatures are used in a + number of places, it might be better to define an auxiliary + function and use that instead: +\begin{verbatim} + charParse :: String -> Char + charParse = parse + + ? unparse . charParse + v113 {dict} . charParse + (4 reductions, 37 cells) + ? +\end{verbatim} + In such situations, it is perhaps worth asking if overloaded + functions are in fact the most appropriate solution for the + problem at hand! + +\IT Using an extra dummy parameter in a function definition. In a + definition such as: +\begin{verbatim} + f = unparse . parse +\end{verbatim} + we can introduce an additional dummy parameter \verb"x" which is not + used except to determine the type of the result produced by parse + in \verb"f": +\begin{verbatim} + f x = unparse . (parse `asTypeOf` (\""->x)) +\end{verbatim} + where the standard prelude operator \verb"asTypeOf" defined by: +\begin{verbatim} + asTypeOf :: a -> a -> a + x `asTypeOf` _ = x +\end{verbatim} + is used to ensure that the type of parse in the definition of \verb"f" is + the same as that of the function \verb'(\""->x)' -- in other words, the + type must be \verb"String -> a" where + \verb"a" is the type of the variable \verb"x". + + The resulting type for \verb"f" is: +\begin{verbatim} + f :: Reader a => a -> String -> String +\end{verbatim} + Notice how the addition of the dummy parameter has been used to + eliminate the ambiguity present in the original type. + + This kind of `coding trick' is rather messy and is not recommended + for anything but the simplest examples. +\EI +The idea of evaluating an expression with an ambiguous type to +see if it does actually need the unspecified dictionaries could have +been implemented quite easily in Gofer using an otherwise unused +datatype \verb"Unresolved" and generating instance declarations such as: +\begin{verbatim} + instance Eq Unresolved where + (==) = error "unresolved overloading for (==)" + (/=) = error "unresolved overloading for (/=)" +\end{verbatim} +for each class. Given a particular expression, we can then use the +type \verb"Unresolved" +in place of any ambiguous type variables in its type. The +evaluation of the expression could then be attempted, either completing +successfully if the dictionaries are not required, but otherwise +resulting in a run-time error. + +This approach is not used in Gofer; instead, the programmer is notified +of any unresolved polymorphism when the program is type checked, +avoiding the possibility that a program might contain an undetected +ambiguity. + + +\subsection{`Recursive' dictionaries} +Unlike Haskell, there are no restrictions on the form of the predicates +that may appear in the context part of a Gofer class or instance +declaration. This has a number of potentially useful applications +because it enables the Gofer programs to use mutually `recursive' +systems of dictionaries. + +One example of this is the ability to implement a large family of +related functions using a group of classes instead of having to use a +single class. The following example illustrates the technique with an +alternative definition for the class \verb"Eq" +in which the \verb"(==)" and \verb"(/=)" +operators are placed in different classes: +\begin{verbatim} + class Neq a => Eq a where (==) :: a -> a -> Bool + + class Eq a => Neq a where (/=) :: a -> a -> Bool + x/=y = not (x == y) +\end{verbatim} +(These declarations clash with those in the standard prelude and +hence cannot actually be used in Gofer unless a modified version of the +standard prelude is used instead.) + +If we then give instance declarations: +\begin{verbatim} + instance Eq Int where (==) = primEqInt + instance Neq Int +\end{verbatim} +and try to evaluate the expression \verb"2==3" then the following system of +dictionaries will be generated: +\BQ +\setlength{\unitlength}{1mm} +\begin{picture}(130,18) +\put(20,4){\line(1,0){40}} +\put(20,12){\line(1,0){40}} +\put(80,4){\line(1,0){40}} +\put(80,12){\line(1,0){40}} +\put(20,4){\line(0,1){8}} +\put(40,4){\line(0,1){8}} +\put(60,4){\line(0,1){8}} +\put(80,4){\line(0,1){8}} +\put(100,4){\line(0,1){8}} +\put(120,4){\line(0,1){8}} + +\put(10,8){\vector(1,0){10}} +\put(50,8){\vector(1,0){30}} +\put(110,8){\line(1,0){20}} +\put(130,8){\line(0,-1){8}} +\put(130,0){\line(-1,0){120}} +\put(10,0){\line(0,1){8}} +\put(50,8){\circle*{1.5}} +\put(110,8){\circle*{1.5}} + +\put(30,8){\makebox(0,0){{\tt primEqInt}}} +\put(90,8){\makebox(0,0){{\tt defNeq d2}}} +\put(20,13){\makebox(0,0)[bl]{{\tt d1: Eq Int}}} +\put(80,13){\makebox(0,0)[bl]{{\tt d2: Neq Int}}} +\end{picture} +\EQ +% +% d1 :: Eq Int d2 :: Neq Int +% +-----------+-----------+ +-----------+-----------+ +% | | | | | | +% +-->| primEqInt |d2::Neq Int+----->| defNeq d2 |d1::Eq Int +---+ +% | | | | | | | | +% | +-----------+-----------+ +-----------+-----------+ | +% | | +% +------------------------------<-------------------------------+ +% +where the function \verb"defNeq" is derived from the default definition in the +class \verb"Neq" and is equivalent to: +\begin{verbatim} + defNeq d x y = not ((==) (#2 d) x y) +\end{verbatim} +Incidentally, if the instance declaration for \verb"Neq Int" above had been +replaced by: +\begin{verbatim} + instance Neq a +\end{verbatim} +then the effect of these declarations would be similar to the standard +definition of the class \verb"Eq", except that it would not be possible to +override the default definition for \verb"(/=)". In other words, this +approach would give the same effect as defining \verb"(/=)" as a top-level +function rather than a member function in the class \verb"Eq": +\begin{verbatim} + class Eq a where (==) :: a -> a -> Bool + + (/=) :: Eq a => a -> a -> Bool + x /= y = not (x == y) +\end{verbatim} +There are other situations in which recursive dictionaries of the kind +described above can be used. A further example is given in the +following section. Unfortunately, the lack of restrictions on the form +of class and instance declarations can also lead to problems in some +(mostly pathological) cases. As an example, consider the class: +\begin{verbatim} + class Bad [a] => Bad a where bad :: a -> a +\end{verbatim} +Without defining any instances of \verb"Bad", it is not possible to construct +any dictionaries for instances of \verb"Bad": +\begin{verbatim} + ? bad 2 + ERROR: Cannot derive instance in expression + *** Expression : bad d126 2 + *** Required instance : Bad Int + ? +\end{verbatim} +If however we add the instance declarations: +\begin{verbatim} + instance Bad Int where bad = id + instance Bad [a] where bad = id +\end{verbatim} +then any attempt to construct a dictionary for \verb"Bad Int" will also +require a dictionary for the superclass \verb"Bad [Int]" and then for the +superclass of that instance \verb"Bad [[Int]]" etc. Since Gofer has only a +finite amount of space for storing dictionaries, this process will +eventually terminate when that space has been used up: +\begin{verbatim} + ? bad 2 + ERROR: Dictionary storage space exhausted + ? +\end{verbatim} +(Depending on the configuration of your particular version of +Gofer and on the nature of the class and instance declarations that are +involved, an alternative error message {\tt ERROR: Too many type variables +in type checker} may be produced instead of the message shown above.) + +From a practical point of view, this problem is unlikely to cause too +many real difficulties: +\BI +\IT Class declarations involving predicates such as those in the + declaration of \verb"Bad" are unlikely to be used in realistic programs. + +\IT All dictionaries are constructed before evaluation begins. This + process is guaranteed to terminate because each new dictionary + that is created uses up part of the space used to hold Gofer + dictionaries. The construction process will either terminate + successfully once complete, or be aborted as soon as all of the + dictionary space has been used. +\EI +It remains to see what impact (if any) this has on realistic programs, +and if later versions of Gofer should be modified to impose some +syntactic restrictions (as in Haskell) or perhaps some form of static +checking of the contexts appearing in class and instance declarations. + + +\subsection{Classes with multiple parameters} +Gofer is the first language to support the use of type classes with +multiple parameters. This again is an experimental feature of the +language, intended to make it possible to explore the claims from a +number of researchers about the use of such classes. + +Initial experiments suggest that multiple parameter type classes are +likely to lead to large numbers of problems with unresolved +overloading. Ultimately, this may mean that such classes are only of +practical use in explicitly typed languages, or alternatively that a +more powerful and general defaulting mechanism (similar to that used in +Haskell with numeric classes) is required to support user controlled +overloading resolution. + +The following declaration introduces a class \verb"Iso" whose elements are +pairs of isomorphic types: +\begin{verbatim} + class Iso b a => Iso a b where iso :: a -> b +\end{verbatim} +The single member function \verb"iso" represents the isomorphism mapping +elements of type \verb"a" +to corresponding elements of type \verb"b". Note the +`superclass' context in this declaration which formalises the idea that +if \verb"a" is isomorphic to \verb"b" +then \verb"b" is also isomorphic to \verb"a". The class \verb"Iso" +therefore provides further examples of the recursive dictionaries +described in the previous section. + +The fact that any type is isomorphic to itself can be described by the +following instance declaration: +\begin{verbatim} + instance Iso a a where iso x = x +\end{verbatim} +For example, the dictionary structure created in order to evaluate the +expression \verb"iso 2 == 3" is: +\BQ +\setlength{\unitlength}{1mm} +\begin{picture}(70,18) +\put(20,4){\line(1,0){40}} +\put(20,12){\line(1,0){40}} +\put(20,4){\line(0,1){8}} +\put(40,4){\line(0,1){8}} +\put(60,4){\line(0,1){8}} + +\put(10,8){\vector(1,0){10}} +\put(50,8){\line(1,0){20}} +\put(70,8){\line(0,-1){8}} +\put(70,0){\line(-1,0){60}} +\put(10,0){\line(0,1){8}} +\put(50,8){\circle*{1.5}} + +\put(30,8){\makebox(0,0){{\tt id}}} +\put(20,13){\makebox(0,0)[bl]{{\tt d:: Iso Int Int}}} +\end{picture} +\EQ +% +% d :: Iso Int Int +% +--------------+--------------+ +% | | | +% +-->| id |d::Iso Int Int+--+ +% | | | | | +% | +--------------+--------------+ | +% | | +% +------------------<-----------------+ +% +\begin{verbatim} + ? iso 2 == 3 + False + (4 reductions, 11 cells) + ? +\end{verbatim} +Our first taste of the problems to come occurs when we try to evaluate +the expression \verb"iso 2 == iso 3": +\begin{verbatim} + ? iso 2 == iso 3 + ERROR: Unresolved overloading + *** type : (Eq a, Iso Int a) => Bool + *** translation : \d130 d132 -> (==) d130 (iso d132 2) (iso d132 3) + ? +\end{verbatim} +In this case, the \verb"iso" function is used to map the integers 2 and 3 to +elements of some type \verb"a", +isomorphic to \verb"Int", and the values produced are +the compared using \verb"(==)" at the instance \verb"Eq a"; +there is no way of +discovering what the value of a should be without using an explicit +type signature. + +Further instances can be defined. The following two declarations are +needed to describe the (approximate) isomorphism between lists of pairs +and pairs of lists: +\begin{verbatim} + instance Iso [(a,b)] ([a],[b]) where + iso xs = (map fst xs, map snd xs) + + instance Iso ([a],[b]) [(a,b)] where + iso (xs,ys) = zip xs ys +\end{verbatim} +Unfortunately, even apparently straightforward examples give problems +with unresolved overloading, forcing the use of explicit type +declarations: +\begin{verbatim} + ? iso [(1,2),(3,4)] + ERROR: Unresolved overloading + *** type : Iso [(Int,Int)] a => a + *** translation : \d126 -> iso d126 [(1,2),(3,4)] + + ? (iso [(1,2),(3,4)]) :: ([Int],[Int]) + ([1, 3],[2, 4]) + (22 reductions, 64 cells) + ? +\end{verbatim} +A second example of a multiple parameter type class is defined as +follows: +\begin{verbatim} + class Ord a => Collects a b where + emptyCollection :: b + addToCollection :: a -> b -> b + listCollection :: b -> [a] +\end{verbatim} +The basic intuition is that the predicate \verb"Collects a b" indicates that +elements of type \verb"b" can be used to represent collections of elements of +type \verb"a". A number of people have suggested using type classes in this +way to provide features similar to the (similarly named, but otherwise +different) classes that occur in object-oriented languages. + +Obvious implementations involve the use of ordered lists or binary +search trees defined by instances of the form: +\begin{verbatim} + data STree a = Empty | Node a (STree a) (STree a) + + instance Collects a [a] where .... + instance Collects a (STree a) where .... +\end{verbatim} +Once again, there are significant problems even with simple examples +using these functions. As an example, the standard way of defining a +function of type: +\begin{verbatim} + Collects a b => [a] -> b +\end{verbatim} +mapping a list of values to a collection of those values using the +higher order function \verb"foldr": +\begin{verbatim} + listToCollection = foldr addToCollection emptyCollection +\end{verbatim} +actually produces a function with ambiguous type: +\begin{verbatim} + ? :t foldr addToCollection emptyCollection + \d139 d140 -> foldr (addToCollection d140) (emptyCollection d139) + :: (Collects c b, Collects a b) => [a] -> b + ? +\end{verbatim} +which cannot be resolved, even with an explicit type declaration. + +\subsection{Overloading and numeric values} +One of the most common uses of overloading is to allow the use of the +standard arithmetic operators such as \verb"(+)", \verb"(*)" +etc.\ on the elements of +a range of numeric types including integers and floating point values in +addition to user defined numeric types such as arbitrary precision +integers, complex and rational numbers, vectors and matrices, +polynomials etc. In Haskell, these features are supported by a number +of built-in types and a complex hierarchy of type classes describing +the operations defined on the elements of each numeric type. + +As an experimental language, intended primarily for the investigation +of general purpose overloading, Gofer has only two built-in numeric +types; \verb"Int" and \verb"Float" +(the second of which is not supported in all +implementations). Similarly, although the Gofer system could be used +to implement the fully hierarchy of Haskell numeric classes, the +standard prelude uses a single numeric type class Num defined by: +\begin{verbatim} + class Eq a => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a +\end{verbatim} +The first four member functions \verb"(+)", \verb"(-)", +\verb"(*)", \verb"(/)" are the standard +arithmetic functions on instances of \verb"Num", whilst +\verb"negate" denotes unary +negation. The final member function, fromInteger is used to coerce any +integer value to the corresponding value in another instance of \verb"Num". +An expression such as \verb"fromInteger 3" is called an overloaded numeric +constant and has type \verb"Num a => a" indicating that it can be used as a +value of any instance of \verb"Num". See below for examples. + +Both \verb"Float" and \verb"Int" are defined as +instances of \verb"Num" using primitive +functions for integer and floating point arithmetic: +\begin{verbatim} + instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + + instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat +\end{verbatim} +These definitions make it possible to evaluate numeric expressions +involving both types: +\begin{verbatim} + ? 2 + 3 + 5 + (3 reductions, 6 cells) + ? 3.2 + 4.321 + 7.521 + (3 reductions, 13 cells) + ? +\end{verbatim} +Note however that any attempt to evaluate an expression mixing +different arithmetic types is likely to cause a type error: +\begin{verbatim} + ? 4.2 * 4 + ERROR: Type error in application + *** expression : 4.2 * 4 + *** term : 4.2 + *** type : Float + *** does not match : Int + ? +\end{verbatim} +Further problems occur when we try to define functions intended to be +used with arbitrary instances of \verb"Num" rather than specific numeric +types. As an example of this, the standard prelude function \verb"sum", +roughly equivalent to: +\begin{verbatim} + sum [] = 0 + sum (x:xs) = x + sum xs +\end{verbatim} +has type \verb"[Int] -> Int", +rather than the more general \verb"Num a => [a] -> a" +which could be used to find the sum of a list of numeric values in any +instance of \verb"Num". The problem in this particular case is caused by the +integer constant 0 in the first line of the definition. Replacing this +with the expression fromInteger 0 leads to the following definition for +a generic sum function of the required type: +\begin{verbatim} + genericSum :: Num a => [a] -> a + genericSum [] = fromInteger 0 + genericSum (x:xs) = x + genericSum xs +\end{verbatim} +For example: +\begin{verbatim} + ? genericSum [1,2,3] + 6 + (10 reductions, 18 cells) + ? genericSum [1.0,2.0,3.0] + 6.0 + (11 reductions, 27 cells) + ? +\end{verbatim} +The \verb"fromInteger" function can also be used to solve the previous +problem: +\begin{verbatim} + ? 4.2 * fromInteger 4 + 16.8 + (3 reductions, 13 cells) + ? +\end{verbatim} +In Haskell, any integer constant \verb"k" appearing in an expression is +treated as if the programmer had actually written \verb"fromInteger k" so +that both of the preceding problems are automatically resolved. +Unfortunately, this also creates some new problems; applying the +function fromInteger to each integer constant in the previous examples +causes problems with unresolved overloading: +\begin{verbatim} + ? fromInteger 2 + fromInteger 3 + ERROR: Unresolved overloading + *** type : Num a => a + *** translation : \d143 -> (+) d143 (fromInteger d143 2) + (fromInteger d143 3) + ? +\end{verbatim} +Once again, Haskell provides a solution to this problem in the form of +a `default mechanism' for numeric types which, once the following +problem has been detected, will typically `default' the unknown type +represented by the type variable a above to be Int, so that the result +is actually equivalent to the following: +\begin{verbatim} + ? (fromInteger 2 + fromInteger 3) :: Int + 5 + (4 reductions, 8 cells) + ? +\end{verbatim} +There are a number of problems with the Haskell default mechanism; both +theoretical and practical. In addition, if a default mechanism of some +form is used then it should also be capable of dealing with arbitrary +user-defined type classes, rather than a small group of `standard' +classes, in order to provide solutions to the unresolved overloading +problems described in previous sections. Therefore, for the time +being, Gofer does not support any form of default mechanism and +overloaded numeric constants can only be obtained by explicit use of +the fromInteger function. + + +\subsection{Constants in dictionaries} +The Gofer system constructs new dictionaries as necessary, and deletes +them when they are no longer required. At any one time, there is at +most one dictionary for each instance of a class. Coupled with lazy +evaluation, this has a number of advantages for classes in which member +functions are defined by variable declarations as in section 9.10. As +an example, consider the class Finite defined by: +\begin{verbatim} + class Finite a where members :: [a] +\end{verbatim} +The only member in this class is a list enumerating the elements of the +type. For example: +\begin{verbatim} + instance Finite Bool where members = [False, True] + + instance (Finite a, Finite b) => Finite (a,b) where + members = [ (x,y) | x<-members, y<-members ] +\end{verbatim} +In order to overcome any problems with unresolved overloading, explicit +type signatures are often needed to resolve overloading: +\begin{verbatim} + ? members :: [Bool] + [False, True] + (6 reductions, 26 cells) + ? length (members :: [((Bool,Bool),(Bool,Bool))]) + 16 + (103 reductions, 195 cells) + ? +\end{verbatim} +In some cases, the required overloading is implicit from the context +and no additional type information is required, as in the following +example: +\begin{verbatim} + ? [ x && y | (x,y) <- members ] + [False, False, False, True] + (29 reductions, 90 cells) + ? +\end{verbatim} +We can also use the technique of passing a `dummy' parameter to resolve +overloading problems in a function definition: +\begin{verbatim} + size :: Finite a => a -> Int + size x = length (members `asTypeOf` [x]) +\end{verbatim} +which calculates the number of elements of a finite type, given an +arbitrary element of that type: +\begin{verbatim} + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? +\end{verbatim} +Now consider the expression \verb"size (True,False) + size (True,False)". +At first glance, we expect this to repeat the calculation in the +previous example two times, requiring approximately twice as many +reductions and cells as before. However, before this expression is +evaluated, Gofer constructs a dictionary for \verb"Finite (Bool,Bool)". The +evaluation of the first summand forces Gofer to evaluate the value for +"members" in this dictionary. Since precisely the same dictionary is +used to calculate the value of the second summand, the evaluation of +"members" is not repeated and the complete calculation actually uses +rather fewer reductions and cells: +\begin{verbatim} + ? size (True,False) + size (True,False) + 8 + (51 reductions, 90 cells) + ? +\end{verbatim} +On the other hand, repeating the original calculation gives exactly the +same number of reductions and cells as before, because the dictionaries +constructed at the beginning of each calculation are not retained for +use in subsequent calculations. + +We can force Gofer to construct specific dictionaries whilst reading +from a file of definitions, so that they are not deleted at the end of +each calculation, using an explicitly typed variable definition such +as: +\begin{verbatim} + boolBoolMembers = members :: [(Bool,Bool)] +\end{verbatim} +This forces Gofer to construct the dictionary \verb"Finite (Bool,Bool)" when +the file of definitions is loaded and prevents it from being deleted at +the end of each calculation. Having loaded a file containing this +definition, the first two attempts to evaluate \verb"size (True,False)" +give: +\begin{verbatim} + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? size (True,False) + 4 + (20 reductions, 32 cells) + ? +\end{verbatim} + +\subsection{The monomorphism restriction} +This section describes a technique used to limit the amount of +overloading used in the definition of certain values to avoid a number +of technical problems. This particular topic has attracted quite a lot +of attention within the Haskell community where it is affectionately +known as the `dreaded monomorphism restriction'. Although the initial +formulation of the rule was rather cumbersome and limiting, the current +version used in both Gofer and Haskell is unlikely to cause any +problems in practice. In addition, many of the examples used to +motivate the need for the monomorphism restriction in Haskell occur as +a result of the use of implicitly overloaded numeric constants, +described in section 14.4.4, and hence do not occur in Gofer. + +The monomorphism restriction takes its name from the way in which it +limits the amount of polymorphism that can be used in particular kinds +of declaration. Although we touch on this point in the following +discussion, the description given here uses an equivalent, but less +abstract approach, based on observations about the implementation of +overloaded functions. + +\paragraph{Basic ideas:} +As we have seen, the implementation of overloading used by Gofer +depends on being able to add extra arguments to a function definition +to supply the required dictionary parameters. For example, given a +function definition such as: +\begin{verbatim} + isElement x [] = False + isElement x (y:ys) = x==y || isElement x ys +\end{verbatim} +we first add a dictionary parameter for the use of the overloaded \verb"(==)" +operator on the right hand side, obtaining: +\begin{verbatim} + isElement x [] = False + isElement x (y:ys) = (==) d x y || isElement x ys +\end{verbatim} +Finally, we have to add the variable \verb"d" as a new parameter for the +function \verb"isElement", on both the left and right hand sides of the +definition: +\begin{verbatim} + isElement d x [] = False + isElement d x (y:ys) = (==) d x y || isElement d x ys +\end{verbatim} +The monomorphism restriction imposes conditions which prevent this last +step from being used for certain kinds of value binding. + +\paragraph{Declaration groups:} +Before giving the full details, it is worth pointing out that, in +general, the monomorphism restriction affects groups of value +declarations rather than just individual definitions. To illustrate +this point, consider the function definitions: +\begin{verbatim} + f x y = x==y || g x y + g x y = not (f x y) +\end{verbatim} +Adding an appropriate dictionary parameter for the \verb"(==)" operator gives: +\begin{verbatim} + f x y = (==) d x y || g x y + g x y = not (f x y) +\end{verbatim} +The next stage is to make this dictionary variable into an extra +parameter to the function \verb"f" wherever it appears, giving: +\begin{verbatim} + f d x y = (==) d x y || g x y + g x y = not (f d x y) +\end{verbatim} +But now the right hand side of the second definition mentions the +dictionary variable \verb"d" which must therefore be added as an extra +parameter to \verb"g": +\begin{verbatim} + f d x y = (==) d x y || g d x y + g d x y = not (f d x y) +\end{verbatim} +In other words, if dictionary parameters are added to any particular +function definition, then each use of that function in another +definition will also be require extra dictionary parameters. As a +result, the monomorphism restriction has to be applied to the smallest +groups of declarations such that any pair of mutually recursive +bindings are in the same group. + +As the example above shows, if one (or more) of the bindings in a given +declaration group is affected by the monomorphism restriction so that +the appropriate dictionary parameters cannot be added as parameters for +that definition, then the same condition must also be imposed on all of +the other bindings in the group. (Adding the extra parameter to \verb"f" in +the example forces us to add an extra parameter for \verb"g"; if extra +parameters were not permitted for \verb"g" +then they could not be added to \verb"f".) + +\paragraph{Restricted bindings:} +There are three main reasons for avoiding adding dictionary parameters +to a particular value binding: +\BI +\IT Dictionary parameters unnecessary. If the dictionary values are + completely determined by context then it is not necessary to pass + the appropriate values as dictionary parameters. For example, the + function definition: +\begin{verbatim} + f x = x == 0 || x == 2 +\end{verbatim} + can be translated as: +\begin{verbatim} + f x = (==) {dict} x 0 || (==) {dict} x 2 +\end{verbatim} + where, in both cases, the symbol \verb"{dict}" denotes the dictionary for + \verb"Eq Int". As a further optimisation, once the dictionary is fully + determined, this can be simplified to: +\begin{verbatim} + f x = primEqInt x 0 || primEqInt x 2 +\end{verbatim} +\IT Dictionary parameters cannot be added in a pattern binding. One + potential solution to this problem would be to replace the pattern + binding by an equivalent set of function bindings. In practice, + we do not use this technique because it typically causes ambiguity + problems, as illustrated by the pattern binding: +\begin{verbatim} + (plus,times) = ((+), (*)) +\end{verbatim} + Translating this into a group of function bindings gives: +\begin{verbatim} + newVariable = ((+), (*)) + plus = fst newVariable -- fst (x,_) = x + times = snd newVariable -- snd (_,y) = y +\end{verbatim} + The type of \verb"newVariable" is + \verb"(Num a, Num b) => (a->a->a, b->b->b)" so + that the correct translation of these bindings using two + dictionary variables gives: +\begin{verbatim} + newVariable da db = ((+) da, (*) db) + plus da db = fst (newVariable da db) + times da db = snd (newVariable da db) +\end{verbatim} + and hence the correct types for \verb"plus" and \verb"times" are: +\begin{verbatim} + plus :: (Num a, Num b) => a -> a -> a + times :: (Num a, Num b) => b -> b -> b +\end{verbatim} + both of which are ambiguous. + +\IT Adding dictionary parameters may translate a variable definition + into a function definition, loosing the benefits of shared + evaluation. As an example, consider the following definition + using the function \verb"size" and the class + \verb"Finite" described in the + previous section: +\begin{verbatim} + twiceSize x = n + n where n = size x +\end{verbatim} + Since the variable n is defined using a local definition, we would + not expect to have to evaluate \verb"size x" more than once to determine + the value of twiceSize. However, adding extra dictionary + parameters without restriction gives: +\begin{verbatim} + twiceSize d x = n d + n d where n d = size d x +\end{verbatim} + Now that \verb"n" has been replaced by a function, the evaluation will be + repeated, once for each occurrence of the expression \verb"n d". In + order to avoid this kind of problem, the monomorphism restriction + does not usually allow extra parameters to be added to a variable + definition. Thus the original definition above will be translated + to give: +\begin{verbatim} + twiceSize d x = n + n where n = size d x +\end{verbatim} + Note that the same rule is applied to variable definitions at the + top-level of a file of definitions, resulting in an error if any + dictionary parameters are required for the right hand side of the + definition. As an example of this: +\begin{verbatim} + twiceMembers = members ++ members +\end{verbatim} + which produces an error message of the form: +\begin{verbatim} + ERROR "ex" (line 157): Unresolved top-level overloading + *** Binding : twiceMembers + *** Inferred type : [_7] + *** Outstanding context : Finite _7 + ? +\end{verbatim} + (A type expression of the form \verb"_n" (such as \verb"_7" in this + particular example) represents a fixed (i.e.\ monomorphic) type + variable.) + + In the case of a variable declaration, the monomorphism + restriction can be overcome by giving an explicit type signature + including an appropriate context, to indicate that the variable + defined is intended to be used as an overloaded value. In this + case, we need only include the declaration: +\begin{verbatim} + twiceMembers :: Finite a => [a] +\end{verbatim} + in the file containing the definition for \verb"twiceMembers" to suppress + the previous error message and allow the function to be used as a + fully overloaded variable. + + Note that the monomorphism restriction interferes with the use of + polymorphism. For example, the definition: +\begin{verbatim} + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers = members ++ members +\end{verbatim} + will not be accepted because the monomorphism restriction forces + the local definition of \verb"twiceMembers" to be restricted to a + single overloading (the dictionary parameter supplied to each use + of members must be constant throughout the local definition): +\begin{verbatim} + ERROR "ex" (line 12): Type error in type signature expression + *** term : twiceMembers + *** type : [(Bool,Bool)] + *** does not match : [Bool] + ? +\end{verbatim} + Once again, this problem can be fixed using an explicit type + declaration: +\begin{verbatim} + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers :: Finite a => [a] + twiceMembers = members ++ members +\end{verbatim} +\EI + +\paragraph{Formal definition:} +The examples above describe the motivation for the monomorphism +restriction, captured by the following definition: + +Dictionary variables will not be used as extra parameters in the +definition of a value in a given declaration group $G$ if: +\BSI +\IT either: $G$ includes a pattern binding +\IT or: $G$ includes a variable declaration, but does not include an + explicit type signature for any of the variables in the + group. +\ESI +If neither of these conditions hold, then equivalent sets of dictionary +parameters will be added to each declaration in the group. + + + + + + +\appendix + +\chapter{Summary of grammar} + +This section gives a summary of the grammar for the language used by +Gofer. The non-terminals `interp' and `module' describe the syntax of +expressions that can be entered into the Gofer interpreter and that of +files of definitions that can be loaded into Gofer respectively. + +The following notational conventions are used in the Grammar which is +specified using a variant of {\sc bnf}: +\BSI +\IT nonterminals are set in roman type; + % are used to distinguish names of nonterminals from + %keywords. +\IT vertical `$|$' bars are used to separate alternatives; +\IT \{braces\} enclose items which may be repeated zero or more times; +\IT \sub brackets\bus\ are used for optional items; +\IT (parentheses) are used for grouping; +\IT terminal sybols are enclosed in \fbox{boxes} and are + set in {\tt typewriter type}. + %"quotes" surround characters which might otherwise be confused with + %the notations introduced above. +\ESI +The following terminal symbols are used but not defined by the grammar: +\BQ +\begin{tabular}{ll} + \I{varid}& identifier beginning with lower case letter as described in + section 6 \\ + \I{conid}& like \I{varid}, but beginning with upper case letter \\ + \I{varop}& operator symbol not beginning with a colon, as described in + section 6 \\ + \I{conop}& constructor function operator, like \I{varop}, but beginning + with a colon character \\ + \I{integer}& integer constant, as described in section 7.3 \\ + \I{float}& floating point constant, as described in section 7.4 \\ + \I{char}& character constant, as described in section 7.5 \\ + \I{string}& string constant, as described in section 7.7 +\end{tabular} +\EQ + + +\subsubsection*{Top-level grammar} +\begin{tabular}{p{2cm}cp{6.5cm}l} + module & ::= & \T{\char123} topdecls \T{\char125}&module\\ + interp & ::= & exp [where] &top-level expression\\ + topdecls & ::= & topdecls \T{;} topdecls &multiple declarations\\ + & $|$ & \T{data} typeLhs \T{=} constrs &datatype declaration\\ + & $|$ & \T{type} typeLhs \T{=} type &synonym declaration\\ + & $|$ & \T{infixl} [digit] op \{\T{,} op\}&fixity declarations\\ + & $|$ & \T{infixr} [digit] op \{\T{,} op\}\\ + & $|$ & \T{infix} [digit] op \{\T{,} op\}\\ + & $|$ & \T{primitive} prims \T{::} type &primitive bindings\\ + & $|$ & class &class declaration\\ + & $|$ & inst &instance declaration\\ + & $|$ & decls &value declarations\\ +\end{tabular} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + typeLhs & ::= & \I{conid} \{\I{varid}\/\} &type declaration lhs\\ + + constrs & ::= & constrs \T{|} constrs &multiple constructors\\ + & $|$ & type \I{conop} type &infix constructor\\ + & $|$ & \I{conid} \{type\} &constructor\\ + + prims & ::= & prims \T{,} prims &multiple bindings\\ + & $|$ & var \I{string} &primitive binding +\end{tabular} + +\subsubsection*{Type expressions} +\begin{tabular}{p{2cm}cp{6.5cm}l} + sigType & ::= & \sub context \T{=>} \bus type &[qualified] type\\ + context & ::= & \T{(} [pred \{\T{,} pred\} ] \T{)} &general form\\ + & $|$ & pred &singleton context\\ + pred & ::= & \I{conid} type \{type\} &predicate\\ + type & ::= & ctype [ \T{->} type ] &function type\\ + ctype & ::= & \I{conid} \{atype\} &datatype or synonym\\ + & $|$ & atype\\ + atype & ::= & \I{varid} &type variable\\ + & $|$ & \T{()} &unit type\\ + & $|$ & \T{(} type \T{)} &parenthesised type\\ + & $|$ & \T{(} type \T{,} type \{\T{,} type\} \T{)} &tuple type\\ + & $|$ & \T{[} type \T{]} &list type +\end{tabular} + +\subsubsection*{Class and instance declarations} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + class & ::= & \T{class} [context \T{=>} ] pred [cbody]\\ + cbody & ::= & \T{where} \T{\char123} cdecls \T{\char125} &class body\\ + cdecls & ::= & cdecls \T{;} cdecls &multiple declarations\\ + & $|$ & var \{\T{,} var\} \T{::} type &member functions\\ + & $|$ & fun rhs [where] &default bindings\\ + + inst & ::= & \T{instance} [context \T{=>} ] pred [ibody]\\ + ibody & ::= & \T{where} \T{\char123} idecls \T{\char125} &instance body\\ +% inst & ::= & inst [context \T{=>} ] pred [ibody]\\ +% ibody & ::= & where \T{\char123} idecls \T{\char125} &instance body\\ + idecls & ::= & idecls \T{;} idecls &multiple declarations\\ + & $|$ & fun rhs [where] &member definition +\end{tabular} + +\subsubsection*{Value declarations} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + decls & ::= & decls \T{;} decls &multiple declarations\\ + & $|$ & var \{\T{,} var\} \T{::} sigType &type declaration\\ + & $|$ & fun rhs [where] &function binding\\ + & $|$ & pat rhs [where] &pattern binding\\ + + rhs & ::= & \T{=} exp &simple right hand side\\ + & $|$ & gdRhs \{gdRhs\} &guarded right hand sides\\ + + gdRhs & ::= & \T{|} exp \T{=} exp &guarded right hand side\\ + + where & ::= & \T{where} \T{\char123} decls \T{\char125} &local definitions\\ + + fun & ::= & var &function of arity 0\\ + & $|$ & pat varop pat &infix operator\\ + & $|$ & \T{(} pat varop \T{)} §ion-like notation\\ + & $|$ & \T{(} varop pat \T{)}\\ + & $|$ & fun apat &function with argument\\ + & $|$ & \T{(} fun \T{)} &parenthesised lhs +\end{tabular} + +\subsubsection*{Expressions} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + exp & ::= & \T{\char92} apat \{apat\} \T{->} exp &lambda expression\\ + & $|$ & \T{let} \T{\char123} decls \T{\char125} \T{in} exp &local definition\\ + & $|$ & \T{if} exp \T{then} exp \T{else} exp &conditional expression\\ + & $|$ & \T{case} exp \T{of} \T{\char123} alts \T{\char125} &case expression\\ + & $|$ & opExp \T{::} sigType &typed expression\\ + & $|$ & opExp\\ + opExp & ::= & opExp op opExp &operator application\\ + & $|$ & pfxExp\\ + pfxExp & ::= & \T{-} appExp &negation\\ + & $|$ & appExp\\ + appExp & ::= & appExp atomic &function application\\ + & $|$ & atomic\\ + atomic & ::= & var &variable\\ + & $|$ & conid &constructor\\ + & $|$ & \I{integer} &integer literal\\ + & $|$ & \I{float} &floating point literal\\ + & $|$ & \I{char} &character literal\\ + & $|$ & \I{string} &string literal\\ + & $|$ & \T{()} &unit element\\ + & $|$ & \T{(} exp \T{)} &parenthesised expr.\\ + & $|$ & \T{(} exp op \T{)} §ions\\ + & $|$ & \T{(} op exp \T{)}\\ + & $|$ & \T{[} list \T{]} &list expression\\ + & $|$ & \T{(} exp \T{,} exp \{\T{,} exp\} \T{)} &tuple\\ + + list & ::= & \sub\ exp \{\T{,} exp\} \bus &enumerated list\\ +%% list & ::= & \sub exp \{\T{,} exp\} \bus &enumerated list\\ + & $|$ & exp \T{|} quals &list comprehension\\ + & $|$ & exp \T{..} &arithmetic sequence\\ + & $|$ & exp \T{,} exp \T{..}\\ + & $|$ & exp \T{..} exp\\ + & $|$ & exp \T{,} exp \T{..} exp\\ + quals & ::= & quals \T{,} quals &multiple qualifiers\\ + & $|$ & pat \T{<-} exp &generator\\ + & $|$ & pat \T{=} exp &local definition\\ + & $|$ & exp &boolean guard\\ + + alts & ::= & alts \T{;} alts &multiple alternatives\\ + & $|$ & pat altRhs [where] &alternative\\ + altRhs & ::= & \T{->} exp &single alternative\\ + & $|$ & gdAlt {gdAlt} &guarded alternatives\\ + gdAlt & ::= & \T{|} exp \T{->} exp &guarded alternative +\end{tabular} + +\subsubsection*{Patterns} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + pat & ::= & pat conop pat &operator application\\ + & $|$ & var \T{+} \I{integer} &$(n+k)$ pattern\\ + & $|$ & appPat\\ + appPat & ::= & appPat apat &application\\ + & $|$ & apat\\ + apat & ::= & var &variable\\ + & $|$ & var \T{@} pat &as pattern\\ + & $|$ & \T{\char126} pat &irrefutable pattern\\ + & $|$ & \T{\_} &wildcard\\ + & $|$ & conid &constructor\\ + & $|$ & \I{integer} &integer literal\\ + & $|$ & \I{char} &character literal\\ + & $|$ & \I{string} &string literal\\ + & $|$ & \T{()} &unit element\\ + & $|$ & \T{(} pat \T{)} &parenthesised expr.\\ + & $|$ & \T{(} pat conop \T{)} §ions\\ + & $|$ & \T{(} conop pat \T{)}\\ + & $|$ & \T{[} [ pat \{\T{,} pat\} ] \T{]} &list\\ + & $|$ & \T{(} pat \T{,} pat \{\T{,} pat\} \T{)} &tuple +\end{tabular} + +\subsubsection*{Variables and operators} + +\begin{tabular}{p{2cm}cp{6.5cm}l} + var & ::= & varid \\ + & $|$ & \T{(-)} &variable\\ + op & ::= & varop \\ + & $|$ & conop \\ + & $|$ & \T{-} &operator\\ + varid & ::= & \I{varid} \\ + & $|$ & \T{(} \I{varop} \T{)} &variable identifier\\ + varop & ::= & \I{varop} \\ + & $|$ & \T{`} \I{varid} \T{`} &variable operator\\ + conid & ::= & \I{conid} \\ + & $|$ & \T{(} \I{conop} \T{)} &constructor identifier\\ + conop & ::= & \I{conop} \\ + & $|$ & \T{`} \I{conid} \T{`} &constructor operator +\end{tabular} + + + + +\chapter{Contents of standard prelude} + +\begin{verbatim} +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.20 (beta-release) +-- Copyright Mark P Jones 1991. +-- +-- Standard prelude for use of overloaded values using type classes. +-- Based on the Haskell standard prelude version 1.1. + +help = "press :? for a list of commands" +\end{verbatim} + +\subsubsection*{Operator precedence table} +\begin{verbatim} +infixl 9 !! +infixr 9 . +infixr 8 ^ +infixl 7 * +infix 7 /, `div`, `rem`, `mod` +infixl 6 +, - +infix 5 \\ +infixr 5 ++, : +infix 4 ==, /=, <, <=, >=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +\end{verbatim} +\subsubsection*{Standard combinators} +\begin{verbatim} +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x +\end{verbatim} +\subsubsection*{Boolean functions} +\begin{verbatim} +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True +\end{verbatim} +\subsubsection*{Character functions} +\begin{verbatim} +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c +\end{verbatim} +\subsubsection*{Standard type classes} +\begin{verbatim} +class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +class Ord a => Ix a where + range :: (a,a) -> [a] + index :: (a,a) -> a -> Int + inRange :: (a,a) -> a -> Bool + +class Ord a => Enum a where + enumFrom :: a -> [a] -- [n..] + enumFromThen :: a -> a -> [a] -- [n,m..] + enumFromTo :: a -> a -> [a] -- [n..m] + enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] + + enumFromTo n m = takeWhile (m>=) (enumFrom n) + enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m) + (enumFromThen n n') + +class Eq a => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a +\end{verbatim} +\subsubsection*{Type class instances} +\begin{verbatim} +primitive primEqInt "primEqInt", + primLeInt "primLeInt" :: Int -> Int -> Bool +primitive primPlusInt "primPlusInt", + primMinusInt "primMinusInt", + primDivInt "primDivInt", + primMulInt "primMulInt" :: Int -> Int -> Int +primitive primNegInt "primNegInt" :: Int -> Int + +instance Eq Int where (==) = primEqInt + +instance Ord Int where (<=) = primLeInt + +instance Ix Int where + range (m,n) = [m..n] + index (m,n) i = i - m + inRange (m,n) i = m <= i && i <= n + +instance Enum Int where + enumFrom n = iterate (1+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + +primitive primEqFloat "primEqFloat", + primLeFloat "primLeFloat" :: Float -> Float -> Bool +primitive primPlusFloat "primPlusFloat", + primMinusFloat "primMinusFloat", + primDivFloat "primDivFloat", + primMulFloat "primMulFloat" :: Float -> Float -> Float +primitive primNegFloat "primNegFloat" :: Float -> Float +primitive primIntToFloat "primIntToFloat" :: Int -> Float + +instance Eq Float where (==) = primEqFloat + +instance Ord Float where (<=) = primLeFloat + +instance Enum Float where + enumFrom n = iterate (1.0+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +instance Eq Char where c == d = ord c == ord d + +instance Ord Char where c <= d = ord c <= ord d + +instance Ix Char where + range (c,c') = [c..c'] + index (c,c') ci = ord ci - ord c + inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci + +instance Enum Char where + enumFrom c = map chr [ord c ..] + enumFromThen c c' = map chr [ord c, ord c' ..] + +instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +instance Ord a => Ord [a] where + [] <= _ = True + (_:_) <= [] = False + (x:xs) <= (y:ys) = x Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + +instance Eq Bool where + True == True = True + False == False = True + _ == _ = False +\end{verbatim} +\subsubsection*{Standard numerical functions} +\begin{verbatim} +primitive div "primDivInt", + rem "primRemInt", + mod "primModInt" :: Int -> Int -> Int + +subtract :: Num a => a -> a -> a +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `div` gcd x y) * y) + +(^) :: Int -> Int -> Int +x ^ 0 = 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`div`2) + | otherwise = f x (n-1) (x*y) + +abs :: Int -> Int +abs x | x >= 0 = x + | x < 0 = - x + +signum :: Int -> Int +signum x | x == 0 = 0 + | x > 0 = 1 + | x < 0 = -1 + +sum, product :: [Int] -> Int +sum = foldl' (+) 0 +product = foldl' (*) 1 + +sums, products :: [Int] -> [Int] +sums = scanl (+) 0 +products = scanl (*) 1 +\end{verbatim} +\subsubsection*{Standard list processing functions} +\begin{verbatim} +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [x] +init (x:xs) = x : init xs + +(++) :: [a] -> [a] -> [a] -- append lists. Associative with +[] ++ ys = ys -- left and right identity []. +(x:xs) ++ ys = x:(xs++ys) + +length :: [a] -> Int -- calculate length of list +length = foldl' (\n _ -> n+1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: Eq a => [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: Eq a => a -> [a] -> Bool +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: Ord a => [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +concat :: [[a]] -> [a] -- concatenate list of lists +concat = foldr (++) [] + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a]. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + + +-- map f xs applies the function f to each element of the list xs returning +-- the corresponding list of results. filter p xs returns the sublist of xs +-- containing those elements which satisfy the predicate p. + +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter _ [] = [] +filter p (x:xs) + | p x = x : xs' + | otherwise = xs' + where xs' = filter p xs + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs +\end{verbatim} +\subsubsection*{List breaking functions} +\begin{verbatim} +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws +\end{verbatim} +\subsubsection*{Merging and sorting lists} +\begin{verbatim} +merge :: Ord a => [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: Ord a => [a] -> [a] +sort = foldr insert [] + +insert :: Ord a => a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: Ord a => [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] +\end{verbatim} +\subsubsection*{zip and zipWith families of functions} +\begin{verbatim} +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] +\end{verbatim} +\subsubsection*{Formatted output} +\begin{verbatim} +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show' :: a -> String +show' x = primPrint 0 x [] + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs +\end{verbatim} +\subsubsection*{Miscellaneous} +\begin{verbatim} +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +error :: String -> a +error msg | False = error msg + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x +\end{verbatim} +\subsubsection*{A trimmed down version of the Haskell Text class} +\begin{verbatim} +type ShowS = String -> String + +class Text a where + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + + showsPrec = primPrint + showList [] = showString "[]" + showList (x:xs) = showChar '[' . shows x . showl xs + where showl [] = showChar ']' + showl (x:xs) = showChar ',' . shows x . showl xs + +shows :: Text a => a -> ShowS +shows = showsPrec 0 + +show :: Text a => a -> String +show x = shows x "" + +showChar :: Char -> ShowS +showChar = (:) + +showString :: String -> ShowS +showString = (++) + +instance Text () + +instance Text Int + +instance Text Char where + showList cs = showChar '"' . showl cs + where showl "" = showChar '"' + showl ('"':cs) = showString "\\\"" . showl cs + showl (c:cs) = showChar c . showl cs + -- Haskell has showLitChar c . showl cs + +instance Text a => Text [a] where + showsPrec p = showList + +instance (Text a, Text b) => Text (a,b) where + showsPrec p (x,y) = showChar '(' . shows x . showChar ',' . + shows y . showChar ')' +\end{verbatim} +\subsubsection*{I/O functions and definitions} +\begin{verbatim} +stdin = "stdin" +stdout = "stdout" +stderr = "stderr" +stdecho = "stdecho" + +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + +data Response = Success + | Str String + | Failure IOError + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +type Dialogue = [Response] -> [Request] +type SuccCont = Dialogue +type StrCont = String -> Dialogue +type FailCont = IOError -> Dialogue + +done :: Dialogue +readFile :: String -> FailCont -> StrCont -> Dialogue +writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue +appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue +readChan :: String -> FailCont -> StrCont -> Dialogue +appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue +echo :: Bool -> FailCont -> SuccCont -> Dialogue + +done resps = [] +readFile name fail succ resps = + (ReadFile name) : strDispatch fail succ resps +writeFile name contents fail succ resps = + (WriteFile name contents) : succDispatch fail succ resps +appendFile name contents fail succ resps = + (AppendFile name contents) : succDispatch fail succ resps +readChan name fail succ resps = + (ReadChan name) : strDispatch fail succ resps +appendChan name contents fail succ resps = + (AppendChan name contents) : succDispatch fail succ resps +echo bool fail succ resps = + (Echo bool) : succDispatch fail succ resps + +strDispatch fail succ (resp:resps) = + case resp of Str val -> succ val resps + Failure msg -> fail msg resps + +succDispatch fail succ (resp:resps) = + case resp of Success -> succ resps + Failure msg -> fail msg resps + +abort :: FailCont +abort err = done + +exit :: FailCont +exit err = appendChan stdout msg abort done + where msg = case err of ReadError s -> s + WriteError s -> s + SearchError s -> s + FormatError s -> s + OtherError s -> s + +print :: Text a => a -> Dialogue +print x = appendChan stdout (show x) abort done + +prints :: Text a => a -> String -> Dialogue +prints x s = appendChan stdout (shows x s) abort done + +interact :: (String -> String) -> Dialogue +interact f = readChan stdin abort + (\x -> appendChan stdout (f x) abort done) + +run :: (String -> String) -> Dialogue +run f = echo False abort (interact f) + +\end{verbatim} + +\chapter{Relationship with Haskell 1.1} + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell as +defined in the report for Haskell version 1.1 [5]. This section +details the differences between the two languages, outlined briefly in +section 2. + +\subsubsection*{Haskell features not included in Gofer:} +\BI +\IT Modules + +\IT Arrays + +\IT Derived instances for standard classes -- the ability to construct + instances of particular classes automatically. + +\IT Default mechanism for eliminating unresolved overloading involving + numeric and standard classes. Since Gofer is an experimental + system, it can be used with a range of completely different + prelude files; there is no concept of `standard classes'. + +\IT Overloaded numeric constants. In the absence of a defaulting + mechanism as mentioned in the previous item, problems with + unresolved overloading make implicitly typed programming involving + numeric constants impractical in an interpreter based system. + +\IT Full range of numeric types and classes. Gofer has only two + primitive numeric types \verb"Int" and \verb"Float" + (the second of which is not + supported in the PC version). Although is would be possible to + modify the standard prelude so that Gofer uses the same class + hierarchy as Haskell, this is unnecessarily sophisticated for the + intended uses of Gofer. + +\IT Datatype definitions in Haskell may involve class constraints such + as: +\begin{verbatim} + data Ord a => Set a = Set [a] +\end{verbatim} + It is not clear how such constraints should be interpreted + (particularly in the light of the extended form of constraints + used by Gofer) in such a way to make them useful whilst avoiding + unwanted ambiguity problems. +\EI + +\subsubsection*{Gofer features not supported in Haskell:} +\BI +\IT Type classes may have multiple parameters. + +\IT Predicates in type expressions may involve arbitrary type + expressions, not just type variables as used in Haskell. + +\IT Instances of type classes can be defined at non-overlapping, but + otherwise arbitrary types, as described in section 14.2.5. + +\IT List comprehensions may include local definitions, specified by + qualifiers of the form \verb"pat=expr" as described in section 10.2. + +\IT No restrictions are placed on the form of predicates that appear + in the context for a class or instance declaration. This has a + number of consequences, including the possibility of using + (mutually) recursive groups of dictionaries, but means that + decidability of the predicate entailment relation may be lost. + This is not a great problem in practice, since all dictionary + construction is performed before evaluation and supposedly + non-terminating dictionary constructions will actually generate an + error due to the limited amount of space available for holding + dictionaries (see section 14.4.2). +\EI + +\subsubsection*{Other differences:} +\BI +\IT Whilst superficially similar the approach to type classes in Gofer + is quite different from that used in Haskell. In particular, the + approach used in Gofer ensures that all necessary dictionaries are + constructed before the evaluation of an expression begins, rather + than being built (possibly several times) during the evaluation as + is the case with Haskell. See section 14 and reference [11] for + further details. + +\IT Input/Output facilities - Gofer supports only a subset of the + requests available in Haskell. In principle, it should not be too + difficult to add most of the remaining forms of request (with the + exception of those associated with binary files) to Gofer. The + principal motivation for including the I/O facilities in Gofer was + to make it possible to experiment with simple interactive + programs. + +\IT In Gofer, unary minus has greater precedence than any operator + symbol, but lower than that of function application. In Haskell, + the precedence of unary minus is the same as that of the infix + (subtraction) operator of the same name. + +\IT In Haskell, the character `\verb"-"' can only be used as the first + character of an operator symbol. In Gofer, this character may + appear in any position in an operator (except for symbols + beginning with \verb"--", which indicates the start of a comment). The + only problems that I am aware of with this is that a lambda + expression such as \verb"\-2->2" will be parsed as such by a Haskell + system, but cause a syntax error in Gofer. This form of lambda + expression is sufficiently unusual that I do not believe this will + cause any problems in practice; in any case, the parsing problem + can be solved by inserting a space: \verb"\ -2->2". + +\IT Pattern bindings are not currently permitted in either instance or + class declarations. This restriction has been made simply for + ease of implementation, is not an inherent problem with the type + class system and is likely to be relaxed in later versions of + Gofer if appropriate. I have yet to see any examples in which the + lack of pattern bindings in class and instance declarations causes + any kind of deficiency. + +\IT Qualified type signatures are not permitted for the member + functions in Gofer class declarations. Once again, this + restriction was made for ease of implementation rather than any + pressing technical issues. It is likely that this restriction + will be relaxed in future versions of Gofer, although I am not + convinced that proper use can be made of such member functions + without some form of nested instance declarations (yuk!). + +\IT The definition of the class Text given in the standard prelude + does not include the Haskell functions for reading/parsing values + from strings; the only reason for omitting these functions was to + try to avoid unnecessary complexity in the standard prelude. The + standard prelude can be modified to include the appropriate + additional definitions if these are required. +\EI + +\subsubsection*{Known problems in Gofer:} +\BI +\IT The null escape sequence \verb="\&"= is not generated in the printable + representations of strings produced by both the primitive function + primPrint (used to implement the \verb"show'" function) and the version + of show defined in the standard prelude. This means that certain + strings values are not printed correctly e.g.\ + \verb=show' "\245\&123"= + produces the string \verb="\245123"=. This is unlikely to cause too many + problems in practice. + +\IT Unification of a type variable a with a type expression of the + form \verb"T a" where \verb"T" + is a synonym name whose expansion does not + involve a will fail. It is not entirely clear whether this + behaviour is correct or not. + +\IT Formfeeds \verb="\f"= and vertical + tabs \verb="\v"= are not treated as valid + whitespace characters in the way suggested by the Haskell report. + +\IT Inability to recover from program stack overlow errors in some + situations. This problem only affects the PC implementation of + Gofer. + +\IT Implementation of \verb"ReadFile" may lose referential transparency; the + response to a particular \verb"ReadFile" request may be affected by a + later \verb"WriteFile" or \verb"AppendFile" + request for the same file. Whilst + this problem can be solved for Unix based implementations, I have + not yet found a portable solution suitable for all of the systems + on which Gofer can be used. +\EI + +\subsubsection*{Areas for possible future improvement:} +\BI +\IT Relaxing the restriction on type synonyms in predicates. + +\IT General purpose automatic default mechanism for eliminating + certain forms of unresolved overloading. + +\IT Improved checking and use of superclass and instance constraints + during static analysis and type checking. + +\IT Simple facility to force dictionary construction at load-time. + +\IT Provision for shell escapes :! etc within the Gofer interpreter. + +\IT Debugging facilities, including breakpoints and tracing from + within interpreter. + +\IT Separate interpreter and compiler programs for creating standalone + applications using Gofer. +\EI + + + +\chapter{Using Gofer with Bird\&Wadler} + +Bird and Wadler's textbook [1] gives an excellent introduction to +functional programming, providing an insight into both basic techniques +and matters of programming style as well as describing the underlying +mathematics and its use for program development and derivation. Most +of the programs in that book can be used with Gofer although there are +a number of differences between the two notations. Fortunately, it is +not difficult to translate from one notation to the other. The +following points are particularly useful for this: +\BI +\IT Type constructors in Gofer begin with capital letters (e.g.\ \verb"Bool", + \verb"Char" etc.) where lower case is used in [1] + (e.g.\ \verb"bool", \verb"char", + etc.). Note that Gofer has no general numeric type \verb"num" as used + in [1]; Use either \verb"Int", \verb"Float", + or overloading in Gofer as + appropriate. + +\IT Datatype definitions in [1] are written in the form \verb"lhs::=constrs". + The equivalent definition in Gofer is: \verb"data lhs = constrs". + + Similarly, a type synonym definition in [1] of the form \verb"lhs == rhs" + can be written in Gofer as: \verb"type lhs = rhs". + +\IT The differences between the syntax used for guarded equations in + Gofer compared with the notation used in [1] have already been + discussed in section 9.2. For example: + + ~~~~~Using the notation of [1]:~~~~~~~~~~~~~~~~~~~~~Using Gofer: +\begin{verbatim} + filter p (x:xs) filter p (x:xs) + = x : filter p xs, if p x | p x = x : filter p xs + = filter p xs, otherwise | otherwise = filter p xs +\end{verbatim} +\IT In Gofer, list comprehension qualifiers are separated by commas + rather than semicolons as used in [1]. + +\IT A number of the function names and types in the standard prelude + are different: +\BQ +\begin{tabular}{ll|ll} + {[1]} & Gofer & {[1]} & Gofer \\\hline + \verb"(#)" & \verb"length" & \verb"takewhile" & \verb"takeWhile"\\ + \verb"(~)" & \verb"not" & \verb"dropwhile" & \verb"dropWhile"\\ + \verb"(/\)" & \verb"(&&)" & \verb"zipwith" & \verb"zipWith"\\ + \verb"(\/)" & \verb"(||)" & \verb"swap" & \verb"flip"\\ + \verb"(!)" & \verb"(!!)" & \verb"in" & \verb"elem"\\ + \verb"(--)" & \verb"(\\)" & \verb"scan" & \verb"scanl"\\ + \verb"hd" & \verb"head" & \verb"some" & \verb"any"\\ + \verb"tl" & \verb"tail" & \verb"listmin" & \verb"minimum"\\ + \verb"decode" & \verb"chr" & \verb"listmax" & \verb"maximum"\\ + \verb"code" & \verb"ord" +\end{tabular} +\EQ + See appendix B for a complete list of standard functions in Gofer. + + The version of \verb"foldl" using \verb"strict" + which appears in [1] is + available in Gofer as the function \verb"foldl'". + The role of \verb"zip" and \verb"zipwith" in [1] is + filled by the \verb"zip" and + \verb"zipWith" families of functions in Gofer. An expression of the + form \verb"zip (xs,ys)" in [1] is equivalent to + \verb"zip xs ys" in Gofer + etc. + +\IT Gofer does not enforce the condition assumed in [1] that the left + hand sides of each of the equations defining a function must be + disjoint. + +\IT The equality operator in Gofer is written as \verb"==" and the single + equality character \verb"=" is a reserved symbol used to separate left + and right hand sides of equations. Many C programmers will be + familiar with this kind of notation (together with the kinds of + problems it can create!). + +\IT Some of the identifiers used in [1] are reserved words in Gofer. + Examples that are particularly likely to occur include \verb"in" and + \verb"then". +\EI + +\chapter{Primitives} + +Warning: the features described in this appendix are typically only +needed when alternative versions of the standard prelude are created. +These features should only be used by expert users; misuse may lead to +failure and runtime errors in the Gofer interpreter. It is not usually +a good idea to use primitive functions directly in your programs. + +A number of primitive functions are builtin to the Gofer interpreter, +and may be bound to function symbols using a declaration of the form: +\begin{verbatim} + primitive name1 code1, name2 code2, ...., namen coden :: type +\end{verbatim} +where each name is an identifier (or an operator symbol enclosed by +parentheses) and each code is a string literal taken from the table +below. The type specified to the right of the \verb"::" symbol must be a +valid type for the functions being defined -- {\em warning: gofer does not +attempt to check for suitability of the declared type}. The following +definition, taken from the standard prelude, illustrates the use of +this feature to bind a function named \verb"primPrint" to the primitive +function with code name string \verb="primPrint"= and type +\verb"Int -> a -> String -> String": +\begin{verbatim} + primitive primPrint "primPrint" :: Int -> a -> String -> String +\end{verbatim} +The primitive functions currently available are: +\BI +\IT integer arithmetic: +\begin{verbatim} + primPlusInt Int -> Int -> Int + primMinusInt Int -> Int -> Int + primMulInt Int -> Int -> Int + primDivInt Int -> Int -> Int + primModInt Int -> Int -> Int + primRemInt Int -> Int -> Int + primNegInt Int -> Int -> Int +\end{verbatim} +\IT floating point arithmetic: +\begin{verbatim} + primPlusFloat Float -> Float -> Float + primMinusFloat Float -> Float -> Float + primMulFloat Float -> Float -> Float + primDivFloat Float -> Float -> Float + primNegFloat Float -> Float -> Float +\end{verbatim} +\newpage +\IT coercion functions: +\begin{verbatim} + primIntToChar Int -> Char -- chr in the standard prelude + primCharToInt Char -> Int -- ord in the standard prelude + primIntToFloat Int -> Float -- implements fromInteger +\end{verbatim} +\IT equality and $\le$ primitives: +\begin{verbatim} + primEqInt Int -> Int -> Bool + primLeInt Int -> Int -> Bool + primEqFloat Float -> Float -> Bool + primLeFloat Float -> Float -> Bool +\end{verbatim} +\IT generic ordering primitives: +\begin{verbatim} + primGenericEq a -> a -> Bool + primGenericNe a -> a -> Bool + primGenericGt a -> a -> Bool + primGenericLe a -> a -> Bool + primGenericGe a -> a -> Bool + primGenericLt a -> a -> Bool +\end{verbatim} + These functions implement the standard generic (i.e.\ non + overloaded) ordering primitives. They are not currently + used in the standard prelude. A simplified prelude may be + created by binding the standard operator symbols \verb"(==)", + \verb"(/=)", \verb"(>)", \verb"(<=)", \verb"(>=)" + and \verb"(<)" to these functions + respectively. +\IT output: +\begin{verbatim} + primPrint Int -> a -> String -> String +\end{verbatim} + This function is used to implement the \verb"show'" function in + the standard prelude and is not usually used directly. + + \verb"primPrint d e s" produces a textual representation of the + value of the expression \verb"e" as a string, followed by the + string \verb"s". The integer parameter \verb"d" is used as an indicator + of the current precedence level. The \verb"primPrint" function + is the standard method of printing the value of an + expression whose type is not equivalent to the type \verb"String" + used by the top-level of the Gofer interpreter. +\IT sequencing: +\begin{verbatim} + primStrict (a -> b) -> a -> b +\end{verbatim} + The \verb="primStrict"= function (bound to the identifier \verb"strict" + in the standard prelude) forces the evaluation of its + second argument before the function supplied as the first + argument is applied to it. See section 9.4 for an + illustration. +\EI + + +%\chapter{Example programs} +%\input{examples.tex} +% + +\chapter{Interpreter command summary} + +\BI +\IT +\I{expr} + + Analyse expression for errors, typecheck and evaluate. If + the expression has type \verb"Dialogue", execute as a program + using the I/O facilities as described in section 12. If + the expression has type \verb"String", evaluate and print result + as a lazy list of characters. In any other case, the + standard prelude function \verb"show'" is applied to the + expression and used to print the value of the result in + the form of a string, as in the previous case.\\ +\IT +\verb":t" \I{expr} \\ +\verb":type" \I{expr} \\ +\verb":T" + + Analyse expression for errors, typecheck and print the + translation and inferred type of the term. +\IT +\verb":q"\\ +\verb":quit"\\ +\verb":Q" + + Exit Gofer interpreter. +\IT +\verb":?"\\ +\verb":h"\\ +\verb":H" + + Display summary of interpreter commands. +\IT +\verb":l" $f_1$ \dots $f_n$\\ +\verb":load"\\ +\verb":L" + + Removes any previously loaded files of definitions and + attempts to load the contents of the files $f_1$ upto $f_n$ one + after the other. + If no filenames are provided, + only + those functions and values defined in the standard prelude + will still be be available. +\IT +\verb":a" $f_1$ \dots $f_n$ \\ +\verb":also"\\ +\verb":A" + + Load the contents of the files $f_1$ upto $f_n$ in addition to + any previously loaded files. If any of the files of + definitions which have already been loaded have been + modified since they were last read then they are + automatically reloaded before any of the files $f_1$ upto $f_n$ + are read. + + If successful, a command of the form \verb":l f1 ... fn" is + equivalent to the sequence of commands: + \verb":l", \verb":a f1" \dots \verb":a fn". +\IT +\verb":r"\\ +\verb":reload"\\ +\verb":R" + + Repeat the last load command, attempting to reload any + files which have subsequently been modified. Since later + files may depend on the definitions in earlier ones, once + one file has been reloaded, all subsequent files will also + need to be reloaded. +\IT +\verb":e" \I{file}\\ +\verb":edit"\\ +\verb":E" + + Suspend current Gofer session and start an editor program + to modify or view the named file. The Gofer session will + be resumed when the editor program terminates, and any + script files that have been changed will be reloaded + automatically. + + Note that a separate editor program is required and that + Gofer must be properly installed to use this feature. The + default editor is usually \verb"vi" (Calvin version 2.0 is a good + substitute for a PC), although this may have been changed + when your system was installed. In any case, you can + always substitute an editor of your choice by setting the + environment variable \verb"EDITOR" to the name of your favourite + editor program. + + There are a number of factors which will affect your + choice of editor. On a slow machine, with only a limited + amount of memory, you will probably need to choose a + relatively small editor which can be loaded reasonably + quickly and does not require too much memory. On a more + powerful system, you may find it more convenient to use + Gofer from a window based environment, running your editor + in one window with Gofer in another. + + Using the \verb":e" command without specifying a particular file + to be edited starts up an editor program as described + above either for the file of definitions most recently + loaded into Gofer or, if an error occurred whilst loading + a file of definitions, for the file of definitions in + which the error was last detected. + + With many editor programs, it is even possible to start + the editor at the line where the error occurred. As + before, it is possible to change the default behaviour of + Gofer in this case by setting the environment variable + \verb"EDITLINE" to a command string which can be used to start + the editor program with a given file at a specific line + number. The positions in the string at which the file + name and line number values should be inserted should be + indicated by the strings \verb="%s"= + and \verb="%d"= respectively, and + may appear in either order. The default command string, + which is used if \verb"EDITLINE" is not set is + \verb="vi +%d %s"=. +\EI + + +\chapter{Bibliography} + +\begin{enumerate} +\item + Richard Bird and Philip Wadler, + {\em Introduction to functional programming}, + Prentice Hall International, 1989. + +\item + Simon L.~Peyton Jones, + {The Implementation of functional programming languages}, + Prentice Hall International, 1987. + +\item + Thomas Johnsson, + {Lambda Lifting: Transforming Programs to Recursive Equations}, + in Lecture Notes in Computer Science 201, + Springer Verlag, 1985. + [but try to get a copy of the version of + this paper included in Johnsson's thesis which benefits from an + extended typeface and is a little easier to read!] + +\item + Philip Wadler and Stephen Blott, + {How to make ad-hoc polymorphism less ad-hoc}, + in the proceedings of the + 16th ACM annual symposium on Principles of Programming Languages, + Austin, Texas, January 1989. + +\item + Paul Hudak, Philip Wadler et al., + {Report on the programming language Haskell, a non-strict purely + functional language (Version 1.1)}, + Technical report Yale University/Glasgow University. August, 1991. + +\item + Philip Wadler and Quentin Miller, + {\em Introduction to Orwell 6.00}, + University of Oxford, 1990. + +\item + Lennart Augustsson and Thomas Johnsson, + {\em Lazy ML user's manual}, + 1990. + +\item + Mark P.~Jones, + {\em Computing with lattices: An application of type classes}, + Technical report PRG-TR-11-90, Programming Research Group, + Oxford University Computing Laboratory, June 1990. + +\item + Mark P.~Jones, + {\em Towards a theory of qualified types}, + Technical report PRG-TR-6-91, + Programming Research Group, Oxford University + Computing Laboratory, April 1991. + +\item + Mark P.~Jones, + {\em Type inference for qualified types}, + Technical + report PRG-TR-10-91, Programming Research Group, Oxford University + Computing Laboratory, June 1991. + +\item + Mark P.~Jones, + {\em A new approach to type classes}, + distributed to + Haskell mailing list 1991. + +\item + Mark P.~Jones, + {\em Practical issues in the implementation of qualified types}, + Forthcoming 1991. +\end{enumerate} + + + +\end{document} + diff --git a/docs/hype b/docs/hype new file mode 100644 index 0000000..6166aae --- /dev/null +++ b/docs/hype @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +Gofer 2.28 is an interactive functional programming environment (i.e. an +interpreter) supporting a language based on the draft report for Haskell +version 1.2, including the following features: + + o Lazy evaluation, higher order functions, pattern matching etc... + + o Wide range of built-in types with provision for defining new free + datatypes and type synonyms. + + o Polymorphic type system with provision for overloading based on + a system of type classes. + + o Full Haskell 1.2 expression and pattern syntax including lambda, + case, conditional and let expressions, list comprehensions, operator + sections, and wildcard, as and irrefutable patterns. + + o Partial implementation of Haskell 1.2 facilities for I/O, enabling + the use of simple interactive programs and programs reading and writing + text files. + + o User documentation, sample programs and source code freely available. + + o Supports constructor classes and overloaded monad comprehensions. + + o Simple minded compiler/translator Gofer -> C with runtime system for + generation of standalone applications. + + o Runs (and originally developed) on PC compatible computers, but + also works on Sun workstations. Code should be portable to many + other kinds of machine. + +Gofer is intended as an experimental language, particularly where type classes +are involved. Gofer extends the Haskell type class system in several ways: + + o Type classes with multiple parameters are supported. + + o Instances of type classes may be defined non-overlapping, but otherwise + arbitrary types. + + o Predicates in contexts may involve arbitrary type expressions, not just + type variables as in Haskell. + + o Basic approach to dictionary construction is different, based on the + approach I described in a posting to the Haskell mailing list early in + Feburary 1991. The resulting system ensures that all dictionaries are + constructed before evaluation begins, avoiding repeated construction + and enabling the shared evaluation of overloaded constants in + dictionaries. + +The most significant features of Haskell not currently supported are: +modules, arrays, overloaded numeric constants, default declarations, derived +instances, contexts in datatype definitions. +------------------------------------------------------------------------------ +And just in case you wondered: + + The name "Gofer" is not a trademark, registered or otherwise, and + you are free to mention this name in published material, public and + private correspondence, or other documents without restriction or + obligation. +------------------------------------------------------------------------------ diff --git a/docs/jeroen.1 b/docs/jeroen.1 new file mode 100644 index 0000000..7538414 --- /dev/null +++ b/docs/jeroen.1 @@ -0,0 +1,274 @@ +.TH GOFER 1 + +.SH NAME +gofer \- Functional programming language +.br +gofc \- Gofer-to-C compiler +.br +gofcc \- Compile C program generated by gofc + +.SH SYNOPSIS +gofer [options] [files] +.br +gofc [options] [files] +.br +gofcc +.RI file .c + +.SH FILE PARAMETERS +File parameters can be of three types: +.br +.TP 1c +Gofer scripts +File containing definitions of functions, +operators, types, etc. +Comments are enclosed by +.B {\- +and +.B \-} +or by +.B \-\- +and end-of-line. +Files ending in +.IR .hs , +.IR .has , +.IR .gs , +.I .gof +and +.I .prelude +are always treated as Gofer scripts. +.TP +Literate scripts +File in which everything is comment except lines that start +with a +.B > +symbol. +Files ending in +.IR .lhs , +.IR .lgs , +.I .verb +and +.I .lit +are always treated as literate scripts. +.TP +Project files +File containing names of files and options that +are used as parameter to Gofer. +Project filenames should be preceded by a +.B + +symbol +and a space. +.PP +Filenames that cannot be classified according to their +suffix are treated as Gofer script, or as +literate script if the +.I +l +option is used (see below). + +.SH OPTIONS +Below is a list of toggles that can be switched +on by +.BI + letter +or off by +.BI \- letter. +In the list the +default settings are shown. +.PD 0 +.sp +.TP 1c ++s +Print number of reductions/cells after evaluation +.TP +\-t +Print type after evaluation +.TP +\-d +Show dictionary values in output expressions +.TP ++f +Terminate evaluation on first error +.TP +\-g +Print number of recovered cells after garbage collection +.TP ++c +Test conformality for pattern bindings +.TP +\-l +Literate scripts as default +.TP ++e +Warn about errors in literate scripts +.TP +\-i +Apply +.I fromInteger +to integer literals +.TP ++o +Optimise use of +.B (&&) +and +.B (||) +.TP +\-u +Catch ambiguously typed top-level variables +.TP +\-. +Print dots during file analysis +.TP ++w +Always show which files are loaded +.TP ++1 +Overload singleton list notation +.TP +\-k +Show `kind'-errors in full +.sp +.PP +Other options are: +.sp +.TP 12 +.RI \-h number +Set heap size in cells (default 100000) +.TP +.RI \-p string +Set prompt string (default ?) +.TP +.RI \-r string +Set `repeat last expression' string (default $$) +.PD + +.SH COMMANDS +Commands that can be typed to the interpreter are: +.PD 0.2v +.sp +.TP 20 +.I expression +Evaluate expression +.TP +.B :quit +Quit interpreter +.TP +.B :? +Display this list of commands +.TP +.BI :load " files" +Load scrips from specified files +.TP +.BI :also " files" +Read additional files +.TP +.BI :project " file" +Use project file +.TP +.BI :edit " file" +Edit file and reload if necessary +.TP +.BI :type " expression" +Print type of expression +.TP +.BI :set " options" +Set options (as in commandline) +.TP +.BI :info " names" +Describe named functions, types etc. +.TP +.BI :find " name" +Edit file containing definition of +.I name +.TP +.BI :names " pattern" +List names currently in scope +.TP +.BI ! command +Shell escape +.TP +.BI :cd " directory" +Change working directory +.PD + + +.SH COMPILER +Gofer programs can be compiled using +.BR gofc . +One of the scripts should contain a definition +for a function +.I main +of type +.I Dialogue. +If you don't know what a `Dialogue' is, you can use +the definition +.IP "" 2cm +main = interact f +.PP +where f is a function f::String\->String. +.B gofc +generates a C program, using the last filename +with +.I .c +appended. +The generated C program can be compiled and linked with +.BR gofcc , +which generates +.IR a.out . + +.SH ENVIRONMENT VARIABLES +.TP 3cm +GOFER +Name of standard prelude (script that is always loaded before +all user files) +.TP +EDITOR +Name of the editor to be used by the +.B :edit +command +.TP +EDITLINE +Description how the editor can be called +with specified linenumber and filename, +e.g. +.BR "vi +%d %s" . + +.SH FILES +.PD 0.2v +.TP 36 +/usr/gofer-2.28/lib/standard.prelude +Standard prelude +.TP +/usr/gofer-2.28/lib/*.prelude +Alternative preludes +.TP +/usr/gofer-2.28/lib/demos/* +Example programs +.TP +/usr/gofer-2.28/lib/runtime.o +Runtime system linked by gofcc +.TP +/usr/gofer-2.28/include/*.h +Files included by gofcc +.TP +/usr/gofer-2.28/doc/* +User manuals (LaTeX-source) +.PD + +.SH AUTHOR +Mark P. Jones + +.SH VERSION +Gofer version 2.28b of May 18, 1993. + +.SH LITERATURE +Mark P. Jones: Introduction to Gofer 2.20 +.br +Mark P. Jones: Gofer 2.23 release notes +.br +Mark P. Jones: Gofer 2.28 release notes +.br +R. Bird & P.Wadler: Introduction to functional programming +.br +Paul Hudak & Joseph Fasel: `A gentle introduction to Haskell', +ACM Sigplan notices 27:5. + + diff --git a/docs/rel221.tex b/docs/rel221.tex new file mode 100644 index 0000000..8a3f586 --- /dev/null +++ b/docs/rel221.tex @@ -0,0 +1,1136 @@ +\documentstyle[a4,fleqn]{article} +\setcounter{tocdepth}{3} +\setcounter{secnumdepth}{3} +\makeatletter +\def\@dottedtocline#1#2#3#4#5{\ifnum #1>\c@tocdepth \else + \vskip \z@ plus .2pt + {\leftskip #2\relax \rightskip \@tocrmarg \parfillskip -\rightskip + \parindent #2\relax\@afterindenttrue + \interlinepenalty\@M + \leavevmode + \@tempdima #3\relax \advance\leftskip \@tempdima \hbox{}\hskip -\leftskip + \mbox{#4}\nobreak% + \mbox{{\sl ~~~#5}} + \hfill{ } + \par +}\fi} + + \def\l@section#1#2{\pagebreak[3] + \vskip 1.0em plus 1pt \@tempdima 1.5em \begingroup + \parindent \z@ \leftskip\@tempdima \rightskip \@pnumwidth + \hspace{6mm} + \bf \leavevmode \hbox{}\hskip-\@tempdima\relax #1 %\hfil + {\sl ~~~#2}\hfil + \endgroup} +\makeatother + +\begin{document} + +\thispagestyle{empty} +\vspace*{15mm} +\begin{center} +{\Huge\bf GOFER} +\vspace{5mm} + +{\Large\bf Gofer 2.21 release notes} +\vspace{5cm} + +{\Large Mark P.~Jones} +\vspace{10mm} + +{\Large November 1991} +\vspace{3cm} + +\end{center} +\setcounter{page}{0} +\newpage +\tableofcontents + +\setlength{\parindent}{0pt} +\setlength{\parskip}{3pt} +\newpage +This document is intended as a supplement to the user manual ``An +introduction to Gofer'' supplied with the previous public release of +Gofer, version 2.20.1. It provides brief descriptions of the changes +and new features incorporated in version 2.21. + +If you would like to be informed when bug-fixes or further versions +become available, please contact me at \verb"jones-mark@cs.yale.edu" (if you +have not already done so) and I will add your name to the list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + +In addition to PC and Sun workstations, I have now had reports that +Gofer has been successfully compiled and used on a number of other +machines including Apollo, DecStation, Mips, MicroVax and Acorn ARM +machines, with little or no changes to the original source. + +This \LaTeX\ version of the release notes was prepared +by Jeroen Fokker, \verb"jeroen@cs.ruu.nl". + +\subsubsection*{Acknowledgements} +Many of the features described in this document were motivated by +comments and suggestions from users of the previously released version +of Gofer. My thanks in particular to Julian Seward, but also to Brent +Benson, Stuart Clayman, Andy Gill, Peter Hancock, Ian Holyer, Hiroyuki +Matsuda, Aiden McCaughey, Tobias Nipkow, Will Partain, Ian Poole, +Bernard Sufrin and Phil Wadler. + +\newcommand{\I}[1]{\mbox{{\it #1}}} +\newcommand{\TT}[1]{\mbox{{\tt #1}}} +\newcommand{\T}[1]{\fbox{\tt #1}} +\newcommand{\sub}{[} +\newcommand{\bus}{]} + +\newcommand{\BQ}{\begin{quote}} +\newcommand{\EQ}{\end{quote}} +\newcommand{\BI}{\begin{itemize}} +\newcommand{\EI}{\end{itemize}} +\newcommand{\BSI}{\begin{simpleitemize}} +\newcommand{\ESI}{\end{simpleitemize}} +\newcommand{\IT}{\item} +\newcommand{\bottom}{\perp} + +\newenvironment{simpleitemize}{% +\begin{list}{$\bullet$}{ +\parsep = 0pt +\parskip = 0pt +\topsep = 0pt +\itemsep = 0pt +}}{\end{list}} + + + +\section{Minor enhancements} + +A number of small enhancements have been made to make the source code +for Gofer a little more flexible. In particular, this includes: +\begin{itemize} +\item Gofer can now be compiled using the Gnu C compiler gcc, for those + who prefer this to the standard cc compiler provided on their + machine. +\item Default table sizes for the Unix version have been expanded which + makes it possible to support larger programs in Gofer (a program + of over 5000 lines has already been tested with this release). +\item The Makefile has been made less SunOS specific and should be + usable on a wider range of machines without modification. +\end{itemize} + + + + + +\section{User interface extensions} + +The user interface of the previous release has been extended to support +a range of new features, intended to make the Gofer environment more +convenient for program development. Further details are given in the +following sections. + +\subsection{Command line options} +Although the previous version of Gofer accepted some command line +options, these were not documented. Those who discovered about the +Gofer command line options in the previous release by reading the +source code should note that a different syntax is now used which is +not compatible with the older system. + +Options may be set when loading Gofer (on the UNIX/DOS command line) +or within the interpreter itself using the :set command. Using this +command on its own with no arguments prints a menu of all of the +available options and displays the current settings: +\begin{verbatim} + ? :set + Groups of options begin with +/- to turn options on/off resp. + + TOGGLES: + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Treat input files as literate scripts + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + a Use any evidence, not nec. best + E Fail silently if evidence not found + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + xnum Set maximum depth for evidence search + + Current settings: +sdcoaE -tfgleiu -h100000 -p? -x8 + ? +\end{verbatim} +Most options are toggles meaning that they can either be switched on +(by preceding the option with a `\verb"+"' character) or off +(by using a `\verb"-"' +character). Several options may be grouped together so that: +\begin{verbatim} + :set +std -le is equivalent to :set +s +t +d -l -e +\end{verbatim} +In order to distinguish command line options from filenames, a leading +`\verb"+"' or `\verb"-"' must also be used with the `\verb"h"', `\verb"p"' +and `\verb"x"' options, although +the choice in each case is not significant. + +Options may also be used in \verb":a" and \verb":l" commands, +and within project files +(see section 2.2), although it should be noted that they will be acted +upon as soon as they are encountered and will not be reapplied when +reloading files. + +Most of the options listed above are described in more detail in the +following sections. + + +\subsubsection{Set Gofer prompt} +The standard Gofer prompt `\verb"? "' may be changed using a command line +option of the form \verb"-p"{\em str} where for any string {\em str}. +The new prompt is +formed from the given string, followed by a single space: +\begin{verbatim} + ? :set -pGofer> + Gofer> :set -p? + ? +\end{verbatim} + +\subsubsection{Print statistics} +In normal operation, Gofer displays the number of reductions and cells +used by a particular calculation when the result has been evaluated or +if the calculation is interrupted: +\begin{verbatim} + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (112 reductions, 204 cells) + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + (18 reductions, 54 cells) + ? +\end{verbatim} +Printing of these statistics can be suppressed using the \verb"-s" option +(and subsequently restored using \verb"+s"): +\begin{verbatim} + ? :set -s + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + ? :set +s + ? 2 + 4 + 6 + (2 reductions, 6 cells) + ? +\end{verbatim} + +\subsubsection{Print type} +Before evaluating an expression entered into the interpreter, the Gofer +type checker is used to determine the type of the resulting value. +This is used to detect errors in the original input expression, avoid +the use of runtime type checks and determine how the value should be +output. The actual type of the term is not usually displayed unless a +type error is detected. This behaviour can be changed using the \verb"+t" +option which displays the type of each value as soon as evaluation is +complete. +\begin{verbatim} + ? :set +t + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] :: [Int] + (108 reductions, 204 cells) + + ? map concat + map concat :: [[[a]]] -> [[a]] + (2 reductions, 17 cells) + + ? fix where fix f = f (fix f) + v112 :: (a -> a) -> a + (1 reduction, 7 cells) + ? +\end{verbatim} +Note that values of type \verb"String" and \verb"Dialogue" +(or equivalent forms) are +displayed in a different manner to other values, and no type information +is printed after such values to avoid any possibility of confusion: +\begin{verbatim} + ? map -- the map function + map :: (a -> b) -> [a] -> [b] + (1 reduction, 6 cells) + + ? "map" -- a string expression + map + (0 reductions, 4 cells) + + ? print "map" -- a dialogue + "map" + (18 reductions, 44 cells) + ? +\end{verbatim} + +\subsubsection{Show dictionaries} +The implementation of overloading in Gofer uses a translation of each +expression entered into the interpreter to a new expression involving +dictionary variables and constants. These additional parameters are +usually included in expressions displayed by the interpreter and are +often useful for understanding and resolving overloading problems: +\begin{verbatim} + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \d125 x -> (+) d125 x x + + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? +\end{verbatim} +If necessary (perhaps to make the output of Gofer easier for a beginner +to understand), the printing of dictionary parameters may be suppressed +using the \verb"-d" option: +\begin{verbatim} + ? :set -d + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \x -> x + x + + ? :t map (1+) [1..10] + map (1 +) (enumFromTo 1 10) :: [Int] + ? +\end{verbatim} +The original behaviour can be obtained using \verb":set +d" within the +interpreter. + + +\subsubsection{Terminate on error} +When an irreducible subexpression is encountered during the evaluation +of a particular expression, the irreducible redex is printed with +surrounding braces and the Gofer interpreter attempts to continue the +evaluation with other parts of the original expression: +\begin{verbatim} + ? take (1/0) [1..] -- value is bottom + {primDivInt 1 0} + (4 reductions, 33 cells) + ? [1/0] -- value is [bottom] + [{primDivInt 1 0}] + (5 reductions, 34 cells) + ? [1/0, 2] -- value is [bottom, 2] + [{primDivInt 1 0}, 2] + (7 reductions, 43 cells) + ? +\end{verbatim} +Notice that, reading an expression enclosed in \{braces\} as bottom, each +of the values printed by Gofer gives the correct value. Of course, it +is not possible to arrange for anything to be printed when a value of +bottom is generated by a nonterminating computation: +\begin{verbatim} + ? last [1..] + ^C{Interrupted!} -- nothing printed until interrupted + + (10470 reductions, 15712 cells) + ? +\end{verbatim} +An alternative behaviour is provided by the \verb"+f" option, which causes the +evaluation of an expression to be abandoned completely if an error +occurs: +\begin{verbatim} + ? :set +f + ? take (1/0) [1..] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 55 cells) + + ? [1/0] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 54 cells) + + ? [1/0,2] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 56 cells) + + ? +\end{verbatim} +Note that we are no longer able to distinguish between the values +produced by these three terms from the output produced by Gofer -- the +only differences are in the number of reductions and cells used which +tells us nothing about the values of the terms. Note that the basic +method of evaluation in Gofer is unchanged -- the \verb"+f" option simply +modifies the printing mechanism (i.e the means by which values are +displayed) to be more strict (in the technical sense of the word). + +Although the use of the \verb"+f" option makes the Gofer printing mechanism +less accurate, it is sometimes useful to use this option during program +development so that an error can be detected as soon as it occurs. The +original behaviour can of course be restored at any time using the \verb"-f" +option. + + +\subsubsection{Heap size} +The \verb"-h"{\em number} option can be used to set the heap size +(i.e. total number +of cells available at any one time), but cannot be used once the +interpreter has been loaded. For example, starting the interpreter +with the command: +\begin{verbatim} + gofer -h20000 +\end{verbatim} +will typically start the Gofer interpreter with a heap of 20000 cells. +Note that the heap is used to hold an intermediate (parsed) form of an +input file while it is being read, type checked and compiled. It +follows that, the larger the input file, the larger the heap required +to enable that file to be loaded into Gofer. In practice, most large +programs are written (and loaded) as a number of separate files (see +section 2.2) which means that this does not usually cause problems. + + +\subsubsection{Garbage collector notification} +It is sometimes helpful to be able to tell when the garbage collector +is being used, in order to monitor the amount of time involved and the +number of cells recovered with each garbage collection. If the \verb"+g" +command line option is given (for example, using the command \verb":set +g") +then the garbage collector prints a message of the form \verb"{{Gc:num}}" each +time that the garbage collector is invoked. The number after the colon +indicates the total number of cells that have been recovered. + +The garbage collector messages are actually printed in three sections, +which indicate which stage the garbage collector has reached (this is +only noticeable on slower machines of course!): +\begin{quote} +\begin{tabular}{ccccccc} + & \verb"{{Gc" && \verb":" && \verb"number}}" \\ + garbage && marking cells && preparing && garbage \\ + collection && which are && unused cells && collection \\ + begins && still in use && for reuse && completed +\end{tabular} +\end{quote} +Garbage collector messages may be printed at almost any stage in a +computation (or indeed whilst loading, type checking or compiling a +file of definitions). For this reason, it is often better to turn +the garbage collector messages off (using \verb":set -g" for example) when +they are not required. + + +\subsubsection{Conformality testing} +As described briefly in section 9.11 of the documentation for Gofer +version 2.20, pattern bindings of the form \I{pat}\verb"="\I{expr} +are implemented +using a `conformality check' to ensure that the value of expr does +indeed match the pattern pat. For example, the pattern binding: +\begin{verbatim} + (x:xs) = [1..] +\end{verbatim} +is actually implemented as if it had been defined by: +\begin{verbatim} + (x:xs) = conformality [1..] + where conformality v@(_:_) = v +\end{verbatim} +which is in turn treated as a group of bindings: +\begin{verbatim} + xxs = conformality [1..] where conformality v@(_:_) = v + x = head xxs + xs = tail xxs +\end{verbatim} +The variables conformality and \verb"xxs" used here are given as examples +only -- in practice, Gofer maintains a supply of variable names and +selects new names from this supply to avoid clashes with variables +which are already in use. + +The conformality check does not cause any problems in the example +above because the list \verb"[1..]" is always guaranteed to match the +pattern \verb"(x:xs)" (i.e.\ a non-empty list). We can however see the +conformality check in action is we try examples in which the pattern +does not match: +\begin{verbatim} + ? x where (x:xs) = [] + {v114 []} + (3 reductions, 25 cells) + + ? xs where (0:xs) = [1..] + {v114 [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1)} + (13 reductions, 94 cells) + ? +\end{verbatim} +The variable \verb"v114" in each of these examples is the variable name +representing the conformality check. As the second example shows, the +value of the expression on the right hand side of the pattern binding +is evaluated as much as possible to determine whether the pattern +fits. + +This example also demonstrates a small problem with the printer +in that, when the first element of the list is encountered, it is +unable to detect that the tail of the list has not yet been evaluated. +Consequently, the expression: +\begin{verbatim} + [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1) +\end{verbatim} +is not enclosed in parentheses as it should be. This is a little +annoying, but not important because the expression only appears in an +error message. The problem cannot in general be solved unless we avoid +the use of the [...] notation for enumerating the elements of a list. + +The conformality check must be used for compatibility with Haskell. +However, it is sometimes useful to be able to suppress the conformality +check using the \verb"-c" option (for example, to use some programs written +for a language without conformality checks within Gofer): +\begin{verbatim} + ? :set -c + ? x where (x:xs) = [] + {_SEL (:) [] 1} + (5 reductions, 36 cells) + ? xs where (0:xs) = [1..] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14^C{Interrupted!} + + (55 reductions, 146 cells) + ? +\end{verbatim} +In the first example, the expression \verb"_SEL (:) [] 1" indicates that the +first component of an object constructed using the (:) operator is to +be extracted from the object \verb"[]". Clearly this is impossible, and hence +the expression \verb"_SEL (:) [] 1" is irreducible. In the second case, the +value of xs is equivalent to \verb"_SEL (:) (1:[2..]) 2" which reduces to +the infinite list \verb"[2..]" as shown, +despite the fact that \verb"[1..]" does not +match the pattern \verb"(0:xs)". + +The \verb"_SEL" function is used internally by Gofer and cannot be +entered directly into the the interpreter. One particular reason for +this is that it is not in general possible to assign a sensible type +to \verb"_SEL". +Constructor functions appearing as the first argument to \verb"_SEL" +are printed in the normal manner. There is no standard syntax for +writing tuple constructors in Gofer or Haskell which are therefore +printed in the form \verb"(,,,)" for example, where the number of commas +indicates the number of components in the tuple. In the following +example the constructor \verb"(,)" denotes the pairing constructor. +\begin{verbatim} + ? f a b where f (n+1) y = n+y; (a,b) = (0,1) + {v113 0 (_SEL (,) (0,1) 2)} + (10 reductions, 63 cells) + ? +\end{verbatim} +The same notation is sometimes used in the messages produced when type +errors are detected: +\begin{verbatim} + ? (1,2) 3 + ERROR: Type error in application + *** expression : (1,2) 3 + *** term : (,) + *** type : a -> b -> (a,b) + *** does not match : c -> d -> e -> f + + ? +\end{verbatim} +This syntax for tuple constructor functions cannot be used in +expressions entered directly into Gofer. It may however be a nice +extension to consider for future versions, allowing definitions such +as \verb"zip = zipWith (,)" and \verb"distl x = map (x,)." + + +\subsubsection{Literate scripts} +In common with most programming languages, Gofer typically treats input +from a file as a list definitions in which program text is the norm, +and comments play a secondary role, introduced by the character +sequences `\verb"--"' and `\verb"{- ... -}"'. + +An alternative approach, using an idea described by Knuth as `literate +programming', gives more emphasis to comments and documentation, with +additional characters needed to distinguish program text from comments. +Gofer supports a form of literate programming based on an idea due to +Richard Bird and originally implemented as part of the functional +programming language Orwell. The same idea has subsequently been +adopted by several other functional language systems. + +A literate script contains a sequence of lines. Program lines are +distinguished from comments by a `\verb">"' character in the first column. +This makes it particularly easy to write a document which is both an +executable program script and at the same time, without need for any +preprocessing, suitable for use with document preparation software such +as LaTeX. Indeed, this document is itself a literate script containing +the following definition of the squaring function. +\begin{verbatim} +> sqr x = x * x +\end{verbatim} +The \verb"+l" option sets Gofer to treat each input file as a literate +script. It should not be used on the command line unless the prelude +file has been edited to make a literate script. + +The effect of using literate scripts can be thought of as applying a +preprocessor to each input file before it is loaded into Gofer. This +program has a particularly simple definition in Gofer: +\begin{verbatim} + illiterate :: String -> String + illiterate cs = unlines [ xs | ('>':xs) <- lines cs ] +\end{verbatim} +The system of literate scripts used in Orwell is actually a little more +complicated than this and requires that the programmer adopt two simple +conventions in an attempt to try to catch simple errors in literate +scripts: +\BI +\IT Every input file must contain at least one line whose first + character is `\verb">"'. This means that programs containing no + definitions (because the programmer has forgotten to use the `\verb">"' + character to mark definitions) are not being accepted. + +\IT Lines containing definitions must be separated from comment lines + by one or more blank lines (i.e. lines containing only space and + tab characters). This is useful for catching programs where the + leading `\verb">"' character has been omitted from one or more lines in + the definition of a function. For example: +\begin{verbatim} + > map f [] = [] + map f (x:xs) = f x : map f xs +\end{verbatim} + would result in an error if the `\verb">"' character appeared in the first + column of the first line. +\EI +Gofer will report on errors of this kind if the \verb"+l" option is combined +with the \verb"+e" option (for example as \verb"+le"). + + +\subsubsection{Optimise {\tt (\&\&)} and {\tt (||)}} +The operator symbols \verb"(&&)" and \verb"(||)" +are usually used to represent the +boolean connectives conjunction (and) and disjunction (or). By +default, Gofer uses the following equations to produce better code for +expressions involving these operators: +\begin{verbatim} + x && y = if x then y else False + x || y = if x then True else y +\end{verbatim} +This optimisation is only valid if the operator symbols \verb"(&&)" +and \verb"(||)" +are indeed bound to the appropriate values at the top level (the +standard full definitions are required in order to support partial +applications involving these operators). Although this optimisation is +in general valid (because the appropriated definitions are included in +the standard prelude), it may be necessary in certain cases (for +example, when working with a non-standard prelude) to suppress the +optimisation using the \verb"-o" option. + + + +\subsection{Project Files} +Project files provide a simple way to use programs which has been +spread across a number of source files. Larger programs are often +written in this way, to separate the different components of the +program into smaller pieces which can be developed and tested +independently of other components. + +A project file is a simple text file containing a list of program +filenames. The project file may also contain comments using either of +the Gofer conventions for comments. As a simple example, a simple +project file, in a file named \verb"miniProlog", suitable for the +stack-based version of the mini Prolog interpreter included as a +demonstration program with Gofer 2.21 is as follows: +\begin{verbatim} + -- This is a project file suitable for loading the stack-based + -- version of the mini Prolog interpreter into Gofer 2.21 + -- + -- Load into Gofer using the command: :p miniProlog + -- or from command line using: gofer + miniProlog + + Parse -- general purpose parsing library + Interact -- general purpose library for interactive programs + PrologData -- definition of main data structures + Subst -- substitutions and unification + StackEngine -- inference engine + Main -- top level program +\end{verbatim} +As indicated in the comments at the top, there are two ways of using +this file with Gofer. Within the interpreter we can use the command +\verb":p miniProlog". Once this command has been entered, Gofer reads the +contents of the project file and then attempts to load each of the +files named. In general, if a particular project file \verb"proj" contains +the options \verb"op1",\dots, \verb"opn" and the filenames +\verb"f1",\dots, \verb"fm", then the +command \verb":p proj" is equivalent to the sequence of commands: +\begin{verbatim} + :l -- clear any previously loaded scripts + :set op1 ... opn -- set options + :l f1 ... fm -- load files +\end{verbatim} +The project file name may also be specified on the command line used to +start the interpreter by preceding the project file name with a single +`\verb"+"' character. Note that there must be at least one space on each side +of the `\verb"+"'. This may be combined with standard command line options, +but any additional filename arguments will be ignored. Starting Gofer +with a command of the form "gofer + proj" is equivalent to starting +Gofer without the \verb"+ proj" arguments and then giving the command +\verb":p proj". + +In addition, Gofer records the name of the project file and displays +this with the list of files loaded. For example: +\begin{verbatim} + Gofer session for: (project: miniProlog) + /users/mpj/public/Gofer/prelude + Parse + Interact + PrologData + Subst + StackEngine + Main + ? +\end{verbatim} +Once a project file has been selected, the command \verb":p" (without any +arguments) can be used to force Gofer to reread the project file and +load fresh copies of each of the files listed there. There are two +places in which this is particularly useful: +\BI +\IT If the project file itself has been modified since the last time + that it was read. +\IT To force Gofer to reload all of the files in the project, + regardless of the last time they were modified. +\EI +As usual, the \verb":r" command can be used to reload each of the files in the +current project without rereading the project file itself, and avoiding +the need to read certain files which have not been modified since the +previous time they were loaded. + +The use of project files integrates smoothly with the other parts of +the Gofer environment. As an example consider a project file proj +containing the four filenames \verb"f1", \verb"f2", \verb"f3" +and \verb"f4", and suppose that the +file \verb"f3" contains an error of some kind. This leads to the following +sequence of commands and results: +\begin{verbatim} + :p proj -- attempt to load project proj + -- reads filenames f1, f2, f3, f4 from proj + -- load definitions from f1 + -- load definitions from f2 + -- load definitions from f3 -- error occurs + -- error message printed + :e -- starts up editor at relevant line in f3 + -- correct error + -- exit editor + -- load definitions from f3 + -- load definitions from f4 +\end{verbatim} +After just these two commands, the error in \verb"f3" has been corrected and +all of the files mentioned in proj have been loaded, ready for use. + + +\subsection{Other new features} + +\subsubsection{{\tt :find} -- find definition} +The command \verb":f name" starts up an editor to allow you to inspect (and +possibly modify) the definition of a particular name from the files +currently loaded into Gofer. If supported (using the \verb"EDITLINE" +variable), Gofer will attempt to initialise the editor so that the +cursor is initially positioned at the first line in the definition. +There are three possibilities: +\BI +\IT If the name is defined by a function or variable binding then + the cursor is positioned at the first line in the definition of + the name (ignoring any type declaration, if present). + +\IT If the name is a constructor function, then the cursor is + positioned at the first line in the definition of the + corresponding data definition. + +\IT If the name represents an internal Gofer function, then the + cursor will be positioned at the beginning of the standard + prelude file. +\EI +Note that names of infix operators should be given without any +enclosing them in parentheses. Thus \verb":f ++" starts an editor on the +standard prelude at the first line in the definition of \verb"(++)". + + +\subsubsection{{\tt :!} -- shell escape} +A command of the form \verb":! cmd" can be used to execute a specified +system command without leaving the Gofer interpreter. For example, +\verb":! ls" (or \verb":! dir" on MS DOS machines) can be used to list the +contents of the current directory. + +The command \verb":!" without any arguments starts a new shell: +\BI +\IT On a unix machine, the \verb"SHELL" environment variable is used to + determine which shell to use (the default is \verb"/bin/sh"). + +\IT On an {\sc ms dos} machine, the \verb"COMSPEC" environment variable is used + to determine which shell to use. This is usually \verb"COMMAND.COM" + and you may return to Gofer using the \verb"EXIT" command. +\EI +As usual, it is not possible to use a shell escape to change the +current working directory. The \verb":cd" command described in the following +section can be used for this purpose. + + +\subsubsection{{\tt :cd} -- change directory} +The command \verb":cd dir" changes the current working directory to the path +given by \verb"dir". This command is ignored if the pathname is omitted. + + +\subsubsection{{\tt :names} -- list names} +The \verb":n" command lists the names of variables and functions whose +definitions are currently loaded into the Gofer interpreter. Using +this command without any arguments produces the list of all names +known to the system. For example, with just the standard prelude +loaded we obtain: +\begin{verbatim} + ? :n + !! && * + ++ - . / /= : < <= == > >= AppendChan AppendFile Echo + Failure False FormatError OtherError ReadChan ReadError ReadFile + SearchError Str Success True WriteError WriteFile [] \\ ^ abort abs + all and any appendChan appendFile asTypeOf break chr cjustify + concat const copy curry cycle div done drop dropWhile echo elem + enumFrom enumFromThen enumFromThenTo enumFromTo error even exit + filter flip foldl foldl' foldl1 foldr foldr1 fromInteger fst fst3 + gcd head help id inRange index init insert interact isAlpha + isAlphanum isAscii isControl isDigit isLower isPrint isSpace + isUpper iterate last layn lcm length lines ljustify map max maximum + merge min minimum mod negate not notElem nub null odd or ord + otherwise primDivFloat primDivInt primEqFloat primEqInt + primIntToFloat primLeFloat primLeInt primMinusFloat primMinusInt + primMulFloat primMulInt primNegFloat primNegInt primPlusFloat + primPlusInt primPrint print prints product products qsort range + readChan readFile rem repeat reverse rjustify run scanl scanl' + scanl1 scanr scanr1 show show' showChar showList showString shows + showsPrec signum snd snd3 sort space span splitAt stdecho stderr + stdin stdout strDispatch strict subtract succDispatch sum sums tail + take takeUntil takeWhile thd3 toLower toUpper transpose uncurry + undefined unlines until until' unwords words writeFile zip zip3 + zip4 zip5 zip6 zip7 zipWith zipWith3 zipWith4 zipWith5 zipWith6 + zipWith7 || + (201 names listed) + ? +\end{verbatim} +Note that the names are listed in the standard alphabetical order. + +The \verb":n" can also accept one or more pattern strings which limits the list +of names printed to those names matching one or more of the given +pattern strings: +\begin{verbatim} + ? :n fold* + foldl foldl' foldl1 foldr foldr1 + (5 names listed) + ? +\end{verbatim} +Each pattern string consists of a string of characters and may use the +standard wildcard characters: `\verb"*"' (matches anything), `\verb"?"' +(matches any +single character), `\verb"\c"' (matches exactly the character \verb"c") +and ranges of +characters of the form `\verb"[a-zA-Z]"' etc. For example: +\begin{verbatim} + ? :n *ap* *[Cc]han \\\\ ? + * + - . / : < > AppendChan ReadChan \\ ^ appendChan appendFile + map readChan + (16 names listed) + ? +\end{verbatim} + +\subsubsection{{\tt \$\$} -- recall last expression} +The previously entered expression can be recalled at any stage whilst +using the Gofer interpreter (even if the list of currently loaded files +has subsequently been changed) by using the operator symbol \verb"$$": +\begin{verbatim} + ? 42 + 42 + (1 reduction, 5 cells) + ? [$$] + [42] + (3 reductions, 12 cells) + ? [$$] + [[42]] + (5 reductions, 19 cells) + ? ($$, length $$) + ([[42]],1) + (14 reductions, 43 cells) + ? +\end{verbatim} +The \verb"$$" symbol is bound to a new value each time that an expression is +evaluated, or its type determined using the \verb":t" command: +\begin{verbatim} + ? :t $$ + ([[42]],length [[42]]) :: ([[Int]],Int) + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? $$ + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (100 reductions, 189 cells) + ? +\end{verbatim} +Note that \verb"$$" can also be used when the last expression entered used +a where clause (such expressions are simply translated into the +appropriate let expressions): +\begin{verbatim} + ? fibs where fibs = 0:1:zipWith (+) fibs (tail fibs) + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55^C{Interrupted!} + + (41 reductions, 136 cells) + ? :t $$ + let {...} in fibs :: [Int] + ? take 5 $$ + [0, 1, 1, 2, 3] + (24 reductions, 77 cells) + ? +\end{verbatim} +Note that \verb"$$" expands to the unevaluated form of the expression, so that +a certain amount of computation may be repeated if \verb"$$" is used more than +once in a subsequent expression: +\begin{verbatim} + ? sum [1..10] + 55 + (92 reductions, 130 cells) + ? $$ + $$ + 110 + (176 reductions, 254 cells) + ? x + x where x = sum [1..10] + 110 + (89 reductions, 131 cells) + ? +\end{verbatim} +Note that the value of \verb"$$" is updated after the expression has been parsed +but before it is type checked: +\begin{verbatim} + ? 42 + 42 + (1 reduction, 5 cells) + ? 4) + ERROR: Syntax error in input (unexpected `)') + ? $$ 4 + ERROR: Type error in application + *** expression : 42 4 + *** term : 42 + *** type : Int + *** does not match : a -> b + + ? +\end{verbatim} + +\subsubsection{Command names} +Command names of the form \verb":X" (where \verb"X" +represents an arbitrary capital +letter) are no longer supported. Each command has a mnemonic full name +of the form \verb":name" which can be abbreviated to \verb":n" +where `\verb"n"' is the first +letter of the full name. The complete list of commands produced by the +\verb":?" command is as follows: +\begin{verbatim} + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :set set command line options + :set help on command line options + :? display this list of commands + evaluate expression + :type print type of expression + :names [pat] list names currently in scope + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + :find edit file containing definition of name + :! command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? +\end{verbatim} + + +\section{Language differences} + +There are very few changes to the language supported by Gofer -- most +programs that ran correctly under the previous release should run +without any changes. The features described in the following sections +are (for the most part) extensions to the previous version. + +\subsection{$c*p$ and $p+k$ patterns} +Motivated by recent discussion on the Haskell mailing list, starting +with a posting from Tony Davie, Gofer now supports a more general form +of $n+k$ pattern, together with a new form of patter, $c*p$. The syntax of +patterns is extended to include: +\begin{verbatim} + pattern ::= .... | pattern + integer | integer * pattern +\end{verbatim} +Note that, in the previous version of Gofer, only variables were +permitted for the pattern $p$ in a $p+k$ pattern. Certain restrictions are +placed on the constants $c$ and $k$ used in $c*p$ and $p+k$ patterns; Gofer +currently requires $c>1$ and $k>0$. + +The semantics of these new patterns are described by the equations +(suggested by Kent Karlsson): +\begin{verbatim} + case e0 of {p+k -> e; _ -> e'} + = if e0 >= k then case e0-k of {p -> e; _ -> e'} else e' + + case e0 of {c*p -> e; _ -> e'} + = if e0 >= 0 then case e0 `divRem` c of {(p, 0) -> e; _ -> e'} + else e' +\end{verbatim} +In Gofer, both forms of pattern match nonnegative integers only (there +is no possibility for overloading here as there is in Haskell). + +These features are included in Gofer to enable experimentation with the +use of $c*p$ patterns. They are not currently supported by Haskell, and +are subject to change as we gain more experience using them. To +illustrate the potential uses for these extensions, here are two +examples provided by Tony Davie in his original message which can be +used in Gofer: +\begin{verbatim} + x^^0 = 1 -- fast exponentiation + x^^(2*n) = xn*xn where xn = x^^n -- compare with definition + x^^(2*n+1) = x * x^^(2*n) -- of (^) in the prelude + + fib 1 = 1 -- fast fibonnacci + fib 2 = 1 + fib (2*n) = (fib(n+1))^^2 - (fib(n-1))^^2 + fib (2*n+1) = (fib(n+1))^^2 + (fib n )^^2 +\end{verbatim} + + +\subsection{Errors during output} +If an error of the form \verb"error str" occurs during an output request in +a program using the facilities for I/O, the \verb"IOError" value passed to +the failure continuation is the \verb"(WriteError str)", rather than +\verb=(WriteError "{error str}")= as in the previous release. This enables +further evaluation of the string \verb"str" (for example to produce a +compound error message by concatenating several strings together). + +You are strongly advised to consider using the standard prelude +continuation \verb"exit" in your programs in place +of the \verb"abort" predicate; +whereas \verb"abort" causes a program to terminate without any indication of +the problem, \verb"exit" attempts to print a suitable error message before +the program terminates. + + +\subsection{Type synonyms in predicates} +Type synonyms may now be used in predicates (The previous release +allowed only data constructors). This means that programs such as the +\verb"cat" program described in section 14.2.6 of the Gofer +documentation can now be written as: +\begin{verbatim} + class Cat a where cat :: a -> Dialogue + instance Cat String where cat n = showFile n done + instance Cat [String] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) +\end{verbatim} +This uses the type synonym \verb"String" in place of the expanded +form \verb"[Char]" +required by the original program. Note that it is still not permitted +to define overlapping instances; an attempt to add an instance for +\verb"Cat [Char]" to the above will not be accepted. + + +\subsection{Reporting on ambiguous types} +Class declarations whose member functions have ambiguous types are no +longer permitted. For example, in the class declaration: +\begin{verbatim} + class Box a where + mem :: Int +\end{verbatim} +The type of the member function \verb"mem" +is \verb"Box a => Int" which is ambiguous +and produces the error message: +\begin{verbatim} + ERROR "examp" (line 3): Ambiguous type signature in class declaration + *** ambiguous type : Box a => Int + *** assigned to : mem + + ? +\end{verbatim} +Similar error messages are also produced an explicit type signature +includes an ambiguous type. For example: +\begin{verbatim} + func :: Eq a => Int -> Int + func x = 2*x+1 +\end{verbatim} +Results in an error of the form: +\begin{verbatim} + ERROR "examp" (line 12): Ambiguous type signature in type declaration + *** ambiguous type : Eq a => Int -> Int + *** assigned to : func + + ? +\end{verbatim} +By default, no error is signalled if an ambiguous type is assigned to a +variable or function by the type checker. This makes it possible to +write definitions such as: +\begin{verbatim} + f y xs = if xs==[] then 0 else g y + g y = f y [] +\end{verbatim} +The types obtained for each of these terms is as follows: +\begin{verbatim} + f :: Eq [a] => b -> [a] -> Int + g :: Eq [a] => b -> Int +\end{verbatim} +Note that the second type is ambiguous. Making the analogy between +these mutually recursive functions and a two state machine, we can +think of a direct call to \verb"f" as initialising the machine correctly so +that there is no problem when we enter \verb"g". On the other hand, entering +the system at \verb"g" does not initialise the machine correctly, as signalled +by the ambiguity. + +Using the \verb"+u" command line flag forces Gofer to generate an error when +an attempt to assign an ambiguous type to a top-level function occurs. +For the above example this gives: +\begin{verbatim} + ERROR "examp" (line 20): Ambiguous type signature in inferred type + *** ambiguous type : Eq [a] => b -> Int + *** assigned to : g + + ? +\end{verbatim} +The restriction to top-level functions means that \verb"f" can still be +implemented by writing: +\begin{verbatim} + f :: Eq [a] => b -> [a] -> Int + f = f' where f' y xs = if xs==[] then 0 else g y + g' y = f y [] +\end{verbatim} +which prevents external access to \verb"g'" (preventing entry to the finite +machine described above in state \verb"g"). Note that the type signature in +this example is necessary to avoid the monomorphism restriction. + + +\section{Other matters} + +\subsection{Contributions} +I would like to hear from anyone with interesting Gofer programs or +other useful items which might be included (with full credit to the +original author(s) of course!) in subsequent releases of Gofer. There +is already one example of this in the new release; a small gnuemacs +mode for running the Gofer interpreter from within gnuemacs on Unix +machines, contributed by Stuart Clayman. See the file \verb"gofer.el" for +more details. + +\subsection{Future directions} +There will not be another release of Gofer for some time. There are +however a number of areas which I would like to investigate at some +point as extensions to the Gofer system: +\BI +\IT The ability to use Haskell style type classes. +\IT Facilities for working with modules, based on the approach + described in the Haskell report. A particular problem here is + in finding an elegant way to provide the full power of the + module system from the interactive environment. +\IT The ability to write stand alone applications programs using + Gofer. +\IT An improved user interface. There are a number of grand ideas + based on the use of windowing, mouse, pulldown-menus etc. The + current user interface is closer to this kind of approach than + might at first be realised. More interesting ideas include the + design of class, data type and value browsers, along the lines + of a Smalltalk system. +\EI +I would be interested to hear from anyone with comments or suggestions +on any of these (or other ideas). + + +\end{document} diff --git a/docs/rel228.tex b/docs/rel228.tex new file mode 100644 index 0000000..0cd674f --- /dev/null +++ b/docs/rel228.tex @@ -0,0 +1,2719 @@ +\documentstyle[a4,fleqn]{article} +\setcounter{tocdepth}{3} +\setcounter{secnumdepth}{3} +\makeatletter +\def\@dottedtocline#1#2#3#4#5{\ifnum #1>\c@tocdepth \else + \vskip \z@ plus .2pt + {\leftskip #2\relax \rightskip \@tocrmarg \parfillskip -\rightskip + \parindent #2\relax\@afterindenttrue + \interlinepenalty\@M + \leavevmode + \@tempdima #3\relax \advance\leftskip \@tempdima \hbox{}\hskip -\leftskip + \mbox{#4}\nobreak% + \mbox{{\sl ~~~#5}} + \hfill{ } + \par +}\fi} + + \def\l@section#1#2{\pagebreak[3] + \vskip 1.0em plus 1pt \@tempdima 1.5em \begingroup + \parindent \z@ \leftskip\@tempdima \rightskip \@pnumwidth + \hspace{6mm} + \bf \leavevmode \hbox{}\hskip-\@tempdima\relax #1 %\hfil + {\sl ~~~#2}\hfil + \endgroup} +\makeatother + +\begin{document} +\title{{\Huge\bf GOFER}} +\author{{\Large Mark P.\ Jones}} + +\thispagestyle{empty} +\vspace*{15mm} +\begin{center} +{\Huge\bf GOFER} +\vspace{5mm} + +{\Large\bf Gofer 2.28 release notes} +\vspace{5cm} + +{\Large Mark P.~Jones} +\vspace{10mm} + +{\Large February 1993} +\vspace{3cm} + +\end{center} +\setcounter{page}{0} +\newpage +\tableofcontents + +\setlength{\parindent}{0pt} +\setlength{\parskip}{3pt} +\newpage + +This document is intended to be used as a supplement to the original +user manual ``An introduction to Gofer version 2.20'' and release +notes for Gofer 2.21 (previously supplied in a file called `update'). + +If you would like to be informed when bug-fixes or further versions +become available, please contact me at \verb"jones-mark@cs.yale.edu" (if you +have not already done so) and I will add your name to the list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + +This \LaTeX\ version of the release notes was prepared +by Jeroen Fokker, \verb"jeroen@cs.ruu.nl". + +\subsubsection*{Acknowledgements} +A lot of people have contributed to the development of Gofer 2.28 with +their support, encouragement, suggestions, comments and bug reports. +There are a lot of people to thank: + + Ray Bellis, Brent Benson, + David Bolton, Rodney Brown, + Dave Cattrall, Manuel Chakravarty, + Rami El Charif, Stuart Clayman, + Andy Duncan, Bernd Eckenfels, + Stephen Eldridge, Jeroen Fokker, + Andy Gill, Annius Groenink, + Dipankar Gupta, Guenter Huebel, + Jon Hallett, Kevin Hammond, + Peter Hancock, Ian Holyer, + Andrew Kennedy, Marnix Klooster, + Tom Lane, Hiroyuki Matsuda, + Aiden McCaughey, Tobias Nipkow, + Rainer Orth, Will Partain, + Simon Peyton Jones, Ian Poole, + Mark Raemer, Dave Rushall, + Julian Seward, Carol Tumey, + Goran Uddeborg, Gavin Wraith, + Bryan Scattergood, Matthew Smith, + Bernard Sufrin, Philip Wadler. + +This list isn't complete, and I apologize in advance if I have +inadvertently left your name out. +\newpage +\section{Minor enhancements and bugfixes} + +The following sections list the minor enhancements and bugfixes that +have been made to Gofer since the release of Gofer version 2.23. More +significant changes are described in later sections. + + +\subsection{Enhancements} +\begin{itemize} +\item For systems without the restrictions of older PCs, Gofer now uses + multiple hash tables to speed the lookup of globally defined + functions. Loading large programs into Gofer is now much faster + as a result. In one example, the time taken to load a 13,000 line + program spread across 40 individual script files was reduced by a + factor of five! + +\item For the most most part, internal errors (which shouldn't normally + appear anyway) no longer terminate the interpreter. + +\item Better handling for programs with objects whose type involves more + than 26 type variables (though whether anyone has real practical + applications for such beasts, I'm rather doubtful). + +\item The Gofer system now supports I/O requests \verb"GetProgName", \verb"GetArgs" + and \verb"GetEnv". The first two requests don't have any sensible + interpretation within the interpreter, so \verb"GetProgName" always + returns \verb/""/, while \verb"GetArgs" returns \verb"[]". These I/O requests are most + useful when producing standalone applications with the Gofer + compiler where they do indeed give the name of the program and the + list of command line arguments as expected. + +\item Added primitives for direct comparison of characters. The + original definitions of character equality and ordering in terms + of the equality and ordering on integers was elegant, but for some + examples, a substantial number of the total reductions in a given + program was taken up with calls to ord, an unnecessary + distraction. + +\item Small improvements in the speed of execution of the runtime machine, + particularly when Gofer is compiled using the GNU C compiler. + +\item Enabled the use of GNU C specific options to store frequently used + global variables in CPU registers. This is perhaps most useful + for speeding up the performance of standalone applications + produced using the Gofer compiler. + +\item Changed definitions in standard preludes to provide overloaded + versions of \verb"sum", \verb"product", \verb"sums", \verb"products", \verb"abs", \verb"signum" and \verb"(^)". + Also added a \verb"genericLength" function as in Haskell. Finally, + added \verb"Text" as a superclass of \verb"Num", again for Haskell compatibility. + +\item Added a new primitive function: \verb"openfile :: String -> String" that + can be used to read the contents of a file (named by the argument + string) as a (lazy) stream of characters. (The implementation is + in terms of a primitive which can also be used to implement the + hbc \verb"openFile" function, provided that you also define the Either + datatype used there.) + +\item Added support for a simple selection of operators for monadic I/O, + mutable variables etc. based on Lambda var (developed at Yale) and + the Glasgow I/O system. I will provide more documentation on this + as soon as there is a better consensus on the names of the + datatypes and functions that should be included in systems like + this. + +\item The error function is now implemented using a primitive function. + +\item Added support for floating point primitives: +\begin{verbatim} + pi :: Float + sin, asin, + cos, acos, + tan, atan, + log, log10, + exp, sqrt :: Float -> Float + atan2 :: Float -> Float -> Float + truncate :: Float -> Int +\end{verbatim} +\item Added support for the use of GNU readline (or equivalent) library + to be used to enhance the user interface with command line + editing. See the source makefile for instructions on how to use + this. + +\item Added floating point support to PC version of Gofer (even the + version for humble 8086 PCs will now support floating point). + Thanks to Jeroen Fokker for this! + +\item I/O datatype definitions and otherwise symbol are now builtin to + the Gofer system. + +\item Other minor tweaks and improvements. +\end{itemize} + + +\subsection{Bug fixes} +Nobody really likes to dwell on bugs, especially when they have been +eliminated. But for those of you who want to know, here is a summary of +the bugs discovered and fixed in Gofer 2.28: +\begin{itemize} +\item End of file does not imply end of line (only significant on + certain systems\dots\ I has made an assumption which happens to hold + under DOS and Unix, but was not true for other systems). + +\item Code generator produced incorrect code for some conditional + expressions involving local variables (fairly obscure). + +\item Some conditional expressions entered into the interpreter were + evaluated incorrectly, leading to unexpected evaluation errors. + +\item A small potential space leak concerned with saving the names of + files passed to the editor from within Gofer was eliminated. + +\item A subtle bug, which only occurred when a garbage collection + occurred in the middle of an attempt to update a cell with an + indirection has been fixed. + +\item Fixing the definitions of the \verb"div" and \verb"quot" operators to agree with + Haskell 1.2 (these had been changed in the transition from 1.1 to + 1.2 without my noticing). + +\item Corrected bug in string matching code (part of the \verb":names" command) + which previously allowed `\verb"*e*p"' to match with `\verb"negate"'! + +\item Nested comments were not always handled correctly when they + occurred at the very end of a script file. + +\item Added new clauses to parser to improve and correct error messages + produced by some examples. + +\item Other miscellaneous tweaks and fixes. +\end{itemize} + +There are no other currently known bugs in Gofer. But someone is bound +to find a new one within hours of the release of 2.28 if past +experience is anything to go by. If that someone is you, please let me +know! + + +\section{User interface extensions} + +The user interface of the previous release has been extended a little +to support a range of new features, intended to make the Gofer +environment more convenient for program development. Further details +are given in the following sections. + +\subsection{Customizing the Gofer system} +Often there will be several people using Gofer on the same system. Not +everyone will want to be using the system in the same way. For example, +some users may wish to use their own version of the prelude or start the +interpreter with particular command line options. + +It has always been possible to do this by installing Gofer in an +appropriate manner. But, having had more than a couple of enquiries +about this, I wanted to take some time to spell the process out more +clearly. The following description will be biased towards those people +using Gofer on Unix-like systems, but the same basic principles can be +applied with other operating systems too. + +The Gofer interpreter and prelude files will typically be installed in +a given directory, accessible to all users on the system. For the sake +of this example, let's assume that this is \verb"/usr/local/lib/Gofer". Each +user could take a copy of the Gofer interpreter into their own file +space, but a much better option is for each user to use a short script +file stored somewhere on their path. For example, the path on my Unix +account includes a subdirectory called bin and I store the following +script file `gofer' in this directory: +\begin{verbatim} + #!/bin/sh + # + # A simple shell script to invoke the Gofer interpreter and set + # the path to the prelude file. Ultimately, you might want to + # copy this file into your own bin directory so that you can record + # your favourite command line settings or use a different prelude + # file ... + # + GOFER=/usr/local/lib/Gofer/standard.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer $* +\end{verbatim} +I happen to use the standard prelude file and the default settings for +all the command line options. If, for example, I wanted to use a +different prelude file, a smaller heap and omit the printing of +statistics about the number of reductions and cells used in an +evaluation, I can modify the script to reflect this: +\begin{verbatim} + #!/bin/sh + # + # A modified version of the above script + # + GOFER=/usr/local/lib/Gofer/simple.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer -h20000 -s $* +\end{verbatim} +Of course, it is also possible to keep both of these short scripts in +my bin directory, so that I have the choice of starting up Gofer in +several different configurations, depending on the kind of work I'm +going to be doing with it. + + +\subsection{Command line options} +Gofer 2.28 supports a number of options which can be set, either on the +command line when Gofer interpreter is started, or using the \verb":set" +command within in the interpreter. Using the \verb":set" command without any +arguments produces a list of all the command line options available: +\begin{verbatim} + ? :set + TOGGLES: groups begin with +/- to turn options on/off resp. + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Literate scripts as default + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + . Print dots to show progress + w Always show which files loaded + 1 Overload singleton list notation + k Show kind errors in full + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + rstr Set repeat last expression string to str + + Current settings: +sfceow1 -tdgliu.k -h100000 -p? -r$$ + ? +\end{verbatim} +Most of these are the same as in the previous release of Gofer. The +following sections outline the few changes that have been made. The +`\verb"1"' and `\verb"k"' toggles are for use with constructor classes and will be +described in Section 4. + + +\subsubsection{Print dots to show progress} +One of the first differences that you might notice when running the +new version of Gofer is that the rows of dots printed when loading a +script file: +\begin{verbatim} + ? :l examples + Reading script file "examples": + Parsing.................................... + Dependency analysis........................ + Type checking.............................. + Compiling.................................. + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? +\end{verbatim} +are no longer printed while script files are loaded. The rows of dots +are useful for showing progress on slow machines (like the PC on which +Gofer was originally developed) where it is reassuring to know that the +system has not crashed, and is simply working its way through one +particular phase of the system. However, on a faster system, the dots +are not necessary and printing them can impose a surprising overhead on +the time it takes to load files. As a default, Gofer now simply prints +the names of each phase (Parsing, Dependency Analysis, Type checking +and Compiling) and, when that phase is complete, backspaces over it to +erase it from the screen. If you are fortunate enough to be using a +fast machine, you may not always see the individual words as they flash +past. After loading a file, your screen will typically look something +like this: +\begin{verbatim} + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? +\end{verbatim} +On some systems, the use of backspace characters to erase a line may +not work properly. One particular example of this occurs if you try to +run Gofer from within emacs. In this case, you may prefer to use the +original setting, printing the lines of dots by giving the command: +\begin{verbatim} + :set +. +\end{verbatim} +The default setting is (as illustrated above, \verb":set -."). In practice, +you will probably want to include the appropriate setting for this +option in your startup script (see Section 2.1). + + +\subsubsection{Always show which files loaded} +Some people may feel that the list of filenames printed by Gofer after +successfully loading one or more script files is redundant. This is +particularly likely if you are using the (usually default) \verb":set -." +option since the list of files loaded will probably still be on the +screen. The list of filenames can be suppressed using the \verb":set -w" +option as follows: +\begin{verbatim} + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? :set -w + ? :l examples + Reading script file "examples": + ? +\end{verbatim} +The default setting can be recovered using a \verb":set +w" command. + +Note that you can also use the \verb":info" command (without any arguments) as +described in Section 2.3.2 to find out the list of files loaded into the +current Gofer session. This should be particularly useful if you choose +the \verb":set -w" option. + + +\subsubsection{Set repeat string} +The previous expression entered into the Gofer system can be recalled +as part of the next expression using the symbol \verb"$$": +\begin{verbatim} + ? map (1+) [1..10] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (101 reductions, 189 cells) + ? filter even $$ + [2, 4, 6, 8, 10] + (130 reductions, 215 cells) + ? +\end{verbatim} +This feature was provided and documented in the previous release of +Gofer. However, it is possible that you may prefer to use a different +character string. This is the purpose of the \verb"-rstr" option which sets +the repeat string to str. For example, user's of SML might be more +comfortable using: +\begin{verbatim} + ? :set -rit + ? 6*7 + 42 + (3 reductions, 7 cells) + ? it + it + 84 + (4 reductions, 11 cells) + ? +\end{verbatim} +Another reason for making this change might be that you have a program +which uses the symbol \verb"$$" as an operator. Each occurrence of the \verb"$$" symbol +in a script file will be interpreted as the correct operator, whatever +the value of the repeat string. But, if the default \verb":set -r$$" setting is +used, any occurrence of \verb"$$" in an expression entered directly to the +evaluator will be taken as a reference to the previous expression. + +Note that the repeat string must be either a valid Haskell identifier or +symbol, although it will always be parsed as an identifier. If the +repeat string is set to a value which is neither an identifier or symbol +(for example, \verb":set -r0") then the repeat last expression facility will be +disabled altogether. + + +\subsubsection{Other changes} +Comparing the list of command line options in Section 2.2 with the list +produced by previous versions of Gofer will reveal some other small +differences not already mentioned above. The changes are as follows: +\begin{itemize} +\item The default setting for the \verb"d" toggle (show dictionaries in output + expressions) has been changed to off (\verb":set -d"). For a lot of + people, the appearance of dictionary values was rather confusing + and of little use. If you still want to see how dictionary values + are used, you will need to do \verb":set +d" or add the \verb"+d" argument to + your startup script. + +\item The default setting for the \verb"e" toggle (warn about errors in + literate scripts) has been changed to \verb":set +e" for closer + compatibility with the literate script convention outline in the + Haskell report, version 1.2. In addition, the setting of the \verb"l" + toggle is now used only as a default if no particular type of + script file is specified by the file extension of a give script. + See Section 2.4 below for further details. + +\item The default setting for the \verb"f" toggle (terminate evaluation on + first error) has been changed to \verb":set +f". The old setting of + \verb":set -f" is, in my opinion, better for debugging purposes, but + does not give the behaviour that those using Haskell might + expect. This has caused a certain amount of confusion and was + the motivation for this change. + +\item The following three command line options, provided in previous + versions of Gofer, have now been removed: +\begin{verbatim} + TOGGLES: + a Use any evidence, not nec. best + E Fail silently if evidence not found + + OTHER OPTIONS: + xnum Set maximum depth for evidence search +\end{verbatim} + These options were only ever used for my own research and were + (intentionally) undocumented, so it seemed sensible to remove them + from the distributed system. A quick patch to the source code and + a recompilation is all that is necessary to reinstate these + options; useful if somebody out there found out about these + options and actually uses them (if you do, I'd love to know + why!). +\end{itemize} + +\subsection{Commands} +The full list of commands that can be used from within the Gofer +interpreter are summarized using the command \verb":?" as follows: +\begin{verbatim} + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + evaluate expression + :type print type of expression + :? display this list of commands + :set set command line options + :set help on command line options + :names [pat] list names currently in scope + :info describe named objects + :find edit file containing definition of name + :!command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? +\end{verbatim} +Almost all of these commands are the same as in the previous release. +The only new features are listed in the following sections. + + +\subsubsection{Shell escapes} +The shell escape command \verb":!" is used to enable you to run other programs +from within the Gofer interpreter. For example, on a Unix system, you +can print a list of all the files in the current directory by typing: +\begin{verbatim} + ? :!ls + + ? +\end{verbatim} +The same thing can be achieved on a PC running DOS by typing: +\begin{verbatim} + ? :!dir + + ? +\end{verbatim} +This is the same as in previous releases of Gofer; the only difference +is that there is no longer any need to type a space between the \verb":!" +command and the shell command that follows it. In fact, there is no +longer any need to type the leading colon either. Thus the two commands +above could equally well have been entered as: +\begin{verbatim} + !ls + !dir +\end{verbatim} +To start a new shell from within Gofer, you can use the command \verb":!" or the +abbreviated form \verb"!" -- in Unix and DOS you can return to the Gofer system +by entering the shell command `\verb"exit"'. This is likely to be different if +you use Gofer on other systems. + + +\subsubsection{Information about named values} +The \verb":info" command is a new feature which is useful for obtaining +information about the values currently loaded into a Gofer session. It +can be used to display information about all kinds of different values +including: +\begin{itemize} +\item Datatypes: The name of the datatype and a list of its associated + constructor functions is printed: +\begin{verbatim} + ? :info Request + -- type constructor + data Request + + -- constructors: + ReadFile :: String -> Request + WriteFile :: String -> String -> Request + AppendFile :: String -> String -> Request + ReadChan :: String -> Request + AppendChan :: String -> String -> Request + Echo :: Bool -> Request + GetArgs :: Request + GetProgName :: Request + GetEnv :: String -> Request +\end{verbatim} +\item Type synonyms: Prints the name and expansion of the synonym: +\begin{verbatim} + ? :info Dialogue + -- type constructor + type Dialogue = [Response] -> [Request] +\end{verbatim} + If the type synonym is restricted (see Section 3.1) then the + expansion is not included in the output: +\begin{verbatim} + ? :info Stack + -- type constructor + type Stack a = +\end{verbatim} +\item Type classes: Lists the type class name, superclasses, member + functions and instances: +\begin{verbatim} + ? :info Eq + -- type class + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + instance Eq Int + instance Eq Float + instance Eq Char + instance Eq a => Eq [a] + instance (Eq a, Eq b) => Eq (a,b) + instance Eq Bool +\end{verbatim} + Note that the member functions listed for the class include the + class predicate as part of the type; the output is not intended + to be thought of as a syntactically valid class declaration. + + Overlapping instance declarations (see Section 3.2) are listed in + increasing order of generality. + +\item Other values: for example, named functions and individual + constructor and member functions: +\begin{verbatim} + ? :info map : <= + map :: (a -> b) -> [a] -> [b] + + (:) :: a -> [a] -> [a] -- data constructor + + (<=) :: Ord a => a -> a -> Bool -- class member +\end{verbatim} +\end{itemize} +As the last example shows, the \verb":info" command can take several arguments +and prints out information about each in turn. A warning message is +displayed if there are no known references to an argument: +\begin{verbatim} + ? :info (:) + Unknown reference `(:)' +\end{verbatim} +This illustrates that the arguments are treated as textual names for +operators, not syntactic expressions (for example, identifiers). The +type of the \verb"(:)" operator can be obtained by giving the command \verb":info :" +as above. There is no provision for including wildcard characters of +any form in the arguments of :info commands. + +If a particular argument can be interpreted as, for example, a +constructor function, or a type constructor depending on context, both +possibilities are displayed. For example, loading a program containing +the definition: +\begin{verbatim} + data Set a = Set [a] +\end{verbatim} +We obtain: +\begin{verbatim} + ? :info Set + -- type constructor + data Set a + + -- constructors: + Set :: [a] -> Set a + + Set :: [a] -> Set a -- data constructor +\end{verbatim} +If no arguments are supplied to \verb":info", a list of all the script files +currently loaded into the interpreter will be displayed: +\begin{verbatim} + ? :info + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples +\end{verbatim} + + +\section{Literate scripts} +Support for literate scripts -- files in which program lines begin with +a `\verb">"' character and all other lines are treated as comments -- was +provided in previous versions of Gofer. The command line option +\verb":set +l" was used to force Gofer to treat each input file as a literate +script, while \verb":set -l" (the default) was used to treat each input file +as a standard script of definitions. + +In practice, this turned out to be somewhat inconvenient, particularly +when loading combinations of files, some as literate scripts, some +without. For example, quite a few people kept two versions of the +prelude, one as a literate script, one not, so that they wouldn't have +to fiddle with the settings or using the :set commands to load files. + +Gofer version 2.28 now uses a more sophisticated scheme to determine +how an input script file should be treated, based on the use of file +extensions. More specifically, any script file with a name ending in +one of the following suffixes: +\begin{verbatim} + .hs .has .gs .gof .prelude +\end{verbatim} +will always be loaded as a normal (i.e. non-literate) script file, +regardless of the setting of the l command line option. In a similar +way, files with names ending in one of the following suffixes: +\begin{verbatim} + .lgs .lhs .verb .lit +\end{verbatim} +will always be treated as literate scripts. The command line option l +is only used for files with names not ending in one of the above +suffixes. + +For example, the commands: +\begin{verbatim} + :set -l + :load prog1.gs prog2 prog3.lgs +\end{verbatim} +will load \verb"prog1.gs" and \verb"prog2" as non-literate scripts, and then load +\verb"prog3.lhs" as a literate script. + + +\subsection{Prelude files} +The Gofer system comes with a standard prelude, and a small number of +alternative preludes. These have always been there, but a lot of +people don't seem to have noticed these, so I thought I'd say a few +words about the different preludes included with Gofer: Remember that +you can always change the prelude you are using by setting the GOFER +environment variable or by modifying a startup script as described in +Section 2.1: +\begin{description} +\item[standard.prelude] The standard Gofer prelude, using type classes + and providing the familiar range of operators + and functions. + +\item[nofloat.prelude] A simplified version of the standard.prelude + which does not include any floating point + operators. This is likely to be of most use + for those using Gofer on PCs where memory is + at a premium; compiling a version of the + interpreter (or compiler runtime library) + without floating point support can give an + important saving. + +\item[simple.prelude] A prelude file based on the standard prelude + but without type classes. Let me emphasize + that point: {\em you can use Gofer without having + to learn about type classes}. Some people + seem to take to the use of type classes right + from the beginning. For those that have + problems understanding the technical details + or even the motivation, the \verb"simple.prelude" + can be used to get you familiar with the syntax + of the language and the basic principles. + Then you can move up to the \verb"standard.prelude" + when you're ready. The principle differences + can be described by listing the types of + commonly used operators in the \verb"simple.prelude": +\begin{verbatim} + (==) :: a -> a -> Bool + (<=) :: a -> a -> Bool + (<) :: a -> a -> Bool + (>=) :: a -> a -> Bool + (>) :: a -> a -> Bool + (/=) :: a -> a -> Bool + show :: a -> String + (+) :: Int -> Int -> Int + (-) :: Int -> Int -> Int + (*) :: Int -> Int -> Int + (/) :: Int -> Int -> Int +\end{verbatim} + The resulting language is closer to the system + in Bird and Wadler (and can be made closer + still by editing the \verb"simple.prelude" to use + \verb"zipwith" instead of \verb"zipWith" etc. + +\item[cc.prelude] An extended version of the \verb"standard.prelude" + including support for a number of useful + constructor classes. Most of the examples + and applications described in Section 4 are + based on this prelude. + +\item[min.prelude] A minimal prelude file. If you really want to + build a very small prelude for a particular + application, start with this and add the extra + things that you need. +\end{description} + +As you can see, the standard extension for prelude files is \verb".prelude" +and any file ending with this suffix will be read as a non-literate +script (as described in Section 2.4). Note that, even if you are using +a computer where the full name of a prelude file is not stored (for +example, on a DOS machine the \verb"standard.prelude" file becomes +\verb"STANDARD.PRE") you should still specify the prelude file by its full +name to ensure that the Gofer system treats it correctly as a prelude +file. + +You are also free to construct your own prelude files, typically by +modifying one of the supplied preludes described above. Anyone who +created prelude files for use with previous releases of Gofer will need +to edit these files to ensure that they will work correctly. Note in +particular that there is no longer any need to include definitions of +the I/O datatypes in programs. Furthermore, the error function should +now be bound to the primitive \verb"primError" rather than using the old +definition of \verb"error s | False = error s". + + +\section{Language differences} + +This section outlines a number of small differences and extensions to +the language used by Gofer. These features are not included in the +definition of Haskell, so you shouldn't be thinking that programs +written using these features can ultimately be used with a full Haskell +system. The use of constructor classes -- a more substantial change is +described in Section 4. + +\subsection{Restricted type synonyms} +Gofer 2.28 supports a form of restricted type synonym that can be used +to restrict the expansion of the synonym to a particular set of +functions. Outside of the selected group of functions, the synonym +constructor behaves like a standard datatype. More precisely, a +restricted type synonym definition is a top level declaration of the +form: +\begin{verbatim} + type T a1 ... am = rhs in f1, ..., fn +\end{verbatim} +where \verb"T" is the name of the restricted type synonym constructor and rhs +is a type expression typically involving some of the (distinct) type +variables \verb"a1", \dots, \verb"am". The same kind of restrictions that apply to +normal type synonym declarations are also applied here. The major +difference is that the expansion of the type synonym can only be used +within the binding group of one of the functions \verb"f1", \dots, \verb"fn" (all of +which must be defined by top-level definitions in the file containing +the restricted type synonym definition). In the definition of any +other function, the type constructor \verb"T" is treated as if it had been +introduced by a definition of the form: +\begin{verbatim} + data T a1 ... am = ... +\end{verbatim} +The original motivation for restricted type synonyms came from my work +with constructor classes as described in Section 4 and you will several +examples of this in the \verb"ccexamples.gs" file in the \verb"demos/Ccexamples" +directory of the standard distribution. For a simpler example, +consider the following definition of a datatype of stacks in terms of +the standard list type: +\begin{verbatim} + type Stack a = [a] in emptyStack, push, pop, top, isEmpty +\end{verbatim} +The definitions for the five functions named here are as follows: +\begin{verbatim} + emptyStack :: Stack a + emptyStack = [] + + push :: a -> Stack a -> Stack a + push = (:) + + pop :: Stack a -> Stack a + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top :: Stack a -> a + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty :: Stack a -> Bool + isEmpty = null +\end{verbatim} +The type signatures here are particularly important. For example, +since \verb"emptyStack" is mentioned in the definition of the restricted type +synonym Stack, the definition of \verb"emptyStack" is type correct. The +declared type for \verb"emptyStack" is \verb"Stack a" which can be expanded to \verb"[a]", +agreeing with the type for the empty list \verb"[]". However, in an expression +outside the binding group of these functions, the \verb"Stack a" type is quite +distinct from the \verb"[a]" type: +\begin{verbatim} + ? emptyStack ++ [1] + ERROR: Type error in application + *** expression : emptyStack ++ [1] + *** term : emptyStack + *** type : Stack a + *** does not match : [Int] +\end{verbatim} +The `binding group' of a value refers to the set of values whose +definitions are in the same mutually recursive group of bindings. In +particular, this does not extend to the type class system so we can +define instances such as: +\begin{verbatim} + instance Eq a => Eq (Stack a) where + s1 == s2 | isEmpty s1 = isEmpty s2 + | isEmpty s2 = isEmpty s1 + | otherwise = top s1 == top s2 && pop s1 == pop s2 +\end{verbatim} +As a convenience, Gofer allows the type signatures of functions +mentioned in the type synonym declaration to be specified within the +definition rather than in a different point in the script. Thus the +example above could equally well have been written as: +\begin{verbatim} + type Stack a = [a] in + emptyStack :: Stack a, + push :: a -> Stack a -> Stack a, + pop :: Stack a -> Stack a, + top :: Stack a -> a, + isEmpty :: Stack a -> Bool + + emptyStack = [] + + push = (:) + + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty = null +\end{verbatim} +However, the first form is necessary when you want to define two or +more restricted type synonyms simultaneously. For example: +\begin{verbatim} + type Pointer = Int in allocate, deref, assign + type Heap a = [a] in newHeap, allocate, deref, assign + newHeap :: Heap a + allocate :: Heap a -> (Heap a, Pointer) + deref :: Heap a -> Pointer -> a + assign :: Heap a -> Pointer -> a -> Heap a + etc ... +\end{verbatim} +The use of restricted type synonyms doesn't quite provide proper +abstract data types. For example, if you try: +\begin{verbatim} + ? push 1 emptyStack + [1] + (5 reductions, 11 cells) +\end{verbatim} +then the structure of the stack as a list of values is revealed by the +printing mechanism. This happens because Gofer uses the \verb"show'" function +to print out a value (in this case of type \verb"Stack Int") which looks inside +the structure of the object to see how it is represented. This happens +to be most convenient for use in an interpreter as an aid to debugging. +For the purists (and the preservation of abstraction), Gofer could be +modified to apply the (overloaded) show function to printed values. +This would force the programmer to define the way in which stack values +are printed (distinct from lists) and preserve the abstraction. Without +having set up this machinery, we get: +\begin{verbatim} + ? show (push 1 emptyStack) + ERROR: Cannot derive instance in expression + *** Expression : show (push 1 emptyStack) + *** Required instance : Text (Stack Int) +\end{verbatim} +The Gofer compiler described in Section 5 does not implement show' and +hence enforces the abstraction. + + +\subsection{Overlapping instance declarations} +This section describes a somewhat technical extension, aimed at those +who work with type classes. Many readers may prefer to skip to the +next section at this point. + +The definition of Haskell and previous versions of Gofer insist that no +two instance declarations for a given class may contain overlapping +predicates. Thus the declarations: +\begin{verbatim} + class CX a where c :: a -> Int + + instance CX (a,Int) where c (x,y) = y + instance CX (Int,a) where c (x,y) = x +\end{verbatim} +are not allowed because the two predicates overlap: +\begin{verbatim} + ERROR "misctest" (line 346): Overlapping instances for class "CX" + *** This instance : CX (Int,a) + *** Overlaps with : CX (a,Int) + *** Common instance : CX (Int,Int) +\end{verbatim} +As the error message indicates, given an expression \verb"c (1,2)" it is not +clear whether we should use the first or the second instance +declarations to evaluate this, with potentially different results, \verb"2" or +\verb"1" respectively. + +On the other hand, there are cases where this sort of thing might be +quite reasonable. For example, the standard function show prints lists +of characters as strings, but any other kind of list is printed using +the \verb"[" \dots \verb"]" notation with the items separated by commas: +\begin{verbatim} + ? show "Hello" + "Hello" + ? show [True,False,True] + [True,False,True] + ? show [1..10] + [1,2,3,4,5,6,7,8,9,10] + ? +\end{verbatim} +Haskell deals with this by an encoding using the showList function, but +a more obvious approach might be to define two instances: +\begin{verbatim} + instance Text a => Text [a] where ... print using [ ... ] notation + instance Text [Char] where ... print as string +\end{verbatim} +Other examples might include providing optimized versions of primitives +for particular frequently use operators, or providing a default +behaviour as in: +\begin{verbatim} + class Eq a where (==) = error "no definition of equality specified" +\end{verbatim} +Haskell requires the context of an overloaded function to be reduced to +a form where the only predicates that it contains are of the form \verb"C a". +This means that the inferred type of an object may be simplified before +the full type of that object is known. For example, we might define a +function: +\begin{verbatim} + f x = show [x,x] +\end{verbatim} +The inferred type in Haskell is \verb"f :: Text a => a -> String" and the +decision about which of the two instance declarations above should be +used has already been forced on us. To see this, note that \verb"f 'a'" would +evaluate to the string \verb/"['a', 'a']"/. But if we allowed the second +instance declaration above to be used, show \verb"['a', 'a']" would evaluate +to \verb/"aa"/. This breaks a fundamental property of the language where we +expect to be able to replace one subexpression with another equal term +and obtain the same result. + +In Gofer, the type system is a little different and the inferred type +is \verb"f :: Text [a] => a -> String." The decision about which instance +declaration to use is postponed until the type assigned to \verb"'a'" is +known. Thus both \verb"f 'a'" and \verb"show ['a', 'a']" evaluate to \verb/"aa"/ without +any contradiction. + +Although the type system in Gofer has always been able to support the +use of certain overlapping instance declarations, previous versions of +the system imposed stronger static restrictions which prohibited their +use. Gofer 2.28 relaxes these restrictions by allowing a program to +contain overlapping instance declarations so long as: +\begin{itemize} +\item One of the instance predicates being declared is a substitution + instance of the other. Thus: +\begin{verbatim} + instance Eq [Char] where ... -- OK + instance Eq a => Eq [a] where ... +\end{verbatim} + is permitted because the second predicate, \verb"Eq [a]", is more general + than the first, \verb"Eq [Char]", which can be obtained by substituting + Char for the type variable \verb"a". However, the example at the + beginning of this section: +\begin{verbatim} + instance CX (a,Int) where ... -- ILLEGAL + instance CX (Int,a) where ... +\end{verbatim} + is not allowed since neither \verb"(a,Int)" or \verb"(Int,a)" is a substitution + instance of the other (even though they have a common instance + \verb"(Int,Int)"). + +\item The two instances declared are not identical. This rules out + examples like: +\begin{verbatim} + instance Eq Char where ... -- ILLEGAL + instance Eq Char where ... +\end{verbatim} +\end{itemize} +The features described here are added principally for experimentation. +I have some particular applications that I want to try out (which is +why I actually implemented these ideas) but I would also be very +interested to hear from anyone else that makes use of this extension. + + +\subsection{Parsing Haskell syntax} +From correspondence that I have received, quite a few people use Gofer +to develop programs which, ultimately, will be compiled and executed +using a Haskell system. Although the syntax of the two languages is +quite similar, it has been necessary to comment out module headers and +other constructs in Haskell programs before they could be used with +previous version of Gofer. + +The new version of the Gofer system is now able to parse these +additional constructs (and will generate an error message if a syntax +error occurs). However: {\em no attempt is made to interpret or use the +information provided by these additional constructs}. This feature is +provided purely for the convenience of those people using Gofer and +Haskell in the manner described above. Gofer does not currently +support any notion of modules beyond the use of separate script files. + +The following changes have been made: +\begin{itemize} +\item The identifiers: +\begin{verbatim} + deriving default module interface + import renaming hiding to +\end{verbatim} + are now reserved words in Gofer. Any program that uses one of + these as an identifier with an older version of Gofer will need + to be modified to use a different name instead. + +\item Module headers and import declarations may be included in a Gofer + program using the syntax set out in version 1.2 of the Haskell + report. Several modules may be included in a single file (but of + course, Gofer makes no distinction between the sections of code + appearing in different `modules'). + +\item Datatype definitions may include \verb"deriving" clauses such as: +\begin{verbatim} + data Maybe a = Just a | Nothing deriving (Eq, Text) +\end{verbatim} + although no derived instances will actually be generated. + If you need these facilities, you might consider writing out + the instances of the type classes concerned yourself in a + separate file which can be loaded when you run your program + with Gofer, but which are omitted when you compile it with a + proper Haskell system. + +\item Programs may include default declarations, although, once again, + these are ignored; for example, there is no restriction on the + forms of type that can be included in a default declaration, nor + will an error occur if a single module includes multiple default + declarations. +\end{itemize} + +\subsection{Local definitions in comprehensions} +We all make mistakes. The syntax for Gofer currently permits a local +definition to appear in a list comprehension (and indeed, in the monad +comprehensions described in the next section): +\begin{verbatim} + [ (x,y) | x <- xs, y = f x, p y ] +\end{verbatim} +This example is implemented by translating it to something equivalent +to: +\begin{verbatim} + map h xs where h [] = [] + h (x:xs) = let y = f x + in if p y then (x,y) : h xs + else h xs +\end{verbatim} +It is cumbersome to rewrite this using list comprehensions without +local definitions: +\begin{verbatim} + concat [ let y = f x in [ (x,y) | p y ] | x <- xs ] +\end{verbatim} +so we might resort to the `hack' of writing: +\begin{verbatim} + [ y | x <- xs, y <- [f x], p y ] +\end{verbatim} +which works (but doesn't extend to recursive bindings, and is really an +inappropriate use for a list; a list is used to represent a sequence of +zero or more objects, so using a list when you know that there is +always going to be exactly one element seems unnecessary). So, to +summarize, I still think that local definitions can be useful in +comprehensions. + +So where is the mistake I mentioned? The problem is with the {\em syntax}. +First, it is rather easy to confuse the comprehension above with the +comprehension: +\begin{verbatim} + [ (x,y) | x <- xs, y == f x, p y ], +\end{verbatim} +leading to errors which are hard to detect. The second is that the +syntax is too restrictive; you can only give relatively simple local +declarations -- mutually recursive definitions and function bindings +are not permitted. + +Gofer 2.28 now supports a new syntax for local definitions in +comprehensions. The old syntax is still supported, for compatibility +with previous releases, but will be deleted in the next public release +(assuming I remember). Local declarations can now be included in a +comprehension using a qualifier of the form \verb"let { decls }". So the +comprehension at the beginning of this section can also be written: +\begin{verbatim} + [ (x,y) | x <- xs, let {y = f x}, p y ] +\end{verbatim} +Note that the braces cannot usually be omitted in Gofer due to an +undocumented extension to the syntax of Gofer function declarations. +The braces would not be needed if this syntax were added to a standard +Haskell system. + +This extension means that it is now possible to write comprehensions +such as: +\begin{verbatim} + [ (x,y,z) | x <- xs, let { y = f x z; + z = g x y; + f n = h n [] }, p x y z ] +\end{verbatim} +Once again, this is still an experimental feature. I suspect it will +be of most use to anyone making substantial use of monad comprehensions +as described in the next section. + + +\section{Constructor classes} + +{\sl [This is a long section; if you are not interested in experimenting +with Gofer's system of constructor classes, you can skip straight ahead +to the next section without missing anything. Of course, if you don't +know what a constructor class is, you might want to read at least some +of this section before you can make that decision.]} + +One of the biggest changes in Gofer version 2.28 is the provision of +support for constructor classes. This section provides an overview of +constructor classes which should hopefully, in conjunction with the +example supplied with the full distribution, be enough to get you +started. More technical details about constructor classes can be +obtained by contacting me. + +Some of the following introduction here (particularly sections 4.1 and +4.2) may seem somewhat familiar to those of you have already read one +of the papers that I have written on the subject although I have added +some more information about the Gofer implementation. + +Others may find that this section of the documentation seems rather +technical; try not to be put off at first sight. Looking through the +examples and the documentation, you may find it is easier to understand +than you expect! + +A final comment before starting: there is, as yet, no strong consensus +on the names and syntax that would be best for monad operations, +comprehensions etc. If you have any opinions, or proposals which +differ from what you see here, please let me know\dots\ I'd be very +interested to hear other people's opinions on this. + + +\subsection{An overloaded map function} +Many functional programs use the \verb"map" function to apply a function to +each of the elements in a given list. The type and definition of this +function as given in the Gofer standard prelude are as follows: +\begin{verbatim} + map :: (a -> b) -> ([a] -> [b]) + map f [] = [] + map f (x:xs) = f x : map f xs +\end{verbatim} +It is well known that the \verb"map" function satisfies the familiar laws: +\begin{verbatim} + map id = id + map f . map g = map (f . g) +\end{verbatim} +A category theorist will recognize these observations as indicating +that there is a functor from types to types whose object part maps any +given type a to the list type \verb"[a]" and whose arrow part maps each +function \verb"f::a -> b" to the function \verb"map f :: [a] -> [b]". A functional +programmer will recognize that similar constructions are also used with +a wide range of other data types, as illustrated by the following +examples: +\begin{verbatim} + data Tree a = Leaf a | Tree a :^: Tree a + + mapTree :: (a -> b) -> (Tree a -> Tree b) + mapTree f (Leaf x) = Leaf (f x) + mapTree f (l :^: r) = mapTree f l :^: mapTree f r + + data Maybe a = Just a | Nothing + + mapMaybe :: (a -> b) -> (Maybe a -> Maybe b) + mapMaybe f (Just x) = Just (f x) + mapMaybe f Nothing = Nothing +\end{verbatim} +Each of these functions has a similar type to that of the original \verb"map" +and also satisfies the functor laws given above. With this in mind, it +seems a shame that we have to use different names for each of these +variants. +A more attractive solution would allow the use of a single name \verb"map", +relying on the types of the objects involved to determine which +particular version of the \verb"map" function is required in a given +situation. For example, it is clear that \verb"map (1+) [1,2,3]" should be +a list, calculated using the original \verb"map" function on lists, while +\verb"map (1+) (Just 1)" should evaluate to \verb"Just 2" using \verb"mapMaybe". + +Unfortunately, in a language using standard Hindley/Milner type +inference, there is no way to assign a type to the \verb"map" function that +would allow it to be used in this way. Furthermore, even if typing +were not an issue, use of the map function would be rather limited +unless some additional mechanism was provided to allow the definition +to be extended to include new datatypes perhaps distributed across a +number of distinct program files. + + +\subsubsection{An attempt to define map using type classes} +The ability to use a single function symbol with an interpretation that +depends on the type of its arguments is commonly known as overloading. +In Gofer, overloading is implemented using type classes -- which can be +thought of as sets of types. For example, the \verb"Eq" class defined by: +\begin{verbatim} + class Eq a where + (==), (/=) :: a -> a -> Bool +\end{verbatim} +(together with an appropriate set of instance declarations) is used to +describe the set of types whose elements can be compared for equality. +The standard prelude for Gofer includes integers, floating point +numbers, characters, booleans, lists (in which the type of the members +is also in \verb"Eq") and so forth. There is no need for all the definitions +of equality to be combined in a single script file; new definitions of +equality are typically included each time a new datatype is defined. + +Functions such as \verb"nub", defined in the standard prelude as: +\begin{verbatim} + nub :: Eq a => [a] -> [a] -- remove duplicates from list + nub [] = [] + nub (x:xs) = x : nub (filter (x/=) xs) +\end{verbatim} +can be used with any choice of type for the type variable a so long as +it is an instance of \verb"Eq". Only a single definition of the \verb"nub" function +is required. + +Unfortunately, the system of type classes is not sufficiently powerful +to give a satisfactory treatment for the map function; to do so would +require a class \verb"Map" and a type expression \verb"m(t)" involving the type +variable \verb"t" such that \verb"S = { m(t) | t is a member of Map }" includes (at +least) the types: +\begin{verbatim} + { (a -> b) -> ([a] -> [b]), + (a -> b) -> (Tree a -> Tree b), + (a -> b) -> (Maybe a -> Maybe b), .... + | a and b arbitrary types } +\end{verbatim} +The only possibility is to take \verb"m(t)" = \verb"t" and choose \verb"Map" as the set of +types \verb"S" for which the map function is required: +\begin{verbatim} + class Map t where map :: t + + instance Map ((a -> b) -> ([a] -> [b])) where ... + instance Map ((a -> b) -> (Tree a -> Tree b)) where ... + instance Map ((a -> b) -> (Maybe a -> Maybe b)) where ... +\end{verbatim} +This syntax is permitted in Gofer (but not in Haskell) but it does not +give a sufficiently accurate characterization of the type of map to be +of much use. For example, the principal type of \verb"\i j -> map j . map i" +is: +\begin{verbatim} + (Map (a -> c -> e), Map (b -> e -> d)) => a -> b -> c -> d +\end{verbatim} +(\verb"a" and \verb"b" are the types of \verb"i" and \verb"j" respectively). This is complicated +and does not enforce the condition that \verb"i" and \verb"j" have function types. +Furthermore, the type is ambiguous (the type variable \verb"e" does not appear +to the right of the \verb"=>" symbol or in the assumptions). Under these +conditions, we cannot guarantee a well-defined semantics for this +expression. Other attempts to define the map function, for example +using multiple parameter type classes, have also failed for essentially +the same reasons. + + +\subsubsection{A solution using constructor classes} +A much better approach is to notice that each of the types for which +the map function is required is of the form: +\begin{verbatim} + (a -> b) -> (f a -> f b). +\end{verbatim} +The variables a and b here represent arbitrary types while f ranges +over the set of type constructors for which a suitable map function has +been defined. In particular, we would expect to include the list +constructor (which we write as \verb"[]" in Gofer), \verb"Tree" and \verb"Maybe" as elements +of this set. Motivated by our earlier comments we will call this set +\verb"Functor". With only a small extension to the Gofer syntax for type +classes this can be described by: +\begin{verbatim} + class Functor f where + map :: (a -> b) -> (f a -> f b) + + instance Functor [] where + map f [] = [] + map f (x:xs) = f x : map f xs + + instance Functor Tree where + map f (Leaf a) = Leaf (f a) + map f (l :^: r) = map f l :^: map f r + + instance Functor Maybe where + map f (Just x) = Just (f x) + map f Nothing = Nothing +\end{verbatim} +\verb"Functor" is our first example of a constructor class. The following +extract illustrates how the definitions for \verb"Functor" work in practice: +\begin{verbatim} + ? map (1+) [1,2,3] + [2, 3, 4] + (15 reductions, 44 cells) + ? map (1+) (Leaf 1 :^: Leaf 2) + Leaf 2 :^: Leaf 3 + (10 reductions, 46 cells) + ? map (1+) (Just 1) + Just 2 + (4 reductions, 17 cells) + ? +\end{verbatim} +Furthermore, by specifying the type of map function more precisely, +we avoid the ambiguity problems mentioned above. For example, the +principal type of \verb"\i j -> map j . map i" is simply: +\begin{verbatim} + Functor f => (a -> b) -> (b -> c) -> f a -> f c +\end{verbatim} +which is not ambiguous, and makes the types of \verb"i" and \verb"j" as \verb"(a -> b)" +and \verb"(b -> c)" respectively. + +[You can try these examples yourself using the Gofer system. The first +thing you need to do is start Gofer using the file \verb"cc.prelude" instead +of the usual Gofer \verb"standard.prelude". The \verb"cc.prelude" includes the +definition of the \verb"functor" class and the instance for \verb"Functor []". The +remaining two instance declarations are included (along with lots of +other examples) in the file \verb"ccexamples.gs" in the \verb"demos/Ccexamples" +subdirectory of the standard distribution.] + + +\subsubsection{The kind system} +Each instance of \verb"Functor" can be thought of as a function from types to +types. It would be nonsense to allow the type \verb"Int" of integers to be an +instance of \verb"Functor", since the type \verb"(a -> b) ->(Int a -> Int b)" is +obviously not well-formed. To avoid unwanted cases like this, we have +to ensure that all of the elements in any given class are of the same +kind. + +To do this, we formalize the notion of kind, writing \verb"*" for the kind of +all types and \verb"k1 -> k2" for the kind of a constructor which takes +something of kind \verb"k1" and returns something of kind \verb"k2". This notion +comes is motivated by some theoretical work by Henk Barendregt on the +subject of `Generalized type systems'; do not confuse this with the use +of the symbol \verb"*" in a certain well-known functional language where it +represents a type variable. These things are completely different! + +Rather than thinking only of types we work with constructors which +include types as a special case. Constructors take the form: +\begin{verbatim} + Constructor ::= ConstructorConstant + | Constructor1 Constructor2 + | variable +\end{verbatim} +This corresponds very closely to the way that most type expressions +are already written in Gofer. For example, Tree a is an application +of the constructor constant \verb"Tree" to the variable \verb"a". Gofer has some +special syntax for tuple, list and function types. The corresponding +constructors can also be written directly in Gofer. For example: +\begin{verbatim} + a -> b = (->) a b + [a] = [] a + (a,b) = (,) a b + (a,b,c) = (,,) a b c + etc ... +\end{verbatim} +Each constructor constant has a corresponding kind. For example: +\begin{verbatim} + Int, Float, () :: * + [], Tree, Maybe :: * -> * + (->), (,) :: * -> * -> * + (,,) :: * -> * -> * -> * +\end{verbatim} +Applying one constructor \verb"C :: k1 -> k2" to a construct \verb"C' :: k1" gives +a constructor expression \verb"C C'" with kind \verb"k2". Notice that this is just +the same sort of thing you would expect from applying a function of +type \verb"a -> b" to an value of type \verb"b"; kinds really are very much like +`types for constructors'. + +Instead of checking that type expressions contain the correct number of +arguments for each type constructor, we need to check that any type +expression has kind \verb"*". In a similar way, all of the elements of a +constructor class must have the same kind; for example, a constructor +class constraint of the form \verb"Functor f" is only valid if \verb"f" is a +constructor expression of kind \verb"* -> *". Note also that our system +includes Gofer/Haskell type classes as a special case; a type class is +simply a constructor class for which each instance has kind \verb"*". Multiple +parameter classes can also be dealt with in the same way, using a tuple +of kinds \verb"(k1,...,kn)" to indicate the kind of constructors required for +each argument. + +The language of constructors is essentially a system of combinators +without any reduction rules. As such, standard techniques can be +used to infer the kinds of constructor variables, constructor constants +introduced by new datatype definitions and the kind of the elements +held in any particular constructor class. The important point is that +there is no need -- and indeed, in our current implementation, no +opportunity -- for the programmer to supply kind information +explicitly. We regard this as a significant advantage since it means +that the programmer can avoid much of the complexity that might +otherwise result from the need to annotate type expressions with +kinds. + + +\subsection{Monads as an application of constructor classes} +Motivated by the work of Moggi and Spivey, Wadler has proposed a style +of functional programming based on the use of monads. While the theory +of monads had already been widely studied in the context of abstract +category theory, Wadler introduced the idea that monads could be used +as a practical method for modeling so-called `impure' features in a +purely functional programming language. + +The examples in this and following sections illustrate that the use of +constructor classes can be particularly convenient for programming in +this style. You will also find a lot more examples prepared for use +with Gofer in the file \verb"ccexamples" in the \verb"demos/Ccexamples" subdirectory +of the standard distribution. + + +\subsubsection{A framework for programming with monads} +The basic motivation for the use of monads is the need to distinguish +between computations and the values that they produce. If \verb"m" is a monad +then an object of type \verb"(m a)" represents a computation which is expected +to produce a value of type \verb"a". These types reflect the fact that the +use of particular programming language features in a given calculation +is a property of the computation itself and not of the result that it +produces. + +Taking the approach outlined by Wadler in his paper `The Essence of +Functional Programming' (POPL '92), we introduce a constructor class of +monads using the definition: +\begin{verbatim} + class Functor m => Monad m where + result :: a -> m a + join :: m (m a) -> m a + bind :: m a -> (a -> m b) -> m b + + join x = bind x id + x `bind` f = join (map f x) +\end{verbatim} +The expression \verb"Functor m => Monad m" defines \verb"Monad" as a subclass of +\verb"Functor" ensuring that, for any given monad, there will also be a +corresponding instance of the overloaded \verb"map" function. The use of a +hierarchy of classes enables us to capture the fact that not every +instance of Functor can be treated as an instance of \verb"Monad" in any +natural way. + +[If you are familiar with either my previous papers or Wadler's +writings on the use of monads, you might notice that the declaration +above uses the name `result' in place of `return' or `unit' that have +been previously used for the same thing. The latter two choices have +been used elsewhere for rather different purposes, and there is +currently no clear picture of which names should be used. The +identifier `result' is the latest in a long line of attempts to find a +name which both conveys the appropriate meaning and is not already in +use for other applications.] + +By including default definitions for bind and join we only need to give +a definition for one of these (in addition to a definition for result) +to completely define an instance of \verb"Monad". This is often quite +convenient. On the other hand, it would be an error to omit +definitions for both operators since the default definitions are +clearly circular. We should also mention that the member functions in +an instance of \verb"Monad" are expected to satisfy a number of laws which are +not reflected in the class definition above. + +The following declaration defines the standard monad structure for the +list constructor \verb"[]" which can be used to describe computations +producing multiple results, corresponding to a simple form of +non-determinism: +\begin{verbatim} + instance Monad [] where + result x = [x] + [] `bind` f = [] + (x:xs) `bind` f = f x ++ (xs `bind` f) +\end{verbatim} +As a second example, the monad structure for the \verb"Maybe" datatype, which +might be used to describe computations which fail to produce any value +at all if an error condition occurs, can be described by: +\begin{verbatim} + instance Monad Maybe where + result x = Just x + Just x `bind` f = f x + Nothing `bind` f = Nothing +\end{verbatim} +Another interesting use of monads is to model programs that make use of +an internal state. Computations of this kind can be represented by +functions of type \verb"s-> (a,s)" (often referred to as state transformers) +mapping an initial state to a pair containing the result and final +state. In order to get this into the appropriate form for the Gofer +system of constructor classes, we introduce a new datatype: +\begin{verbatim} + data State s a = ST (s -> (a,s)) +\end{verbatim} +The functor and monad structures for state transformers are as follows: +\begin{verbatim} + instance Functor (State s) where + map f (ST st) = ST (\s -> let (x,s') = st s in (f x, s')) + + instance Monad (State s) where + result x = ST (\s -> (x,s)) + ST m `bind` f = ST (\s -> let (x,s') = m s + ST f' = f x + in f' s') +\end{verbatim} +Notice that the \verb"State" constructor has kind \verb"* -> * -> *" and that the +declarations above define \verb"State s" as a monad and functor for any state +type \verb"s" (and hence \verb"State s" has kind \verb"* -> *" as required for an instance +of these classes). There is no need to assume a fixed state type. + +>From a user's point of view, the most interesting properties of a monad +are described, not by the \verb"result", \verb"bind" and \verb"join" operators, but by the +additional operations that it supports. The following examples are +often useful when working with state monads. The first can be used to +`run' a program given an initial state and discarding the final state, +while the second might be used to implement an integer counter in a +\verb"State Int" monad: +\begin{verbatim} + startingWith :: State s a -> s -> a + ST m `startingWith` s0 = result where (result,_) = m s0 + incr :: State Int Int + incr = ST (\s -> (s,s+1)) +\end{verbatim} +To illustrate the use of state monads, consider the task of labeling +each of the nodes in a binary tree with distinct integer values. One +simple definition is: +\begin{verbatim} + label :: Tree a -> Tree (a,Int) + label tree = fst (lab tree 0) + where lab (Leaf n) c = (Leaf (n,c), c+1) + lab (l :^: r) c = (l' :^: r', c'') + where (l',c') = lab l c + (r',c'') = lab r c' +\end{verbatim} +This uses an explicit counter (represented by the second parameter to +\verb"lab") and great care must be taken to ensure that the appropriate +counter value is used in each part of the program; simple errors, such +as writing \verb"c" in place of \verb"c'" in the last line, are easily made but can +be hard to detect. + +An alternative definition, using a state monad and following the +layout suggested in Wadler's POPL paper, can be written as follows: +\begin{verbatim} + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = incr `bind` \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l `bind` \l' -> + lab r `bind` \r' -> + result (l' :^: r') +\end{verbatim} +While this program is perhaps a little longer than the previous +version, the use of monad operations ensures that the correct counter +value is passed from one part of the program to the next. There is no +need to mention explicitly that a state monad is required: The use of +\verb"startingWith" and the initial value \verb"0" (or indeed, the use of \verb"incr" on its +own) are sufficient to determine the monad \verb"State Int" needed for the +bind and result operators. It is not necessary to distinguish between +different versions of the monad operators bind, result and join or to +rely on explicit type declarations. + + +\subsubsection{Monad comprehensions} +Several functional programming languages provide support for list +comprehensions, enabling some common forms of computation with lists to +be written in a concise form resembling the standard syntax for set +comprehensions in mathematics. In his paper `Comprehending Monads' +(ACM Lisp and Functional Programming, 1990), Wadler made the +observation that the comprehension notation can be generalized to +arbitrary monads, of which the list constructor is just one special +case. + +In Wadler's notation, a monad comprehension is written using the syntax +of a list comprehension but with a superscript to indicate the monad in +which the comprehension is to be interpreted. This is a little awkward +and makes the notation less powerful than might be hoped since each +comprehension is restricted to a particular monad. Using the +overloaded operators described in the previous section, Gofer provides +a more flexible form of monad comprehension which relies on overloading +rather than superscripts. At the time of writing, this is the only +concrete implementation of monad comprehensions known to us. + +In our system, a monad comprehension is an expression of the form +\verb"[e | qs ]" where \verb"e" is an expression and \verb"gs" is a list of generators of +the form \verb"p <- exp". As a special case, if \verb"gs" is empty then the +comprehension \verb"[ e | qs ]" is written as \verb"[ e ]". The implementation of +monad comprehensions is based on the following translation of the +comprehension notation in terms of the result and bind operators +described in the previous section: +\begin{verbatim} + [ e ] = result e + [ e | p <- exp, qs ] = exp `bind` \p -> [ e | qs ] +\end{verbatim} +In this notation, the label function from the previous section can +be rewritten as: +\begin{verbatim} + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = [ Leaf (n,c) | c <- incr ] + lab (l :^: r) = [ l :^: r | l <- lab l, r <- lab r ] +\end{verbatim} +Applying the translation rules for monad comprehensions to this +definition yields the previous definition in terms of result and bind. +The principal advantage of the comprehension syntax is that it is often +more concise and, in the author's opinion, sometimes more attractive. + + +\subsubsection{Monads with a zero} +Assuming that you are familiar with Gofer's list comprehensions, you +will know that it is also possible to include boolean guards in +addition to generators in the definition of a list comprehension. Once +again, Wadler showed that this was also possible in the more general +setting of monad comprehensions, so long as we restrict such +comprehensions to monads that include a special element zero satisfying +a small number of laws. This can be dealt with in our framework by +defining a subclass of \verb"Monad": +\begin{verbatim} + class Monad m => Monad0 m where + zero :: m a +\end{verbatim} +For example, the \verb"List" monad has the empty list as a zero element: +\begin{verbatim} + instance Monad0 [] where zero = [] +\end{verbatim} +Note that not there are also some monads which do not have a zero +element and hence cannot be defined as instances of \verb"Monad0". The +\verb"State s" monads described in Section 4.2.1 are a simple example of +this. + +Working in a monad with a zero, a comprehension involving a boolean +guard can be implemented using the translation: +\begin{verbatim} + [ e | guard, qs ] = if guard then [ e | qs ] else zero +\end{verbatim} +Notice that, as far as the type system is concerned, the use of +zero in the translation of a comprehension involving a guard automatically +captures the restriction to monads with a zero: +\begin{verbatim} + ? :t \x p -> [ x | p x ] + \x p -> [ x | p x ] :: Monad0 b => a -> (a -> Bool) -> b a + ? +\end{verbatim} +The inclusion of a zero element also allows a slightly different +translation for generators in comprehensions: +\begin{verbatim} + [ e | p <- exp, qs ] = exp `bind` f + where f p = [ e | qs ] + f _ = zero +\end{verbatim} +This corresponds directly to the semantics of standard Gofer list +comprehensions, but only differs from the semantics of the translation +given in the previous section when \verb"p" is an irrefutable pattern; i.e. +when \verb"p" is a pattern which may not match the value (or values) generated +by \verb"exp". You can see the difference by trying the following example +in Gofer: +\begin{verbatim} + ? [ x | [x] <- [[1],[],[2]]] + [1, 2] + (9 reductions, 31 cells) + ? map (\[x] -> x) [[1],[],[2]] + [1, + Program error: {v157 []} + (8 reductions, 66 cells) +\end{verbatim} +In order to retain compatibility with the standard list comprehension +notation, Gofer always uses the second translation above for generators +if the pattern \verb"p" is refutable. This may sometimes give inferred types +which are more restrictive than you expect. For example, tuples are +not irrefutable patterns in Gofer or Haskell, and so the function: +\begin{verbatim} + ? :t \xs -> [ x | (x,y) <- xs ] + \xs -> [ x | (x,y)<-xs ] :: Monad0 a => a (b,c) -> a b + ? +\end{verbatim} +is restricted to monads with a zero because the expanded translation +above is used. You can always avoid this problem by using the lazy +pattern construct (i.e. the tilde operator, \verb"~p") as in: +\begin{verbatim} + ? :t \xs -> [ x | ~(x,y) <- xs ] + \xs -> [ x | ~(x,y)<-xs ] :: Monad a => a (b,c) -> a b + ? +\end{verbatim} +[At one stage, I was using a different form of brackets to represent +monad comprehensions, implemented using the original translation to +avoid changing the semantics of list comprehensions. But I finally +decided that it would be better to use standard comprehension notation +with lazy pattern annotations where necessary since this is less +cumbersome than writing \verb"\xs -> [| x | (x,y) <- xs |]" in place of the +comprehension above. Please let me know what you think!] + + +\subsubsection{Generic operations on monads} +The combination of polymorphism and constructor classes in our system +makes it possible to define generic functions which can be used on a +wide range of different monads. A simple example of this is the +`Kleisli composition' for an arbitrary monad, similar to the usual +composition of functions except that it also takes care of `side +effects'. The general definition is as follows: +\begin{verbatim} + (@@) :: Monad m => (a -> m b) -> (c -> m a) -> (c -> m b) + f @@ g = join . map f . g +\end{verbatim} +For example, in a monad of the form \verb"State s", the expression \verb"f @@ g" +denotes a state transformer in which the final state of the computation +associated with \verb"g" is used as the initial state for the computation +associated with \verb"f". More precisely, for this particular kind of monad, +the general definition given above is equivalent to: +\begin{verbatim} + (@@) :: (b -> State s c) -> (a -> State s b) -> (a -> State s c) + f @@ g = \a -> STM (\s0 -> let ST g' = g a + (b,s1) = g' s0 + ST f' = f b + (c,s2) = f' s1 + in (c,s2)) +\end{verbatim} +The biggest advantage of the generic definition is that there is no +need to construct new definitions of \verb"(@@)" for every different monad. +On the other hand, if specific definitions were required for some +instances, perhaps in the interests of efficiency, we could simply +include \verb"(@@)" as a member function of \verb"Monad" and use the generic +definition as a default implementation. + +Generic operations can also be defined using the comprehension +notation: +\begin{verbatim} + mapl :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapl f [] = [ [] ] + mapl f (x:xs) = [ y:ys | y <- f x, ys <- mapl f xs ] +\end{verbatim} +This is the same as mapping a function down the elements of a list +using the normal map function except that, in the presence of side +effects, the order in which the applications are carried out is +important. For \verb"mapl", we start on the left (i.e. the front of the list) +and work towards the right. There is a corresponding dual which works +in the reverse direction: +\begin{verbatim} + mapr :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapr f [] = [ [] ] + mapr f (x:xs) = [ y:ys | ys <- mapr f xs, y <- f x ] +\end{verbatim} +These general functions have applications in several kinds of monad +with examples involving state and output. + +The comprehension notation can also be used to define a generalization +of Haskell's filter function which works in an arbitrary monad with a +zero: +\begin{verbatim} + filter :: Monad0 m => (a -> Bool) -> m a -> m a + filter p xs = [ x | x<-xs, p x ] +\end{verbatim} +There are many other general purpose functions that can be defined +in the current framework and used in arbitrary monads. To give you +some further examples, here are generalized versions of the foldl and +foldr functions which work in an arbitrary monad: +\begin{verbatim} + mfoldl :: Monad m => (a -> b -> m a) -> a -> [b] -> m a + mfoldl f a [] = result a + mfoldl f a (x:xs) = f a x `bind` (\fax -> mfoldl f fax xs) + + mfoldr :: Monad m => (a -> b -> m b) -> b -> [a] -> m b + mfoldr f a [] = result a + mfoldr f a (x:xs) = mfoldr f a xs `bind` (\y -> f x y) +\end{verbatim} +[Generalizing these definitions (and those of \verb"mapl", \verb"mapr") to work with +a second arbitrary monad (in place of the list monad) is left as an +entertaining exercise for the reader :--)] + +As a final example, here is a definition of a `while' loop for an +arbitrary monad: +\begin{verbatim} + while :: Monad m => m Bool -> m b -> m () + while c s = c `bind` \b -> + if b then s `bind` \x -> + while c s + else result () +\end{verbatim} + +\subsubsection{A family of state monads} +We have already described the use of monads to model programs with +state using the \verb"State" datatype in Section 4.2.1. The essential +property of any such monad is the ability to update the state and we +might therefore consider a more general class of state monads given by: +\begin{verbatim} + class Monad (m s) => StateMonad m s where + update :: (s -> s) -> m s s + set :: s -> m s s + fetch :: m s s + set new = update (\old -> new) + fetch = update id +\end{verbatim} +An expression of the form \verb"update f" denotes the computation which +updates the state using \verb"f" and result the old state as its result. For +example, the \verb"incr" function described above can be defined as: +\begin{verbatim} + incr :: StateMonad m Int => m Int Int + incr = update (1+) +\end{verbatim} +in this more general setting. The class declaration above also +includes set and fetch functions which set the state to a particular +value or return its value. These are easily defined in terms of the +update function as illustrated by the default definitions. + +The \verb"StateMonad" class has two parameters; the first should be a +constructor of kind \verb"(* -> * -> *)" while the second gives the state +type (of kind \verb"*"); both are needed to specify the type of update. +The implementation of update for a monad of the form \verb"State s" is +straightforward and provides us with our first instance of the +\verb"StateMonad" class: +\begin{verbatim} + instance StateMonad State s where + update f = ST (\s -> (s, f s)) +\end{verbatim} +A rather more interesting family of state monads can be described using +the following datatype definition: +\begin{verbatim} + data STM m s a = STM (s -> m (a,s)) -- a more sophisticated example, + -- where the state monad is + -- parameterized by a second, + -- arbitrary monad. +\end{verbatim} +Note that the first parameter to \verb"StateM" has kind \verb"(* -> *)", a +significant extension from Haskell (and previous versions of Gofer) +where all of the arguments to a type constructor must be types. This +is another benefit of the kind system. + +The functor and monad structure of a \verb"StateM m s" constructor are given +by: +\begin{verbatim} + instance Monad m => Functor (STM m s) where + map f (STM xs) = STM (\s -> [ (f x, s') | ~(x,s') <- xs s ]) + + instance Monad m => Monad (STM m s) where + result x = STM (\s -> result (x,s)) + STM xs `bind` f = STM (\s -> xs s `bind` (\(x,s') -> + let STM f' = f x + in f' s')) +\end{verbatim} +Note the condition that \verb"m" is an instance of \verb"Monad" in each of these +definitions. If we hadn't used the lazy pattern construct \verb"~(x,s')" in +the instance of \verb"Functor", it would have been necessary to strengthen +this further to instances of \verb"Monad0" -- i.e. monads with a zero. + +The definition of \verb"StateM m" as an instance of \verb"StateMonad" is also +straightforward: +\begin{verbatim} + instance StateMonad (STM m) s where + update f = STM (\s -> result (s, f s)) +\end{verbatim} +The following two functions are also useful for work with \verb"STM m s" +monads. The first, protect, allows an arbitrary computation to be +embedded in a state based computation without access to the state. +The second, execute, is similar to the \verb"startingWith" function in +Section 4.2.1, running a state based computation with a given initial +state and returning a computation as the result. +\begin{verbatim} + protect :: Monad m => m a -> STM m s a + protect m = STM (\s -> [ (x,s) | x<-m ]) + + execute :: Monad m => s -> STM m s a -> m a + execute s (STM f) = [ x | ~(x,s') <- f s ] +\end{verbatim} +Support for monads like \verb"StateM m s" seems to be an important step +towards solving the problem of constructing monads by combining +features from simpler monads, in this case combining the use of state +with the features of an arbitrary monad \verb"m". I hope that the system of +constructor classes in Gofer will be a useful tool for people working +in this area. + + +\subsubsection{Monads and substitution} +The previous sections have concentrated on the use of monads to +describe computations. Monads also have a useful interpretation as a +general approach to substitution. This in turn provides another +application for constructor classes. + +Taking a fairly general approach, a substitution can be considered as a +function \verb"s::v-> t w" where the types \verb"v" and \verb"w" +represent sets of variables and the type \verb"t a" represents a set +of terms, typically involving elements of type \verb"a". If \verb"t" is +a monad and \verb"x::t v", then \verb"x `bind` s" gives the result of +applying the substitution \verb"s" to the term \verb"x" by replacing +each occurrence of a variable \verb"v" in \verb"x" with the corresponding +term \verb"s v" in the result. For example: +\begin{verbatim} + instance Monad Tree where + result = Leaf + Leaf x `bind` f = f x + (l :^: r) `bind` f = (l `bind` f) :^: (r `bind` f) +\end{verbatim} +With this interpretation in mind, the Kleisli composition \verb"(@@)" in +Section 4.2.4 is just the standard way of composing substitutions, +while the result function corresponds to a null substitution. The fact +that \verb"(@@)" is associative with result as both a left and right identity +follows from the standard algebraic properties of a monad. + + +\subsection{Constructor classes in Gofer} +The previous two sections should have given you some ideas about the +motivation and use for constructor classes. It remains to say a few +words about the way that constructor classes fit into the general Gofer +framework. In practice, this means giving a more detailed description +of the way that the kind system works. + + +\subsubsection{Kind errors and the k command line option} +As has already been mentioned, Gofer 2.28 uses kind information to +check that type expressions are well-formed rather than simply checking +that each type constructor is applied to an appropriate number of +arguments. For example, having defined a tree datatype: +\begin{verbatim} + data Tree a = Leaf a | Tree a :^: Tree a +\end{verbatim} +the following definition will be rejected as an error: +\begin{verbatim} + type Example = Tree Int Bool +\end{verbatim} +as follows: +\begin{verbatim} + ERROR "file" (line 42): Illegal type "Tree Int Bool" in + constructor application +\end{verbatim} +The problem here is that the \verb"Tree" constructor has kind \verb"* -> *" so that +it expects to take one argument (a type) and deliver a type as the +result. On the other hand, in the definition of Example, the \verb"Tree" +constructor is treated as having (at least) two arguments; i.e. as +having a kind of the form \verb"(* -> * -> k)" for some kind \verb"k". Rather than +confuse a user who is not familiar with the use of kinds, Gofer +normally just prints an error message like the one above for examples +like this. + +If you would like Gofer to give a more detailed description of the +problem, you can use the \verb":set +k" command line option as follows: +\begin{verbatim} + ? :set +k + ? :r + Reading script file "file": + + ERROR "file" (line 42): Kind error in constructor application + *** expression : Tree Int Bool + *** constructor : Tree + *** kind : * -> * + *** does not match : * -> a -> b +\end{verbatim} +When the \verb"k" command line option has been selected, the \verb":info" command +described in Section 2.3.2 also includes kind information about the +kinds of type constructors defined in a program. For example, given +the definition of \verb"Tree" above and the datatypes: +\begin{verbatim} + data STM m s x = STM (s -> m (s, x)) + data Queue a = Empty | a :< Queue a | Queue a :> a +\end{verbatim} +The \verb":info" command gives the following kinds (editing the output to +remove details about constructor functions for each datatype): +\begin{verbatim} + ? :info Tree STM Queue + -- type constructor with kind * -> * + data Tree a + -- type constructor with kind (* -> *) -> * -> * -> * + data STM a b c + + -- type constructor with kind * -> * + data Queue a +\end{verbatim} +In addition to calculating a kind of each type constructor introduced +in a datatype declaration, Gofer also determines a kind for each +constructor defined by means of a type synonym. For example, the +following definitions: +\begin{verbatim} + type Subst m v = v -> m v + type Compose f g x = f (g x) + type Pointer a = Int + type Apply f x = f x + type Fusion f g x = f x (g x) + type Const x y = x +\end{verbatim} +are treated as having kinds: +\begin{verbatim} + ? :info Subst Compose Pointer Apply Fusion Const + -- type constructor with kind (* -> *) -> * -> * + type Subst a b = b -> a b + + -- type constructor with kind (* -> *) -> (* -> *) -> * -> * + type Compose a b c = a (b c) + + -- type constructor with kind * -> * + type Pointer a = Int + + -- type constructor with kind (* -> *) -> * -> * + type Apply a b = a b + + -- type constructor with kind (* -> * -> *) -> (* -> *) -> * -> * + type Fusion a b c = a c (b c) + + -- type constructor with kind * -> * -> * + type Const a b = a +\end{verbatim} +Note however type synonyms are only used as abbreviations for other +type expressions. It is not permitted to use a type synonym +constructor in a type expression without giving the correct number of +arguments. +\begin{verbatim} + ? undefined :: Const Int + ERROR: Wrong number of arguments for type synonym "Const" +\end{verbatim} +Assuming that you are familiar with polymorphic functions in Gofer, you +might be wondering why some of the kinds given for the type synonyms +above are not also polymorphic in some sense. After all, the standard +prelude function const, is defined by +\begin{verbatim} + const x y = x +\end{verbatim} +with type \verb"a -> b -> a", which looks very similar to the definition of +the \verb"Const" type synonym above, except that the kinds of the two +arguments have both been fixed as \verb"*". In fact, the right hand side of +a type synonym declaration is always required to have kind \verb"*", so this +would mean that the most general kind that could be assigned to the +\verb"Const" constructor would be \verb"* -> a -> *." + +Gofer does not currently support the use of polymorphic kinds (let's +call them polykinds from now on). First of all, it is not clear what +practical applications polykinds might offer (I have yet to find an +example where they are useful). Furthermore, some of the deeper +theoretical issues about type inference and related topics have not yet +been studied and I suspect that polykinds would introduce significant +complications without any significant benefits. + +The current approach is to replace any unknown part of an inferred kind +with the kind \verb"*." Any polymorphism in the kind of a constructor +corresponds much more closely to the idea of a value that is not +actually used at all than in the language of normal expressions and +their types so this is unlikely to cause any problems. And of course, +in Haskell and previous versions of Gofer, any variable used in a type +expression was assumed to be a type variable with kind \verb"*", so all of the +kinds above are consistent with this interpretation. + +The rest of this section is likely to get a bit hairy. Read on at your +peril, or skip to the start of Section 4.3.2. Only those with a strong +interest in the type theory and pragmatics of constructor classes will +miss anything. + +The same approach is used to determine the kinds of constructor +variables in type expressions. In theory, this can sometimes lead to +problems. In practice, this only happens in very contrived examples +and I doubt that any problems will occur for serious applications. The +following example illustrates the kind of `problem' that can occur. +Suppose that we use a script containing the definitions: +\begin{verbatim} + undefined :: a -- the `bottom' value + undefined = undefined + + strange :: f Tree -> f a + strange = undefined +\end{verbatim} +The type signature for the `strange' function is indeed very strange; +the constructor variables \verb"f" and \verb"a" have kinds \verb"(* -> *) -> *" and \verb"(* -> *)" +respectively. What's more, the type is very restrictive. Without +including additional primitive constructs in the language, I very much +doubt that you will be able to find an alternative definition for +strange which is not semantically equivalent to the definition above. +And of course, the definition above doesn't really have any practical +applications anyway. [In case you don't get my point, I'm trying to +show that this really is a very contrived example.] I would be very +surprised to see a genuine example of a polymorphic operator which +involves constructor variables of higher kinds in a non-trivial way +that does not also include overloading constraints as part of the +type. For example, it is not at all difficult to think of an +interesting value of type \verb"Monad m => a -> m a," but much harder to think +of something with type \verb"a -> m a" (remember this means for all \verb"a" and for +all \verb"m"). + +The definitions of undefined and strange above will be accepted by the +Gofer system as will the following definition: +\begin{verbatim} + contrived = strange undefined +\end{verbatim} +The type of contrived will now be \verb"f a" where \verb"f :: (* -> *) -> *" and +\verb"a :: (* -> *)". However, if we modify the definition of contrived to +include a type signature: +\begin{verbatim} + contrived :: f a + contrived = strange undefined +\end{verbatim} +then we get a type checking error: +\begin{verbatim} + ? :l file + Reading script file "file": + Type checking + ERROR "file" (line 24): Type error in function binding + *** term : contrived + *** type : a b + *** does not match : c d + *** because : constructor variable kinds do not match +\end{verbatim} +The problem is that for the declared type signature, the variables \verb"f" and +\verb"a" are treated as having kinds \verb"(* -> *)" and \verb"*" respectively. These do not +agree with the real kinds for these variables. + +To summarize, what this all means is that it is possible to define +values whose principal types cannot be expressed within the language of +Gofer types in the current implementation. The values defined can +actually be used within a program, but it would not, for example, be +possible to allow such values to be exported from a module in a Haskell +system unless kind annotations were added to the inferred types. + + +\subsubsection{The kind of values in a constructor class} +The previous section indicated that, if the \verb":set +k" command line option +has been set, the \verb":info" command will include information about the +kinds of type constructor constants in its output. This will also +cause the \verb":info" command to display information about the kinds of +classes and constructor classes. Notice for example in the following +how the output distinguishes between \verb"Eq", a type class, and \verb"Functor", a +constructor class in which each instance has kind \verb"(* -> *)": +\begin{verbatim} + ? :info Eq Functor + -- type class + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + ... + + -- constructor class with arity (* -> *) + class Functor a where + map :: Functor a => (b -> c) -> a b -> a c + + -- instances: + instance Functor [] + ... +\end{verbatim} + + +\subsubsection{Implementation of list comprehensions} +The implementation of overloaded monad comprehensions is cute, but also +has a couple of potential disadvantages. These are discussed in this +section. As you will see, they really aren't very much to worry +about. + +First of all, the decision to overload the notation for singleton lists +so that \verb"[ exp ] == result exp" can sometimes cause a few surprises: +\begin{verbatim} + ? map (1+) [1] + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) [ 1 ] +\end{verbatim} +Note that this will only occur if you are actually using a prelude +which includes the definition of the \verb"Monad" class given in Section 4.2 +This can be solved using the command line toggle \verb":set -1" which forces +any expression of the form \verb"[ exp ]" to be treated as a singleton list +rather than being interpreted in an arbitrary monad. You really +have to write `result' if you do want an arbitrary monad: +\begin{verbatim} + ? :set -1 + ? map (1+) [1] + [2] + (7 reductions, 18 cells) + ? map (1+) (result 1) + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) (result 1) +\end{verbatim} +This should probably be the default setting, but I have left things as +they are for the time being, partly so that other people might get the +chance to find out about this and decide what setting they think would +be best. As usual, the default setting can be recovered using the +\verb":set +1" command. + +A second concern is that the implementation of list comprehensions may +be less efficient in the presence of monad comprehensions. Gofer +usually uses Wadler's `optimal' translation for list comprehensions as +described in Simon Peyton Jones book. In fact, this translation will +always be used if either the prelude being used does not include the +standard Monad class or the type system is able to guarantee that a +given monad comprehension is actually a list comprehension. + +If you use a prelude containing the \verb"Monad" class, you may notice some +small differences in performance in examples such as: +\begin{verbatim} + ? [ x * x | x <- [1..10] ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (98 reductions, 203 cells) + + ? f [1..10] where f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (139 reductions, 268 cells) +\end{verbatim} +The second expression is a little more expensive since the local +definition of f is polymorphic with \verb"f :: (Num b, Monad a) => a b -> a b" +and hence the implementation of the comprehension in \verb"f" does not use the +standard translation for lists. To be honest, the difference between +these two functions really isn't anything to worry about in the context +of an interpreter like Gofer. And of course, if you really want to +avoid this problem, an explicit type signature will do the trick (as in +other cases where overloading is involved): +\begin{verbatim} + ? f [1..10] where f :: Num b => [b] -> [b]; + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 205 cells) + + ? f [1..10] where f :: [Int] -> [Int] + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 203 cells) +\end{verbatim} +As the last example shows, there is only one more reduction in this +case and that is the reduction step that deals with the application of +\verb"f" to the argument list \verb"[1..10]". + + +\section{GOFC, the Gofer compiler} + + +This release of Gofer includes \verb"gofc", a `compiler' for Gofer programs +which translates a large class of Gofer programs into C code which can +then be compiled and executed as a standalone application. + +Before anybody gets too excited, there are a couple of points which I +should mention straight away: +\begin{itemize} +\item To make use of \verb"gofc", you will need a C compiler. This is why I + do not intend to distribute any binary versions of \verb"gofc"; if you + have the C compiler needed to compile the output of \verb"gofc" then + you should also be able to compile \verb"gofc" from the sources. + +\item First of all, the Gofer compiler was written by modifying the + Gofer interpreter. Most of the modifications and changes were + made in just a few days. The compiler and interpreter still + share a large proportion of code. As such, and in case it isn't + obvious: {\em please do not} expect to gain the same kind of performance + out of \verb"gofc" as you would from one of the serious Haskell + projects. A considerably greater amount of time and effort has + gone into those systems. + +\item The compiler is actually over a year old, but this is the first + time it has been released. Although I have worked with it a bit + myself, it hasn't had half the amount of testing that Gofer user's + have given the interpreter over the last year and a half. It may + not be as reliable as the interpreter. If you have problems with + a compiled program, try running it with the interpreter too just + to check that you haven't found a potential bug in \verb"gofc". +\end{itemize} + +That having been said, I hope that the Gofer compiler will be useful to +many Gofer users. One possible advantage is that the executables may +be smaller than with some other systems. And of course, the fact that +gofc runs on some home computers may also be useful. Finally, gofc +provides a simplified system for experimenting with the runtime details +of an implementation. For example, the source code for the runtime +system is set up in such a way as to make it possible to experiment +with alternative garbage collection schemes. + + +\subsection{Using gofc} +Compiling a program with gofc is very much like starting up the Gofer +interpreter. The compiler starts by reading the prelude and then +loads the script files specified by the command line. These scripts +must contain a definition for the value \verb"main :: Dialogue" which will be +the dialogue expression that is evaluated when the compiled program is +executed. + +For example, if the file \verb"apr1.gs" contains the simple program: +\begin{verbatim} + main :: Dialogue + main = appendChan "stdout" "Hello, world\n" exit done +\end{verbatim} +then this can be compiled as: +\begin{verbatim} + machine% gofc apr1.gs + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "apr1.gs": + + Writing C output file "apr1.c": + [Leaving Gofer->C] + machine% +\end{verbatim} +The output is written to the file \verb"apr1.c" -- i.e. the name obtained by +removing the \verb".gs" suffix and replacing it with a \verb".c" suffix. Other +filename suffixes that are treated in a similar way are: +\begin{center} +\begin{tabular}{|ll|} \hline + \verb".prj" & \\ + \verb".gp" & for Gofer project files \\ \hline + \verb".prelude" & for Gofer prelude files \\ \hline + \verb".gof" & \\ + \verb".gs" & for Gofer scripts \\ \hline + \verb".has" & \\ + \verb".hs" & for Haskell scripts \\ \hline + \verb".lhs" & \\ + \verb".lit" & \\ + \verb".lgs" & \\ + \verb".verb" & for literate scripts \\ \hline +\end{tabular} +\end{center} + +If no recognized suffix is found then the name of the output file is +obtained simply by appending the \verb".c" suffix to the input name. + +For the benefit of those using Unix systems, let me point out that this +could cause you problems if you are not careful; if you take an input +file called `\verb"prog"' and compile it to `\verb"prog.c"' using \verb"gofc", make sure +that you do not compile the C program in such a way that the output is +also called `\verb"prog"' since this will overwrite your original source code! +For this reason, I would always suggest using file extensions such as +the \verb".gs" example above if you are using \verb"gofc". + +If you run gofc with multiple script files, then the name of the output +file is based on the last script file to be loaded. For example, the +command `\verb"gofc prog1.gs prog2.gs"' produces an output file `\verb"prog2.c"'. + +Gofc also works with project files, using the name of the project file +to determine the name of the output file. For example, the \verb"miniProlog" +interpreter can be compiled using: +\begin{verbatim} + machine% gofc + miniProlog + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "Parse": + Reading script file "Interact": + Reading script file "PrologData": + Reading script file "Subst": + Reading script file "StackEngine": + Reading script file "Main": + + Writing C output file "miniProlog.c": + [Leaving Gofer->C] + machine% +\end{verbatim} +This is another case where it might well have been sensible to have +used a \verb".prj" or \verb".gp" for the project file \verb"miniProlog" since compiling the +C code in \verb"miniProlog.c" to a file named `\verb"miniProlog"' will overwrite the +project file! Choose filenames with care! + +You can also specify Gofer command line options as part of the command +line used to run \verb"gofc". Think of it like this; use exactly the same +command line to start Gofc as you would have done to start Gofer (ok, +replacing the command `\verb"gofer"' with `\verb"gofc"') so that you could start your +program immediately by evaluating the main expression. To summarize +what happens next: +\begin{itemize} +\item Gofc will load the prelude file. Do not worry if the prelude + (or indeed, later files) contain lots of definitions that your + program will not actually use; only definitions which are actually + required to evaluate the main expression will be included in the + output file. + +\item Gofc will load the script files specified. If an error is found + then an error message will be printed and the compilation will be + aborted. You would probably be sensible to run your program + through the interpreter first to tidy up any errors and avoid this + problem. + +\item Gofc will look for a definition of `\verb"main"' and check that it has + type \verb"Dialogue". You will get an error if an appropriate main + value cannot be found. + +\item Gofc determines the appropriate name for the output file. + +\item Gofc checks to make sure that you haven't used a primitive + function that is not supported by the runtime system (see + Section 5.2 for more details). + +\item Gofc outputs a C version of the program in the output file. +\end{itemize} + +Once you have compiled the Gofer program to C, you need to compile +the C code to build the executable application program. This will +vary from one system to another and is documented elsewhere. + + +\subsection{Primitive operations} +The Gofer compiler accepts the same source language as the +interpreter. However, there is a small collection of Gofer primitives +which are only implemented in the interpreter. The most likely +omission that you will notice is the \verb"primPrint" function which is used +to define the \verb"show"' function in the standard prelude. Omitting this +function is not an indication of laziness on my part; it is impossible +to implement \verb"primPrint" in the current runtime system because there is +insufficient type information available at program runtime. + +For example, if you try to compile the program: +\begin{verbatim} + main :: Dialogue + main = appendChan "stdout" (show' 42) exit done +\end{verbatim} +the compiler will respond with the error message: +\begin{verbatim} + ERROR: Primitive function primPrint is not + supported by the gofc runtime system + (used in the definition of show') + Aborting compilation +\end{verbatim} +The solution is to use type classes. This is one of the reasons for +including them in the language in the first place. This example can +be compiled by changing the original program to: +\begin{verbatim} + main :: Dialogue + main = appendChan "stdout" (show 42) exit done +\end{verbatim} +(Remember that show is the overloaded function for converting values of +any type a that is an instance of the Text class to a string value.) + + +\subsection{Debugging output} +Another potentially useful feature of \verb"gofc" is it's ability to dump a +listing of all the supercombinator definitions that are created by +loading a particular combination of script files. For the time being, +this is only useful for the purpose of debugging, but with only small +modifications, it might be possible to use this as input to an +alternative backend/code generator system (the format of the output +combinators already uses explicit layout characters to make the task of +parsing easier in an application like this). + +To illustrate how this option might be used, suppose that we were working +on a program containing the definition: +\begin{verbatim} + hidden xs = map (\[x] -> x) xs +\end{verbatim} +and that somewhere during the execution of our program, this function is +applied to a list value \verb"[[1],[1,2]]": +\begin{verbatim} + ? hidden [[1],[1,2]] + [1, + Program error: {v132 [1, 2]} + (13 reductions, 75 cells) +\end{verbatim} +The variable \verb"v132" which appears here is the name used internally to +represent the lambda expression in the definition of hidden. For this +particular example, it is fairly easy to work this out, but in general, +it may not be so straightforward. Running the program through \verb"gofc" and +using the \verb"+D" toggle as follows produces an output file containing Gofer +SuperCombinators, hence the \verb".gsc" suffix: +\begin{verbatim} + machine% gofc +D file + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + [Writing supercombinators to "file.gsc"] + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "file": + [Leaving Gofer->C] + machine% +\end{verbatim} +Note that there is no need in this situation for the files loaded to +contain a definition for \verb"main :: Dialogue", although the compiler must +be loaded using exactly the same prelude and order of files as in the +original Gofer session to ensure that the same names are used. Scanning +the output file, we find that the only mention of \verb"v132" is in the +definitions: +\begin{verbatim} + v132 o1 = case o1 of { + (:) o3 o2 -> case o2 of { + [] -> o3; + } + } + + hidden o1 = map v132 o1; +\end{verbatim} +This shows fairly clearly where the function \verb"v132" comes from. Of +course, this is far from perfect, but it might help someone to track +down a bug that little bit faster one day. It's better than nothing. + +Of course, the debugging output might also be of interest to anyone +that wants to find out more about the implementation of Gofer and +examine the supercombinator definitions generated when list +comprehensions, overloading, local function definitions etc. have all +been eliminated. For example, the standard prelude definitions of \verb"map" +and filter become: +\begin{verbatim} + map o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> o2 o4 : map o2 o3; + } + + filter o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> let { o5 = filter o2 o3; + } in | o2 o4 -> o4 : o5; + | otherwise -> o5; + } +\end{verbatim} +This is one of the tools I'll be using if anyone ever reports another +bug in the code generator\dots + + +\section{Some history} + +Ever since the first version of Gofer was released I've had requests +from Gofer users around the world asking how Gofer got its name and how +it came into being. This section is an attempt to try and answer those +questions. + +\subsection{Why Gofer?} +Everything has to have a name. You may type in an `anonymous function' +as a lambda expression but Gofer will still go ahead and give it a +name. To tell the truth, I always intended the name `Gofer' to be +applied to my particular implementation of a functional programming +environment, not to the language on which it is based. I wanted that +to be an anonymous language. But common usage has given it the same +name, Gofer. + +If you take a look in a dictionary (as some puzzled Gofer users have) +you'll find that `gofer' means: +\begin{quote} + an employee whose duties include running errands +\end{quote} +(although you'd better choose a dictionary printed since the 70s for +this). I'd not thought about this when I chose the name (and I would +have used a lower case g instead of an upper case G if I had). In +fact, Gofer was originally conceived as a system for machine assisted +equational reasoning. One of the properties of functional languages +that I find particularly attractive is that they are: +\begin{quote} + {\bf go}od {\bf f}or {\bf e}quational {\bf r}easoning. +\end{quote} +So now you know. The fact that you can also tell someone who is having +a problem with their C program to ``Gofer it!'' (unsympathetic, I know) +is nothing more than a coincidence. Fairly recently, somebody wrote to +ask if Gofer stood for +`{\bf go}od {\bf f}unctional programming {\bf e}nvi{\bf r}onment''. I +was flattered; I wish I'd thought of that one. + +Some people have asked me why I didn't choose a title including the +name `Haskell', a language on which Gofer is very strongly based. +There are two reasons for this. To start with, the original version of +Gofer was based on a different syntax, Orwell + type classes. The +Haskell influence only crept in when I started on version 2.xx. +Secondly, it's only right to point out that there is quite a large gap +between a system like Gofer and the full blown Haskell systems that +have been developed. Using a name which doesn't involve `Haskell' +directly seemed the right thing to do. Some people tell me that it was +a mistake. One of the objectives of Haskell was to create a standard +language for non-strict functional programming. Gofer isn't intended +as an alternative to Haskell and I hope it will continue to grow closer +as time passes. + +While I'm on the subject of names, I should also talk about an +additional source of confusion that may sometimes crop up. While Gofer +is a functional programming system, there is also a campus wide +information system called `Gopher' (sharing it's name with the North +American rodents). I would guess that the latter has many more users +than the former. So please be careful to spell Gofer with an `f' not +a `ph' to try and minimize the confusion. + +It has occurred to me that I should try and think of another name for +Gofer to avoid the confusion with Gopher. I hope that won't be +necessary, but if you have a really good suggestion, let me know! One +possibility might be to call it `Gordon'. The younger generation of +brits might know what the connection is. Others may need to ask their +children\dots + +\subsection{The history of Gofer} +Here is a summary of the way that I first learnt about functional +programming, and how it started me on the path to writing Gofer. +This, slightly sentimental review is mostly for my own entertainment. +If you're the sort of person that likes to read the acknowledgments +and bibliographic notes in a thesis: this is for you. If not, you +can always stop reading :-) + +My first exposure to lazy functional programming languages was using a +language called `Orwell' developed and used at the Programming Research +Group in Oxford. I've been interested in using and implementing lazy +functional programming languages ever since. + +One of the properties of programming in Orwell that appealed to me was +the ability to use equational reasoning -- a very simple style of +mathematical reasoning -- to establish properties of programs and prove +that they would behave in particular ways. Even more interesting, +equational reasoning can be used to calculate efficient implementations +of programs from a formal specification of what was intended. + +Probably the first non-trivial functional program that I wrote was a +simple Prolog interpreter. (This was originally written in Orwell and +later transcribed to be compiled using the Chalmers Haskell B compiler, +hbc. The remnants of this program live on in the mini Prolog +interpreter that is included with the Gofer distribution and, I +believe, with at least a couple of the big Haskell systems.) Using a +sequence of something like a dozen or so transformations (most of which +were fairly mundane), I discovered that I could turn a relatively +abstract specification of a Prolog inference engine into a program that +could be interpreted as the definition of a low level stack-based +machine for executing Prolog queries. Indeed, I used the result as the +core of a C implementation of mini Prolog. + +The transformations themselves were simple enough but managing the +complexity of the calculations was tough. It was not uncommon to find +that some of the intermediate steps in a calculation would span more +than 200 characters. Even with a relatively small number of +transformation steps, carrying out proofs like this was both tedious +and prone to mistakes. A natural application for a computer! + +Here's an outline of what happened next: +\begin{description} + \item[eqr] 1989. Eqr was a crude tool for machine assisted equational + reasoning. It worked well enough for the job I had intended + to use it for, but it also had a number of problems. I + particularly missed the ability to use and record type + information as part of an automated derivation. + + \item[1.xx] 1990. Gofer 1.xx was intended to be the next step forward + providing machine support for {\em typed} equational reasoning. + It was based on Orwell syntax and was later extended to + support Haskell style type classes. It had a lexer, parser, + type checker and simple top-level interactive loop. It + couldn't run programs or construct derivations. + + \item[2.xx] January 1991. A complete rewrite. I remember those early + days, several months passed before I ever got compile some of + the earliest code. The emphasis switched to being able to run + programs rather than derive them when I came up with a new + implementation technique for type classes in February 1991. + If I wanted to see it implemented, I was going to have to do + it myself. Around about May, I realized I had something that + might be useful to other people. + + \item[2.20] The first public release, announced in August 1991 and + distributed shortly after that in September. + + \item[2.21] November 1991, providing a more comprehensive user + interface, access to command line options and fixing a + small number of embarrassing bugs in the original release. + + \item[2.23] August 1992, having been somewhat preoccupied with academic + studies for some time, the main purpose of this release + was to correct a number of minor bugs which had again been + discovered, either by myself or by one or more of the many + Gofer users out there. + + \item[2.28] January 1993. The most substantial update to Gofer since + the original release. I had been doing a lot of work and + experimentation with Gofer during the time between the + release of versions 2.21 and 2.23, but I didn't have the + time to get these extensions suitable for public distribution. + By the time I came to release version 2.23, I also had + several other distinct versions of Gofer (each derived + from the source for version 2.21) including a compiler + and a prototype implementation of constructor classes + which was called `ccgofer'. Work on version 2.28 started + with efforts to merge these developments back into a single + system (I was tired of trying to maintain several different + versions, even though I was the only one using them). + The rough outline of changes was as follows (with the + corresponding version numbers for those who wonder why + 2.28 follows 2.23): + +\begin{tabular}{ll} + 2.24 & enhancements and bug fixes \\ + 2.25 & merging in support for the Gofer compiler \\ + 2.26 & a reimplementation of constructor classes \\ + 2.27 & reworked code generator and other minor fixes \\ + 2.28 & preparation for public release +\end{tabular} +\end{description} + +\end{document} diff --git a/docs/release.221 b/docs/release.221 new file mode 100644 index 0000000..e2ced27 --- /dev/null +++ b/docs/release.221 @@ -0,0 +1,1386 @@ + + + + + +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.21 + + Copyright Mark P Jones 1991. + + + Release notes + +----------------------------------------------------------------------- + +This document is intended as a supplement to the user manual ``An +introduction to Gofer'' supplied with the previous public release of +Gofer, version 2.20.1. It provides brief descriptions of the changes +and new features incorporated in version 2.21. With the exception of +bug fixes, which will be distributed as soon as they become available, +there are no plans to release a further update of Gofer for some time +(at least six months). + +If you would like to be informed when bug-fixes or further versions +become available, please send email to me at mpj@prg.ox.ac.uk or +jones-mark@cs.yale.edu (if you have not already done so) and I will +add your name to the mailing list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + +In addition to PC and Sun workstations, I have now had reports that +Gofer has been successfully compiled and used on a number of other +machines including Apollo, DecStation, Mips, MicroVax and Acorn ARM +machines, with little or no changes to the original source. + + +ACKNOWLEDGMENTS + +Many of the features described in this document were motivated by +comments and suggestions from users of the previously released version +of Gofer. My thanks in particular to Julian Seward, but also to Brent +Benson, Stuart Clayman, Andy Gill, Peter Hancock, Ian Holyer, Hiroyuki +Matsuda, Aiden McCaughey, Tobias Nipkow, Will Partain, Ian Poole, +Bernard Sufrin and Phil Wadler. + + + + + + + + + + + 1 + + + + +Release Notes 1. MINOR ENHANCEMENTS + + +1. MINOR ENHANCEMENTS + +A number of small enhancements have been made to make the source code +for Gofer a little more flexible. In particular, this includes: + + o Gofer can now be compiled using the Gnu C compiler gcc, for those + who prefer this to the standard cc compiler provided on their + machine. + + o Default table sizes for the Unix version have been expanded which + makes it possible to support larger programs in Gofer (a program + of over 5000 lines has already been tested with this release). + + o The Makefile has been made less SunOS specific and should be + usable on a wider range of machines without modification. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 2 + + + + +Release Notes 2. USER INTERFACE EXTENSIONS + + +2. USER INTERFACE EXTENSIONS + +The user interface of the previous release has been extended to support +a range of new features, intended to make the Gofer environment more +convenient for program development. Further details are given in the +following sections. + +2.1 Command line options +------------------------ +Although the previous version of Gofer accepted some command line +options, these were not documented. Those who discovered the +Gofer command line options in the previous release by reading the +source code should note that a different syntax is now used which is +not compatible with the older system. + +Options may be set when loading Gofer (on the UNIX/DOS command line) +or within the interpreter itself using the :set command. Using this +command on its own with no arguments prints a menu of all of the +available options and displays the current settings: + + ? :set + Groups of options begin with +/- to turn options on/off resp. + + TOGGLES: + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Treat input files as literate scripts + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + a Use any evidence, not nec. best + E Fail silently if evidence not found + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + xnum Set maximum depth for evidence search + + Current settings: +sdcoaE -tfgleiu -h100000 -p? -x8 + ? + +Most options are toggles meaning that they can either be switched on +(by preceding the option with a `+' character) or off (by using a `-' +character). Several options may be grouped together so that: + + :set +std -le is equivalent to :set +s +t +d -l -e + +In order to distinguish command line options from filenames, a leading +`+' or `-' must also be used with the `h', `p' and `x' options, although +the choice in each case is not significant. + + + + 3 + + + + +Release Notes 2.1 Command line options + + +Options may also be used in :a and :l commands, and within project files +(see section 2.2), although it should be noted that they will be acted +upon as soon as they are encountered and will not be reapplied when +reloading files. + +Most of the options listed above are described in more detail in the +following sections. + + +2.1.1 Set Gofer prompt +----------------------- +The standard Gofer prompt "? " may be changed using a command line +option of the form -pstr where for any string str. The new prompt is +formed from the given string, followed by a single space: + + ? :set -pGofer> + Gofer> :set -p? + ? + +2.1.2 Print statistics +----------------------- +In normal operation, Gofer displays the number of reductions and cells +used by a particular calculation when the result has been evaluated or +if the calculation is interrupted: + + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (112 reductions, 204 cells) + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + (18 reductions, 54 cells) + ? + +Printing of these statistics can be suppressed using the -s option +(and subsequently restored using +s): + + ? :set -s + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + ? :set +s + ? 2 + 4 + 6 + (2 reductions, 6 cells) + ? + + +2.1.3 Print type +----------------- +Before evaluating an expression entered into the interpreter, the Gofer +type checker is used to determine the type of the resulting value. +This is used to detect errors in the original input expression, avoid +the use of runtime type checks and determine how the value should be + + + 4 + + + + +Release Notes 2.1.3 Print type + + +output. The actual type of the term is not usually displayed unless a +type error is detected. This behaviour can be changed using the +t +option which displays the type of each value as soon as evaluation is +complete. + + ? :set +t + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] :: [Int] + (108 reductions, 204 cells) + + ? map concat + map concat :: [[[a]]] -> [[a]] + (2 reductions, 17 cells) + + ? fix where fix f = f (fix f) + v112 :: (a -> a) -> a + (1 reduction, 7 cells) + ? + +Note that values of type String and Dialogue (or equivalent forms) are +displayed in a different manner to other values, and no type information +is printed after such values to avoid any possibility of confusion: + + ? map -- the map function + map :: (a -> b) -> [a] -> [b] + (1 reduction, 6 cells) + + ? "map" -- a string expression + map + (0 reductions, 4 cells) + + ? print "map" -- a dialogue + "map" + (18 reductions, 44 cells) + ? + + +2.1.4 Show dictionaries +------------------------ +The implementation of overloading in Gofer uses a translation of each +expression entered into the interpreter to a new expression involving +dictionary variables and constants. These additional parameters are +usually included in expressions displayed by the interpreter and are +often useful for understanding and resolving overloading problems: + + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \d125 x -> (+) d125 x x + + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? + +If necessary (perhaps to make the output of Gofer easier for a beginner +to understand), the printing of dictionary parameters may be suppressed + + + 5 + + + + +Release Notes 2.1.4 Show dictionaries + + +using the -d option: + + ? :set -d + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \x -> x + x + + ? :t map (1+) [1..10] + map (1 +) (enumFromTo 1 10) :: [Int] + ? + +The original behaviour can be obtained using :set +d within the +interpreter. + + +2.1.5 Terminate on error +------------------------- +When an irreducible subexpression is encountered during the evaluation +of a particular expression, the irreducible redex is printed with +surrounding braces and the Gofer interpreter attempts to continue the +evaluation with other parts of the original expression: + + ? take (1/0) [1..] -- value is bottom + {primDivInt 1 0} + (4 reductions, 33 cells) + ? [1/0] -- value is [bottom] + [{primDivInt 1 0}] + (5 reductions, 34 cells) + ? [1/0, 2] -- value is [bottom, 2] + [{primDivInt 1 0}, 2] + (7 reductions, 43 cells) + ? + +Notice that, reading an expression enclosed in {braces} as bottom, each +of the values printed by Gofer gives the correct value. Of course, it +is not possible to arrange for anything to be printed when a value of +bottom is generated by a nonterminating computation: + + ? last [1..] + ^C{Interrupted!} -- nothing printed until interrupted + + (10470 reductions, 15712 cells) + ? + +An alternative behaviour is provided by the +f option, which causes the +evaluation of an expression to be abandoned completely if an error +occurs: + + ? :set +f + ? take (1/0) [1..] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 55 cells) + + + + + 6 + + + + +Release Notes 2.1.5 Terminate on error + + + ? [1/0] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 54 cells) + + ? [1/0,2] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 56 cells) + + ? + +Note that we are no longer able to distinguish between the values +produced by these three terms from the output produced by Gofer -- the +only differences are in the number of reductions and cells used which +tells us nothing about the values of the terms. Note that the basic +method of evaluation in Gofer is unchanged -- the +f option simply +modifies the printing mechanism (i.e the means by which values are +displayed) to be more strict (in the technical sense of the word). + +Although the use of the +f option makes the Gofer printing mechanism +less accurate, it is sometimes useful during program development so +that an error can be detected as soon as it occurs. The original +behaviour can of course be restored at any time using the -f +option. + + +2.1.6 Heap size +---------------- +The -hnumber option can be used to set the heap size (i.e. total number +of cells available at any one time), but cannot be used once the +interpreter has been loaded. For example, starting the interpreter +with the command: + + gofer -h20000 + +will typically start the Gofer interpreter with a heap of 20000 cells. +Note that the heap is used to hold an intermediate (parsed) form of an +input file while it is being read, type checked and compiled. It +follows that, the larger the input file, the larger the heap required +to enable that file to be loaded into Gofer. In practice, most large +programs are written (and loaded) as a number of separate files (see +section 2.2) which means that this does not usually cause problems. + + +2.1.7 Garbage collector notification +------------------------------------- +It is sometimes helpful to be able to tell when the garbage collector +is being used, in order to monitor the amount of time involved and the +number of cells recovered with each garbage collection. If the +g +command line option is given (for example, using the command :set +g) +then the garbage collector prints a message of the form {{Gc:num}} each +time that the garbage collector is invoked. The number after the colon +indicates the total number of cells that have been recovered. + + + + + 7 + + + + +Release Notes 2.1.7 Garbage collector notification + + +The garbage collector messages are actually printed in three sections, +which indicate which stage the garbage collector has reached (this is +only noticeable on slower machines of course!): + + {{Gc : number}} + + garbage marking cells preparing garbage + collection which are unused cells collection + begins still in use for reuse completed + +Garbage collector messages may be printed at almost any stage in a +computation (or indeed whilst loading, type checking or compiling a +file of definitions). For this reason, it is often better to turn +the garbage collector messages off (using :set -g for example) when +they are not required. + + +2.1.8 Conformality testing +--------------------------- +As described briefly in section 9.11 of the documentation for Gofer +version 2.20, pattern bindings of the form pat=expr are implemented +using a `conformality check' to ensure that the value of expr does +indeed match the pattern pat. For example, the pattern binding: + + (x:xs) = [1..] + +is actually implemented as if it had been defined by: + + (x:xs) = conformality [1..] + where conformality v@(_:_) = v + +which is in turn treated as a group of bindings: + + xxs = conformality [1..] where conformality v@(_:_) = v + x = head xxs + xs = tail xxs + +[The variables conformality and xxs used here are given as examples +only -- in practice, Gofer maintains a supply of variable names and +selects new names from this supply to avoid clashes with variables +which are already in use.] + +The conformality check does not cause any problems in the example +above because the list [1..] is always guaranteed to match the +pattern (x:xs) (i.e. a non-empty list). We can however see the +conformality check in action if we try examples in which the pattern +does not match: + + ? x where (x:xs) = [] + {v114 []} + (3 reductions, 25 cells) + + ? xs where (0:xs) = [1..] + {v114 [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1)} + (13 reductions, 94 cells) + ? + + + 8 + + + + +Release Notes 2.1.8 Conformality testing + + +The variable v114 in each of these examples is the variable name +representing the conformality check. As the second example shows, the +value of the expression on the right hand side of the pattern binding +is evaluated as much as necessary to determine whether the pattern +fits. + +[ASIDE: This example also demonstrates a small problem with the printer +in that, when the first element of the list is encountered, it is +unable to detect that the tail of the list has not yet been evaluated. +Consequently, the expression: + + [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1) + +is not enclosed in parentheses as it should be. This is a little +annoying, but not important because the expression only appears in an +error message. The problem cannot in general be solved unless we avoid +the use of the [...] notation for enumerating the elements of a list.] + +The conformality check must be used for compatibility with Haskell. +However, it is sometimes useful to be able to suppress the conformality +check using the -c option (for example, to use some programs written +for a language without conformality checks within Gofer): + + ? :set -c + ? x where (x:xs) = [] + {_SEL (:) [] 1} + (5 reductions, 36 cells) + ? xs where (0:xs) = [1..] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14^C{Interrupted!} + + (55 reductions, 146 cells) + ? + +In the first example, the expression _SEL (:) [] 1 indicates that the +first component of an object constructed using the (:) operator is to +be extracted from the object []. Clearly this is impossible, and hence +the expression _SEL (:) [] 1 is irreducible. In the second case, the +value of xs is equivalent to _SEL (:) (1:[2..]) 2 which reduces to +the infinite list [2..] as shown, despite the fact that [1..] does not +match the pattern (0:xs). + +[ASIDE: The _SEL function is used internally by Gofer and cannot be +entered directly into the the interpreter. One particular reason for +this is that it is not in general possible to assign a sensible type +to _SEL. Constructor functions appearing as the first argument to _SEL +are printed in the normal manner. There is no standard syntax for +writing tuple constructors in Gofer or Haskell which are therefore +printed in the form (,,,) for example, where the number of commas +indicates the number of components in the tuple. In the following +example the constructor (,) denotes the pairing constructor. + + ? f a b where f (n+1) y = n+y; (a,b) = (0,1) + {v113 0 (_SEL (,) (0,1) 2)} + (10 reductions, 63 cells) + ? + + + + 9 + + + + +Release Notes 2.1.8 Conformality testing + + +The same notation is sometimes used in the messages produced when type +errors are detected: + + ? (1,2) 3 + ERROR: Type error in application + *** expression : (1,2) 3 + *** term : (,) + *** type : a -> b -> (a,b) + *** does not match : c -> d -> e -> f + + ? + +This syntax for tuple constructor functions cannot be used in +expressions entered directly into Gofer. It may however be a nice +extension to consider for future versions, allowing definitions such +as zip = zipWith (,) and distl x = map (x,).] + + +2.1.9 Literate scripts +----------------------- +In common with most programming languages, Gofer typically treats input +from a file as a list definitions in which program text is the norm, +and comments play a secondary role, introduced by the character +sequences ``--'' and ``{- ... -}''. + +An alternative approach, using an idea described by Knuth as ``literate +programming'', gives more emphasis to comments and documentation, with +additional characters needed to distinguish program text from comments. +Gofer supports a form of literate programming based on an idea due to +Richard Bird and originally implemented as part of the functional +programming language Orwell. The same idea has subsequently been +adopted by several other functional language systems. + +A literate script contains a sequence of lines. Program lines are +distinguished from comments by a `>' character in the first column. +This makes it particularly easy to write a document which is both an +executable program script and at the same time, without need for any +preprocessing, suitable for use with document preparation software such +as LaTeX. Indeed, this document is itself a literate script containing +the following definition of the squaring function. + +> sqr x = x * x + +The +l option sets Gofer to treat each input file as a literate +script. It should not be used on the command line unless the prelude +file has been edited to make a literate script. + +The effect of using literate scripts can be thought of as applying a +preprocessor to each input file before it is loaded into Gofer. This +program has a particularly simple definition in Gofer: + + illiterate :: String -> String + illiterate cs = unlines [ xs | ('>':xs) <- lines cs ] + +The system of literate scripts used in Orwell is actually a little more +complicated than this and requires that the programmer adopt two simple + + + 10 + + + + +Release Notes 2.1.9 Literate scripts + + +conventions in an attempt to try to catch simple errors in literate +scripts: + + o Every input file must contain at least one line whose first + character is `>'. This means that programs containing no + definitions (because the programmer has forgotten to use the `>' + character to mark definitions) from being accepted. + + o Lines containing definitions must be separated from comment lines + by one or more blank lines (i.e. lines containing only space and + tab characters). This is useful for catching programs where the + leading `>' character has been omitted from one or more lines in + the definition of a function. For example: + + > map f [] = [] + map f (x:xs) = f x : map f xs + + would result in an error if the `>' character appeared in the first + column of the first line. + +Gofer will report on errors of this kind if the +l option is combined +with the +e option (for example as +le). + + +2.1.10 Optimise (&&) and (||) +----------------------------- +The operator symbols (&&) and (||) are usually used to represent the +boolean connectives conjunction (and) and disjunction (or). By +default, Gofer uses the following equations to produce better code for +expressions involving these operators: + + x && y = if x then y else False + x || y = if x then True else y + +This optimization is only valid if the operator symbols (&&) and (||) +are indeed bound to the appropriate values at the top level (the +standard full definitions are required in order to support partial +applications involving these operators). Although this optimization is +in general valid (because the appropriated definitions are included in +the standard prelude), it may be necessary in certain cases (for +example, when working with a non-standard prelude) to suppress the +optimization using the -o option. + + + + + + + + + + + + + + + + + 11 + + + + +Release Notes 2.2 Project Files + + +2.2 Project Files +------------------ +Project files provide a simple way to use programs which are +spread across a number of source files. Larger programs are often +written in this way, to separate the different components of the +program into smaller pieces which can be developed and tested +independently of other components. + +A project file is a simple text file containing a list of program +filenames. The project file may also contain comments using either of +the Gofer conventions for comments. As a simple example, a simple +project file, in a file named "miniProlog", suitable for the +stack-based version of the mini Prolog interpreter included as a +demonstration program with Gofer 2.21 is as follows: + + -- This is a project file suitable for loading the stack-based + -- version of the mini Prolog interpreter into Gofer 2.21 + -- + -- Load into Gofer using the command: :p miniProlog + -- or from command line using: gofer + miniProlog + + Parse -- general purpose parsing library + Interact -- general purpose library for interactive programs + PrologData -- definition of main data structures + Subst -- substitutions and unification + StackEngine -- inference engine + Main -- top level program + +As indicated in the comments at the top, there are two ways of using +this file with Gofer. Within the interpreter we can use the command +:p miniProlog. Once this command has been entered, Gofer reads the +contents of the project file and then attempts to load each of the +files named. In general, if a particular project file "proj" contains +the options op1, ..., opn and the filenames f1, ..., fm, then the +command :p proj is equivalent to the sequence of commands: + + :l -- clear any previously loaded scripts + :set op1 ... opn -- set options + :l f1 ... fm -- load files + +The project file name may also be specified on the command line used to +start the interpreter by preceding the project file name with a single +`+' character. Note that there must be at least one space on each side +of the `+'. This may be combined with standard command line options, +but any additional filename arguments will be ignored. Starting Gofer +with a command of the form "gofer + proj" is equivalent to starting +Gofer without the "+ project" arguments and then giving the command +:p proj. + +In addition, Gofer records the name of the project file and displays +this with the list of files loaded. For example: + + Gofer session for: (project: miniProlog) + /users/mpj/public/Gofer/prelude + Parse + Interact + + + 12 + + + + +Release Notes 2.2 Project Files + + + PrologData + Subst + StackEngine + Main + ? + +Once a project file has been selected, the command :p (without any +arguments) can be used to force Gofer to reread the project file and +load fresh copies of each of the files listed there. There are two +places in which this is particularly useful: + + o If the project file itself has been modified since the last time + that it was read. + + o To force Gofer to reload all of the files in the project, + regardless of the last time they were modified. + +As usual, the :r command can be used to reload each of the files in the +current project without rereading the project file itself, and avoiding +the need to read certain files which have not been modified since the +previous time they were loaded. + +The use of project files integrates smoothly with the other parts of +the Gofer environment. As an example consider a project file proj +containing the four filenames f1, f2, f3 and f4, and suppose that the +file f3 contains an error of some kind. This leads to the following +sequence of commands and results: + + :p proj -- attempt to load project proj + -- reads filenames f1, f2, f3, f4 from proj + -- load definitions from f1 + -- load definitions from f2 + -- load definitions from f3 -- error occurs + -- error message printed + :e -- starts up editor at relevant line in f3 + -- correct error + -- exit editor + -- load definitions from f3 + -- load definitions from f4 + +After just these two commands, the error in f3 has been corrected and +all of the files mentioned in proj have been loaded, ready for use. + + + + + + + + + + + + + + + + + 13 + + + + +Release Notes 2.3 Other new features + + +2.3 Other new features +----------------------- + +2.3.1 :find - find definition +------------------------------ +The command ":f name" starts up an editor to allow you to inspect (and +possibly modify) the definition of a particular name from the files +currently loaded into Gofer. If supported (using the EDITLINE +variable), Gofer will attempt to initialize the editor so that the +cursor is initially positioned at the first line in the definition. +There are three possibilities: + + o If the name is defined by a function or variable binding then + the cursor is positioned at the first line in the definition of + the name (ignoring any type declaration, if present). + + o If the name is a constructor function, then the cursor is + positioned at the first line in the definition of the + corresponding data definition. + + o If the name represents an internal Gofer function, then the + cursor will be positioned at the beginning of the standard + prelude file. + +Note that names of infix operators should be given without any +enclosing them in parentheses. Thus ":f ++" starts an editor on the +standard prelude at the first line in the definition of (++). + + +2.3.2 :! - shell escape +------------------------ +A command of the form ":! cmd" can be used to execute a specified +system command without leaving the Gofer interpreter. For example, +":! ls" (or ":! dir" on MS DOS machines) can be used to list the +contents of the current directory. + +The command ":!" without any arguments starts a new shell: + + o On a unix machine, the SHELL environment variable is used to + determine which shell to use (the default is "/bin/sh"). + + o On an MS DOS machine, the COMSPEC environment variable is used + to determine which shell to use. This is usually COMMAND.COM + and you may return to Gofer using the EXIT command. + +As usual, it is not possible to use a shell escape to change the +current working directory. The :cd command described in the following +section can be used for this purpose. + + +2.3.3 :cd - change directory +----------------------------- +The command ":cd dir" changes the current working directory to the path +given by "dir". This command is ignored if the pathname is omitted. + + + + + 14 + + + + +Release Notes 2.3.4 :names - list names + + +2.3.4 :names - list names +-------------------------- +The :n command lists the names of variables and functions whose +definitions are currently loaded into the Gofer interpreter. Using +this command without any arguments produces the list of all names +known to the system. For example, with just the standard prelude +loaded we obtain: + + ? :n + !! && * + ++ - . / /= : < <= == > >= AppendChan AppendFile Echo + Failure False FormatError OtherError ReadChan ReadError ReadFile + SearchError Str Success True WriteError WriteFile [] \\ ^ abort abs + all and any appendChan appendFile asTypeOf break chr cjustify + concat const copy curry cycle div done drop dropWhile echo elem + enumFrom enumFromThen enumFromThenTo enumFromTo error even exit + filter flip foldl foldl' foldl1 foldr foldr1 fromInteger fst fst3 + gcd head help id inRange index init insert interact isAlpha + isAlphanum isAscii isControl isDigit isLower isPrint isSpace + isUpper iterate last layn lcm length lines ljustify map max maximum + merge min minimum mod negate not notElem nub null odd or ord + otherwise primDivFloat primDivInt primEqFloat primEqInt + primIntToFloat primLeFloat primLeInt primMinusFloat primMinusInt + primMulFloat primMulInt primNegFloat primNegInt primPlusFloat + primPlusInt primPrint print prints product products qsort range + readChan readFile rem repeat reverse rjustify run scanl scanl' + scanl1 scanr scanr1 show show' showChar showList showString shows + showsPrec signum snd snd3 sort space span splitAt stdecho stderr + stdin stdout strDispatch strict subtract succDispatch sum sums tail + take takeUntil takeWhile thd3 toLower toUpper transpose uncurry + undefined unlines until until' unwords words writeFile zip zip3 + zip4 zip5 zip6 zip7 zipWith zipWith3 zipWith4 zipWith5 zipWith6 + zipWith7 || + (201 names listed) + ? + +Note that the names are listed in the standard alphabetical order. + +The :n can also accept one or more pattern strings which limits the list +of names printed to those names matching one or more of the given +pattern strings: + + ? :n fold* + foldl foldl' foldl1 foldr foldr1 + (5 names listed) + ? + +Each pattern string consists of a string of characters and may use the +standard wildcard characters: `*' (matches anything), `?' (matches any +single character), `\c' (matches exactly the character c) and ranges of +characters of the form `[a-zA-Z]' etc. For example: + + ? :n *ap* *[Cc]han \\\\ ? + * + - . / : < > AppendChan ReadChan \\ ^ appendChan appendFile + map readChan + (16 names listed) + ? + + + 15 + + + + +Release Notes 2.3.5 $$ - recall last expression + + +2.3.5 $$ - recall last expression +---------------------------------- +The previously entered expression can be recalled at any stage whilst +using the Gofer interpreter (even if the list of currently loaded files +has subsequently been changed) by using the operator symbol $$: + + ? 42 + 42 + (1 reduction, 5 cells) + ? [$$] + [42] + (3 reductions, 12 cells) + ? [$$] + [[42]] + (5 reductions, 19 cells) + ? ($$, length $$) + ([[42]],1) + (14 reductions, 43 cells) + ? + +The $$ symbol is bound to a new value each time that an expression is +evaluated, or its type determined using the :t command: + + ? :t $$ + ([[42]],length [[42]]) :: ([[Int]],Int) + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? $$ + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (100 reductions, 189 cells) + ? + +Note that $$ can also be used when the last expression entered used +a where clause (such expressions are simply translated into the +appropriate let expressions): + + ? fibs where fibs = 0:1:zipWith (+) fibs (tail fibs) + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55^C{Interrupted!} + + (41 reductions, 136 cells) + ? :t $$ + let {...} in fibs :: [Int] + ? take 5 $$ + [0, 1, 1, 2, 3] + (24 reductions, 77 cells) + ? + +Note that $$ expands to the unevaluated form of the expression, so that +a certain amount of computation may be repeated if $$ is used more than +once in a subsequent expression: + + ? sum [1..10] + 55 + (92 reductions, 130 cells) + ? $$ + $$ + 110 + + + 16 + + + + +Release Notes 2.3.5 $$ - recall last expression + + + (176 reductions, 254 cells) + ? x + x where x = sum [1..10] + 110 + (89 reductions, 131 cells) + ? + +Note that the value of $$ is updated after the expression has been parsed +but before it is type checked: + + ? 42 + 42 + (1 reduction, 5 cells) + ? 4) + ERROR: Syntax error in input (unexpected `)') + ? $$ 4 + ERROR: Type error in application + *** expression : 42 4 + *** term : 42 + *** type : Int + *** does not match : a -> b + + ? + + +2.3.6 Command names +-------------------- +Command names of the form :X (where X represents an arbitrary capital +letter) are no longer supported. Each command has a mnemonic full name +of the form :name which can be abbreviated to :n where `n' is the first +letter of the full name. The complete list of commands produced by the +:? command is as follows: + + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :set set command line options + :set help on command line options + :? display this list of commands + evaluate expression + :type print type of expression + :names [pat] list names currently in scope + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + :find edit file containing definition of name + :! command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? + + + + + 17 + + + + +Release Notes 3. LANGUAGE DIFFERENCES + + +3. LANGUAGE DIFFERENCES + +There are very few changes to the language supported by Gofer -- most +programs that ran correctly under the previous release should run +without any changes. The features described in the following sections +are (for the most part) extensions to the previous version. + +3.1 c*p and p+k patterns +------------------------ +Motivated by recent discussion on the Haskell mailing list, starting +with a posting from Tony Davie, Gofer now supports a more general form +of n+k pattern, together with a new form of pattern, c*p. The syntax +of patterns is extended to include: + + pattern ::= .... | pattern + integer | integer * pattern + +Note that, in the previous version of Gofer, only variables were +permitted for the pattern p in a p+k pattern. Certain restrictions are +placed on the constants c and k used in c*p and p+k patterns; Gofer +currently requires c>1 and k>0. + +The semantics of these new patterns are described by the equations +(suggested by Kent Karlsson): + + case e0 of {p+k -> e; _ -> e'} + = if e0 >= k then case e0-k of {p -> e; _ -> e'} else e' + + case e0 of {c*p -> e; _ -> e'} + = if e0 >= 0 then case e0 `divRem` c of {(p, 0) -> e; _ -> e'} + else e' + +In Gofer, both forms of pattern match nonnegative integers only (there +is no possibility for overloading here as there is in Haskell). + +These features are included in Gofer to enable experimentation with the +use of c*p patterns. They are not currently supported by Haskell, and +are subject to change as we gain more experience using them. To +illustrate the potential uses for these extensions, here are two +examples provided by Tony Davie in his original message which can be +used in Gofer: + + x^^0 = 1 -- fast exponentiation + x^^(2*n) = xn*xn where xn = x^^n -- compare with definition + x^^(2*n+1) = x * x^^(2*n) -- of (^) in the prelude + + fib 1 = 1 -- fast fibonnacci + fib 2 = 1 + fib (2*n) = (fib(n+1))^^2 - (fib(n-1))^^2 + fib (2*n+1) = (fib(n+1))^^2 + (fib n )^^2 + + + + + + + + + + 18 + + + + +Release Notes 3.2 Errors during output + + +3.2 Errors during output +------------------------ +If an error of the form "error str" occurs during an output request in +a program using the facilities for I/O, the IOError value passed to +the failure continuation is the (WriteError str), rather than +(WriteError "{error str}") as in the previous release. This enables +further evaluation of the string str (for example to produce a +compound error message by concatenating several strings together). + +You are strongly advised to consider using the standard prelude +continuation "exit" in your programs in place of the "abort" predicate; +whereas "abort" causes a program to terminate without any indication of +the problem, "exit" attempts to print a suitable error message before +the program terminates. + + +3.3 Type synonyms in predicates +------------------------------- +Type synonyms may now be used in predicates (The previous release +allowed only data constructors). This means that programs such as the +cat program described in section 14.2.6 (page 68) of the Gofer +documentation can now be written as: + + class Cat a where cat :: a -> Dialogue + instance Cat String where cat n = showFile n done + instance Cat [String] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) + +This uses the type synonym String in place of the expanded form [Char] +required by the original program. Note that it is still not permitted +to define overlapping instances; an attempt to add an instance for Cat +[Char] to the above will not be accepted. + + +3.4 Reporting on ambiguous types +-------------------------------- +Class declarations whose member functions have ambiguous types are no +longer permitted. For example, in the class declaration: + + class Box a where + mem :: Int + +The type of the member function mem is Box a => Int which is ambiguous +and produces the error message: + + ERROR "examp" (line 3): Ambiguous type signature in class declaration + *** ambiguous type : Box a => Int + *** assigned to : mem + + ? + +Similar error messages are produced when an explicit type signature +includes an ambiguous type. For example: + + + + 19 + + + + +Release Notes 3.4 Reporting on ambiguous types + + + func :: Eq a => Int -> Int + func x = 2*x+1 + +Results in an error of the form: + + ERROR "examp" (line 12): Ambiguous type signature in type declaration + *** ambiguous type : Eq a => Int -> Int + *** assigned to : func + + ? + +By default, no error is signalled if an ambiguous type is assigned to a +variable or function by the type checker. This makes it possible to +write definitions such as: + + f y xs = if xs==[] then 0 else g y + g y = f y [] + +The types obtained for each of these terms is as follows: + + f :: Eq [a] => b -> [a] -> Int + g :: Eq [a] => b -> Int + +Note that the second type is ambiguous. Making the analogy between +these mutually recursive functions and a two state machine, we can +think of a direct call to f as initializing the machine correctly so +that there is no problem when we enter g. On the other hand, entering +the system at g does not initialize the machine correctly, as signalled +by the ambiguity. + +Using the +u command line flag forces Gofer to generate an error when +an attempt to assign an ambiguous type to a top-level function occurs. +For the above example this gives: + + ERROR "examp" (line 20): Ambiguous type signature in inferred type + *** ambiguous type : Eq [a] => b -> Int + *** assigned to : g + + ? + +The restriction to top-level functions means that f can still be +implemented by writing: + + f :: Eq [a] => b -> [a] -> Int + f = f' where f' y xs = if xs==[] then 0 else g y + g' y = f y [] + +which prevents external access to g' (preventing entry to the finite +machine described above in state g). Note that the type signature in +this example is necessary to avoid the monomorphism restriction. + + + + + + + + + 20 + + + + +Release Notes 4. OTHER MATTERS + + +4. OTHER MATTERS + +4.1 Contributions +----------------- +I would like to hear from anyone with interesting Gofer programs or +other useful items which might be included (with full credit to the +original author(s) of course!) in subsequent releases of Gofer. There +is already one example of this in the new release; a small gnuemacs +mode for running the Gofer interpreter from within gnuemacs on Unix +machines, contributed by Stuart Clayman. See the file gofer.el for +more details. + +4.2 Future directions +--------------------- +There will not be another release of Gofer for some time. There are +however a number of areas which I would like to investigate at some +point as extensions to the Gofer system: + + o The ability to use Haskell style type classes. + + o Facilities for working with modules, based on the approach + described in the Haskell report. A particular problem here is + in finding an elegant way to provide the full power of the + module system from the interactive environment. + + o The ability to write stand alone applications programs using + Gofer. + + o An improved user interface. There are a number of grand ideas + based on the use of windowing/mouse/pulldown-menus etc. The + current user interface is closer to this kind of approach than + might at first be realized. More interesting ideas include the + design of class, data type and value browsers, along the lines + of a Smalltalk system. + +I would be interested to hear from anyone with comments or suggestions +on any of these (or other ideas). + + + + + + + + + + + + + + + + + + + + + + 21 + + diff --git a/docs/release.228 b/docs/release.228 new file mode 100644 index 0000000..3c4e209 --- /dev/null +++ b/docs/release.228 @@ -0,0 +1,3234 @@ + + + + + +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.28 + + Copyright Mark P Jones 1993. + + Release notes +----------------------------------------------------------------------- + +This document is intended to be used as a supplement to the original +user manual ``An introduction to Gofer version 2.20'' and release +notes for Gofer 2.21 (previously supplied in a file called `update'). + +If you would like to be informed when bug-fixes or further versions +become available, please contact me at jones-mark@cs.yale.edu (if you +have not already done so) and I will add your name to the list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + + +ACKNOWLEDGMENTS: +A lot of people have contributed to the development of Gofer 2.28 with +their support, encouragement, suggestions, comments and bug reports. +There are a lot of people to thank: + + Ray Bellis Brent Benson + David Bolton Rodney Brown + Dave Cattrall Manuel Chakravarty + Rami El Charif Stuart Clayman + Andy Duncan Bernd Eckenfels + Stephen Eldridge Jeroen Fokker + Andy Gill Annius Groenink + Dipankar Gupta Guenter Huebel + Jon Hallett Kevin Hammond + Peter Hancock Ian Holyer + Andrew Kennedy Marnix Klooster + Tom Lane Hiroyuki Matsuda + Aiden McCaughey Tobias Nipkow + Rainer Orth Will Partain + Simon Peyton Jones Ian Poole + Mark Raemer Dave Rushall + Julian Seward Carol Tumey + Goran Uddeborg Gavin Wraith + Bryan Scattergood Matthew Smith + Bernard Sufrin Philip Wadler + +This list isn't complete, and I apologize in advance if I have +inadvertently left your name out. + + + 1 + + + + +Release Notes v2.28 1. MINOR ENHANCEMENTS AND BUGFIXES + + +1. MINOR ENHANCEMENTS AND BUGFIXES + +The following sections list the minor enhancements and bugfixes that +have been made to Gofer since the release of Gofer version 2.23. More +significant changes are described in later sections. + + +1.1 Enhancements +----------------- + o For systems without the restrictions of older PCs, Gofer now uses + multiple hash tables to speed the lookup of globally defined + functions. Loading large programs into Gofer is now much faster + as a result. In one example, the time taken to load a 13,000 line + program spread across 40 individual script files was reduced by a + factor of five! + + o For the most most part, internal errors (which shouldn't normally + appear anyway) no longer terminate the interpreter. + + o Better handling for programs with objects whose type involves more + than 26 type variables (though whether anyone has real practical + applications for such beasts, I'm rather doubtful). + + o The Gofer system now supports I/O requests GetProgName, GetArgs + and GetEnv. The first two requests don't have any sensible + interpretation within the interpreter, so GetProgName always + returns "", while GetArgs returns []. These I/O requests are most + useful when producing standalone applications with the Gofer + compiler where they do indeed give the name of the program and the + list of command line arguments as expected. + + o Added primitives for direct comparison of characters. The + original definitions of character equality and ordering in terms + of the equality and ordering on integers was elegant, but for some + examples, a substantial number of the total reductions in a given + program was taken up with calls to ord, an unnecessary + distraction. + + o Small improvements in the speed of execution of the runtime machine, + particularly when Gofer is compiled using the GNU C compiler. + + o Enabled the use of GNU C specific options to store frequently used + global variables in CPU registers. This is perhaps most useful + for speeding up the performance of standalone applications + produced using the Gofer compiler. + + o Changed definitions in standard preludes to provide overloaded + versions of sum, product, sums, products, abs, signum and (^). + Also added a genericLength function as in Haskell. Finally, + added Text as a superclass of Num, again for Haskell compatibility. + + o Added a new primitive function: openfile :: String -> String that + can be used to read the contents of a file (named by the argument + string) as a (lazy) stream of characters. (The implementation is + in terms of a primitive which can also be used to implement the + hbc openFile function, provided that you also define the Either + + + 2 + + + + +Release Notes v2.28 1.1 Enhancements + + + datatype used there.) + + o Added support for a simple selection of operators for monadic I/O, + mutable variables etc. based on Lambda var (developed at Yale) and + the Glasgow I/O system. I will provide more documentation on this + as soon as there is a better consensus on the names of the + datatypes and functions that should be included in systems like + this. + + o The error function is now implemented using a primitive function. + + o Added support for floating point primitives: + + pi :: Float + + sin, asin, + cos, acos, + tan, atan, + log, log10, + exp, sqrt :: Float -> Float + + atan2 :: Float -> Float -> Float + truncate :: Float -> Int + + o Added support for the use of GNU readline (or equivalent) library + to be used to enhance the user interface with command line + editing. See the source makefile for instructions on how to use + this. + + o Added floating point support to PC version of Gofer (even the + version for humble 8086 PCs will now support floating point). + Thanks to Jeroen Fokker for this! + + o I/O datatype definitions and otherwise symbol are now builtin to + the Gofer system. + + o Other minor tweaks and improvements. + + +1.2 Bug fixes +-------------- +Nobody really likes to dwell on bugs, especially when they have been +eliminated. But for those of you who want to know, here is a summary of +the bugs discovered and fixed in Gofer 2.28: + + o End of file does not imply end of line (only significant on + certain systems ... I has made an assumption which happens to hold + under DOS and Unix, but was not true for other systems). + + o Code generator produced incorrect code for some conditional + expressions involving local variables (fairly obscure). + + o Some conditional expressions entered into the interpreter were + evaluated incorrectly, leading to unexpected evaluation errors. + + o A small potential space leak concerned with saving the names of + + + 3 + + + + +Release Notes v2.28 1.2 Bug fixes + + + files passed to the editor from within Gofer was eliminated. + + o A subtle bug, which only occurred when a garbage collection + occurred in the middle of an attempt to update a cell with an + indirection has been fixed. + + o Fixing the definitions of the div and quot operators to agree with + Haskell 1.2 (these had been changed in the transition from 1.1 to + 1.2 without my noticing). + + o Corrected bug in string matching code (part of the :names command) + which previously allowed "*e*p" to match with "negate"! + + o Nested comments were not always handled correctly when they + occurred at the very end of a script file. + + o Added new clauses to parser to improve and correct error messages + produced by some examples. + + o Other miscellaneous tweaks and fixes. + +There are no other currently known bugs in Gofer. But someone is bound +to find a new one within hours of the release of 2.28 if past +experience is anything to go by. If that someone is you, please let me +know! + + +2. USER INTERFACE EXTENSIONS + +The user interface of the previous release has been extended a little +to support a range of new features, intended to make the Gofer +environment more convenient for program development. Further details +are given in the following sections. + +2.1 Customizing the Gofer system +--------------------------------- +Often there will be several people using Gofer on the same system. Not +everyone will want to be using the system in the same way. For example, +some users may wish to use their own version of the prelude or start the +interpreter with particular command line options. + +It has always been possible to do this by installing Gofer in an +appropriate manner. But, having had more than a couple of enquiries +about this, I wanted to take some time to spell the process out more +clearly. The following description will be biased towards those people +using Gofer on Unix-like systems, but the same basic principles can be +applied with other operating systems too. + +The Gofer interpreter and prelude files will typically be installed in +a given directory, accessible to all users on the system. For the sake +of this example, let's assume that this is /usr/local/lib/Gofer. Each +user could take a copy of the Gofer interpreter into their own file +space, but a much better option is for each user to use a short script +file stored somewhere on their path. For example, the path on my Unix +account includes a subdirectory called bin and I store the following +script file `gofer' in this directory: + + + 4 + + + + +Release Notes v2.28 2.1 Customizing the Gofer system + + + #!/bin/sh + # + # A simple shell script to invoke the Gofer interpreter and set + # the path to the prelude file. Ultimately, you might want to + # copy this file into your own bin directory so that you can record + # your favourite command line settings or use a different prelude + # file ... + # + GOFER=/usr/local/lib/Gofer/standard.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer $* + +I happen to use the standard prelude file and the default settings for +all the command line options. If, for example, I wanted to use a +different prelude file, a smaller heap and omit the printing of +statistics about the number of reductions and cells used in an +evaluation, I can modify the script to reflect this: + + #!/bin/sh + # + # A modified version of the above script + # + GOFER=/usr/local/lib/Gofer/simple.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer -h20000 -s $* + +Of course, it is also possible to keep both of these short scripts in +my bin directory, so that I have the choice of starting up Gofer in +several different configurations, depending on the kind of work I'm +going to be doing with it. + + +2.2 Command line options +-------------------------- +Gofer 2.28 supports a number of options which can be set, either on the +command line when Gofer interpreter is started, or using the :set +command within in the interpreter. Using the :set command without any +arguments produces a list of all the command line options available: + + ? :set + TOGGLES: groups begin with +/- to turn options on/off resp. + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Literate scripts as default + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + . Print dots to show progress + w Always show which files loaded + 1 Overload singleton list notation + k Show kind errors in full + + + 5 + + + + +Release Notes v2.28 2.2 Command line options + + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + rstr Set repeat last expression string to str + + Current settings: +sfceow1 -tdgliu.k -h100000 -p? -r$$ + ? + +Most of these are the same as in the previous release of Gofer. The +following sections outline the few changes that have been made. The +`1' and `k' toggles are for use with constructor classes and will be +described in Section 4. + + +2.2.1 Print dots to show progress +---------------------------------- +One of the first differences that you might notice when running the +new version of Gofer is that the rows of dots printed when loading a +script file: + + ? :l examples + Reading script file "examples": + Parsing.................................... + Dependency analysis........................ + Type checking.............................. + Compiling.................................. + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + +are no longer printed while script files are loaded. The rows of dots +are useful for showing progress on slow machines (like the PC on which +Gofer was originally developed) where it is reassuring to know that the +system has not crashed, and is simply working its way through one +particular phase of the system. However, on a faster system, the dots +are not necessary and printing them can impose a surprising overhead on +the time it takes to load files. As a default, Gofer now simply prints +the names of each phase (Parsing, Dependency Analysis, Type checking +and Compiling) and, when that phase is complete, backspaces over it to +erase it from the screen. If you are fortunate enough to be using a +fast machine, you may not always see the individual words as they flash +past. After loading a file, your screen will typically look something +like this: + + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + +On some systems, the use of backspace characters to erase a line may +not work properly. One particular example of this occurs if you try to + + + 6 + + + + +Release Notes v2.28 2.2.1 Print dots to show progress + + +run Gofer from within emacs. In this case, you may prefer to use the +original setting, printing the lines of dots by giving the command: + + :set +. + +The default setting is (as illustrated above, :set -.). In practice, +you will probably want to include the appropriate setting for this +option in your startup script (see Section 2.1). + + +2.2.2 Always show which files loaded +------------------------------------- +Some people may feel that the list of filenames printed by Gofer after +successfully loading one or more script files is redundant. This is +particularly likely if you are using the (usually default) :set -. +option since the list of files loaded will probably still be on the +screen. The list of filenames can be suppressed using the :set -w +option as follows: + + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? :set -w + ? :l examples + Reading script file "examples": + ? + +The default setting can be recovered using a :set +w command. + +Note that you can also use the :info command (without any arguments) as +described in Section 2.3.2 to find out the list of files loaded into the +current Gofer session. This should be particularly useful if you choose +the :set -w option. + + +2.2.3 Set repeat string +------------------------ +The previous expression entered into the Gofer system can be recalled +as part of the next expression using the symbol $$: + + ? map (1+) [1..10] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (101 reductions, 189 cells) + ? filter even $$ + [2, 4, 6, 8, 10] + (130 reductions, 215 cells) + ? + +This feature was provided and documented in the previous release of +Gofer. However, it is possible that you may prefer to use a different +character string. This is the purpose of the -rstr option which sets +the repeat string to str. For example, user's of SML might be more +comfortable using: + + + 7 + + + + +Release Notes v2.28 2.2.3 Set repeat string + + + ? :set -rit + ? 6*7 + 42 + (3 reductions, 7 cells) + ? it + it + 84 + (4 reductions, 11 cells) + ? + +Another reason for making this change might be that you have a program +which uses the symbol $$ as an operator. Each occurrence of the $$ symbol +in a script file will be interpreted as the correct operator, whatever +the value of the repeat string. But, if the default :set -r$$ setting is +used, any occurrence of $$ in an expression entered directly to the +evaluator will be taken as a reference to the previous expression. + +Note that the repeat string must be either a valid Haskell identifier or +symbol, although it will always be parsed as an identifier. If the +repeat string is set to a value which is neither an identifier or symbol +(for example, :set -r0) then the repeat last expression facility will be +disabled altogether. + + +2.2.4 Other changes +-------------------- +Comparing the list of command line options in Section 2.2 with the list +produced by previous versions of Gofer will reveal some other small +differences not already mentioned above. The changes are as follows: + + o The default setting for the d toggle (show dictionaries in output + expressions) has been changed to off (:set -d). For a lot of + people, the appearance of dictionary values was rather confusing + and of little use. If you still want to see how dictionary values + are used, you will need to do :set +d or add the +d argument to + your startup script. + + o The default setting for the e toggle (warn about errors in + literate scripts) has been changed to :set +e for closer + compatibility with the literate script convention outline in the + Haskell report, version 1.2. In addition, the setting of the l + toggle is now used only as a default if no particular type of + script file is specified by the file extension of a give script. + See Section 2.4 below for further details. + + o The default setting for the f toggle (terminate evaluation on + first error) has been changed to :set +f. The old setting of + :set -f is, in my opinion, better for debugging purposes, but + does not give the behaviour that those using Haskell might + expect. This has caused a certain amount of confusion and was + the motivation for this change. + + o The following three command line options, provided in previous + versions of Gofer, have now been removed: + + TOGGLES: + a Use any evidence, not nec. best + + + 8 + + + + +Release Notes v2.28 2.2.4 Other changes + + + E Fail silently if evidence not found + + OTHER OPTIONS: + xnum Set maximum depth for evidence search + + These options were only ever used for my own research and were + (intentionally) undocumented, so it seemed sensible to remove them + from the distributed system. A quick patch to the source code and + a recompilation is all that is necessary to reinstate these + options; useful if somebody out there found out about these + options and actually uses them (if you do, I'd love to know + why!). + + +2.3 Commands +------------- +The full list of commands that can be used from within the Gofer +interpreter are summarized using the command :? as follows: + + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + evaluate expression + :type print type of expression + :? display this list of commands + :set set command line options + :set help on command line options + :names [pat] list names currently in scope + :info describe named objects + :find edit file containing definition of name + :!command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? + +Almost all of these commands are the same as in the previous release. +The only new features are listed in the following sections. + + +2.3.1 Shell escapes +-------------------- +The shell escape command :! is used to enable you to run other programs +from within the Gofer interpreter. For example, on a Unix system, you +can print a list of all the files in the current directory by typing: + + ? :!ls + + ? + + + 9 + + + + +Release Notes v2.28 2.3.1 Shell escapes + + +The same thing can be achieved on a PC running DOS by typing: + + ? :!dir + + ? + +This is the same as in previous releases of Gofer; the only difference +is that there is no longer any need to type a space between the :! +command and the shell command that follows it. In fact, there is no +longer any need to type the leading colon either. Thus the two commands +above could equally well have been entered as: + + !ls + !dir + +To start a new shell from within Gofer, you can use the command :! or the +abbreviated form ! -- in Unix and DOS you can return to the Gofer system +by entering the shell command `exit'. This is likely to be different if +you use Gofer on other systems. + + +2.3.2 Information about named values +------------------------------------- +The :info command is a new feature which is useful for obtaining +information about the values currently loaded into a Gofer session. It +can be used to display information about all kinds of different values +including: + + o Datatypes: The name of the datatype and a list of its associated + constructor functions is printed: + + ? :info Request + -- type constructor + data Request + + -- constructors: + ReadFile :: String -> Request + WriteFile :: String -> String -> Request + AppendFile :: String -> String -> Request + ReadChan :: String -> Request + AppendChan :: String -> String -> Request + Echo :: Bool -> Request + GetArgs :: Request + GetProgName :: Request + GetEnv :: String -> Request + + ? + + o Type synonyms: Prints the name and expansion of the synonym: + + ? :info Dialogue + -- type constructor + type Dialogue = [Response] -> [Request] + + ? + + + + 10 + + + + +Release Notes v2.28 2.3.2 Information about named values + + + If the type synonym is restricted (see Section 3.1) then the + expansion is not included in the output: + + ? :info Stack + -- type constructor + type Stack a = + + ? + + o Type classes: Lists the type class name, superclasses, member + functions and instances: + + ? :info Eq + -- type class + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + instance Eq Int + instance Eq Float + instance Eq Char + instance Eq a => Eq [a] + instance (Eq a, Eq b) => Eq (a,b) + instance Eq Bool + + ? + + Note that the member functions listed for the class include the + class predicate as part of the type; the output is not intended + to be thought of as a syntactically valid class declaration. + + Overlapping instance declarations (see Section 3.2) are listed in + increasing order of generality. + + o Other values: for example, named functions and individual + constructor and member functions: + + ? :info map : <= + map :: (a -> b) -> [a] -> [b] + + (:) :: a -> [a] -> [a] -- data constructor + + (<=) :: Ord a => a -> a -> Bool -- class member + + ? + +As the last example shows, the :info command can take several arguments +and prints out information about each in turn. A warning message is +displayed if there are no known references to an argument: + + ? :info (:) + Unknown reference `(:)' + ? + + + + 11 + + + + +Release Notes v2.28 2.3.2 Information about named values + + +This illustrates that the arguments are treated as textual names for +operators, not syntactic expressions (for example, identifiers). The +type of the (:) operator can be obtained by giving the command :info : +as above. There is no provision for including wildcard characters of +any form in the arguments of :info commands. + +If a particular argument can be interpreted as, for example, a +constructor function, or a type constructor depending on context, both +possibilities are displayed. For example, loading a program containing +the definition: + + data Set a = Set [a] + +We obtain: + + ? :info Set + -- type constructor + data Set a + + -- constructors: + Set :: [a] -> Set a + + Set :: [a] -> Set a -- data constructor + + ? + +If no arguments are supplied to :info, a list of all the script files +currently loaded into the interpreter will be displayed: + + ? :info + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + + +2.4 Literate scripts +--------------------- +Support for literate scripts -- files in which program lines begin with +a `>' character and all other lines are treated as comments -- was +provided in previous versions of Gofer. The command line option +:set +l was used to force Gofer to treat each input file as a literate +script, while :set -l (the default) was used to treat each input file +as a standard script of definitions. + +In practice, this turned out to be somewhat inconvenient, particularly +when loading combinations of files, some as literate scripts, some +without. For example, quite a few people kept two versions of the +prelude, one as a literate script, one not, so that they wouldn't have +to fiddle with the settings or using the :set commands to load files. + +Gofer version 2.28 now uses a more sophisticated scheme to determine +how an input script file should be treated, based on the use of file +extensions. More specifically, any script file with a name ending in +one of the following suffixes: + + + 12 + + + + +Release Notes v2.28 2.4 Literate scripts + + + .hs .has .gs .gof .prelude + +will always be loaded as a normal (i.e. non-literate) script file, +regardless of the setting of the l command line option. In a similar +way, files with names ending in one of the following suffixes: + + .lgs .lhs .verb .lit + +will always be treated as literate scripts. The command line option l +is only used for files with names not ending in one of the above +suffixes. + +For example, the commands: + + :set -l + :load prog1.gs prog2 prog3.lgs + +will load prog1.gs and prog2 as non-literate scripts, and then load +prog3.lhs as a literate script. + + +2.5 Prelude files +------------------ +The Gofer system comes with a standard prelude, and a small number of +alternative preludes. These have always been there, but a lot of +people don't seem to have noticed these, so I thought I'd say a few +words about the different preludes included with Gofer: Remember that +you can always change the prelude you are using by setting the GOFER +environment variable or by modifying a startup script as described in +Section 2.1: + + standard.prelude The standard Gofer prelude, using type classes + and providing the familiar range of operators + and functions. + + nofloat.prelude A simplified version of the standard.prelude + which does not include any floating point + operators. This is likely to be of most use + for those using Gofer on PCs where memory is + at a premium; compiling a version of the + interpreter (or compiler runtime library) + without floating point support can give an + important saving. + + simple.prelude A prelude file based on the standard prelude + but without type classes. Let me emphasize + that point: YOU CAN USE GOFER WITHOUT HAVING + TO LEARN ABOUT TYPE CLASSES :-) Some people + seem to take to the use of type classes right + from the beginning. For those that have + problems understanding the technical details + or even the motivation, the simple.prelude + can be used to get you familiar with the syntax + of the language and the basic principles. + Then you can move up to the standard.prelude + when you're ready. The principle differences + + + 13 + + + + +Release Notes v2.28 2.5 Prelude files + + + can be described by listing the types of + commonly used operators in the simple.prelude: + + (==) :: a -> a -> Bool + (<=) :: a -> a -> Bool + (<) :: a -> a -> Bool + (>=) :: a -> a -> Bool + (>) :: a -> a -> Bool + (/=) :: a -> a -> Bool + show :: a -> String + (+) :: Int -> Int -> Int + (-) :: Int -> Int -> Int + (*) :: Int -> Int -> Int + (/) :: Int -> Int -> Int + + The resulting language is closer to the system + in Bird and Wadler (and can be made closer + still by editing the simple.prelude to use + zipwith instead of zipWith etc...). + + cc.prelude An extended version of the standard.prelude + including support for a number of useful + constructor classes. Most of the examples + and applications described in Section 4 are + based on this prelude. + + min.prelude A minimal prelude file. If you really want to + build a very small prelude for a particular + application, start with this and add the extra + things that you need. + +As you can see, the standard extension for prelude files is .prelude +and any file ending with this suffix will be read as a non-literate +script (as described in Section 2.4). Note that, even if you are using +a computer where the full name of a prelude file is not stored (for +example, on a DOS machine the standard.prelude file becomes +STANDARD.PRE) you should still specify the prelude file by its full +name to ensure that the Gofer system treats it correctly as a prelude +file. + +You are also free to construct your own prelude files, typically by +modifying one of the supplied preludes described above. Anyone who +created prelude files for use with previous releases of Gofer will need +to edit these files to ensure that they will work correctly. Note in +particular that there is no longer any need to include definitions of +the I/O datatypes in programs. Furthermore, the error function should +now be bound to the primitive "primError" rather than using the old +definition of error s | False = error s. + + +3. LANGUAGE DIFFERENCES + +This section outlines a number of small differences and extensions to +the language used by Gofer. These features are not included in the +definition of Haskell, so you shouldn't be thinking that programs +written using these features can ultimately be used with a full Haskell + + + 14 + + + + +Release Notes v2.28 3. LANGUAGE DIFFERENCES + + +system. The use of constructor classes -- a more substantial change is +described in Section 4. + +3.1 Restricted type synonyms +----------------------------- +Gofer 2.28 supports a form of restricted type synonym that can be used +to restrict the expansion of the synonym to a particular set of +functions. Outside of the selected group of functions, the synonym +constructor behaves like a standard datatype. More precisely, a +restricted type synonym definition is a top level declaration of the +form: + + type T a1 ... am = rhs in f1, ..., fn + +where T is the name of the restricted type synonym constructor and rhs +is a type expression typically involving some of the (distinct) type +variables a1, ..., am. The same kind of restrictions that apply to +normal type synonym declarations are also applied here. The major +difference is that the expansion of the type synonym can only be used +within the binding group of one of the functions f1, ..., fn (all of +which must be defined by top-level definitions in the file containing +the restricted type synonym definition). In the definition of any +other function, the type constructor T is treated as if it had been +introduced by a definition of the form: + + data T a1 ... am = ... + +The original motivation for restricted type synonyms came from my work +with constructor classes as described in Section 4 and you will several +examples of this in the ccexamples.gs file in the demos/Ccexamples +directory of the standard distribution. For a simpler example, +consider the following definition of a datatype of stacks in terms of +the standard list type: + + type Stack a = [a] in emptyStack, push, pop, top, isEmpty + +The definitions for the five functions named here are as follows: + + emptyStack :: Stack a + emptyStack = [] + + push :: a -> Stack a -> Stack a + push = (:) + + pop :: Stack a -> Stack a + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top :: Stack a -> a + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty :: Stack a -> Bool + isEmpty = null + +The type signatures here are particularly important. For example, + + + 15 + + + + +Release Notes v2.28 3.1 Restricted type synonyms + + +since emptyStack is mentioned in the definition of the restricted type +synonym Stack, the definition of emptyStack is type correct. The +declared type for emptyStack is Stack a which can be expanded to [a], +agreeing with the type for the empty list []. However, in an expression +outside the binding group of these functions, the Stack a type is quite +distinct from the [a] type: + + ? emptyStack ++ [1] + ERROR: Type error in application + *** expression : emptyStack ++ [1] + *** term : emptyStack + *** type : Stack a + *** does not match : [Int] + + ? + +The `binding group' of a value refers to the set of values whose +definitions are in the same mutually recursive group of bindings. In +particular, this does not extend to the type class system so we can +define instances such as: + + instance Eq a => Eq (Stack a) where + s1 == s2 | isEmpty s1 = isEmpty s2 + | isEmpty s2 = isEmpty s1 + | otherwise = top s1 == top s2 && pop s1 == pop s2 + +As a convenience, Gofer allows the type signatures of functions +mentioned in the type synonym declaration to be specified within the +definition rather than in a different point in the script. Thus the +example above could equally well have been written as: + + type Stack a = [a] in + emptyStack :: Stack a, + push :: a -> Stack a -> Stack a, + pop :: Stack a -> Stack a, + top :: Stack a -> a, + isEmpty :: Stack a -> Bool + + emptyStack = [] + + push = (:) + + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty = null + +However, the first form is necessary when you want to define two or +more restricted type synonyms simultaneously. For example: + + type Pointer = Int in allocate, deref, assign + type Heap a = [a] in newHeap, allocate, deref, assign + newHeap :: Heap a + + + 16 + + + + +Release Notes v2.28 3.1 Restricted type synonyms + + + allocate :: Heap a -> (Heap a, Pointer) + deref :: Heap a -> Pointer -> a + assign :: Heap a -> Pointer -> a -> Heap a + etc ... + +The use of restricted type synonyms doesn't quite provide proper +abstract data types. For example, if you try: + + ? push 1 emptyStack + [1] + (5 reductions, 11 cells) + ? + +then the structure of the stack as a list of values is revealed by the +printing mechanism. This happens because Gofer uses the show' function +to print out a value (in this case of type Stack Int) which looks inside +the structure of the object to see how it is represented. This happens +to be most convenient for use in an interpreter as an aid to debugging. +For the purists (and the preservation of abstraction), Gofer could be +modified to apply the (overloaded) show function to printed values. +This would force the programmer to define the way in which stack values +are printed (distinct from lists) and preserve the abstraction. Without +having set up this machinery, we get: + + ? show (push 1 emptyStack) + ERROR: Cannot derive instance in expression + *** Expression : show (push 1 emptyStack) + *** Required instance : Text (Stack Int) + + ? + +The Gofer compiler described in Section 5 does not implement show' and +hence enforces the abstraction. + + +3.2 Overlapping instance declarations +-------------------------------------- +This section describes a somewhat technical extension, aimed at those +who work with type classes. Many readers may prefer to skip to the +next section at this point. + +The definition of Haskell and previous versions of Gofer insist that no +two instance declarations for a given class may contain overlapping +predicates. Thus the declarations: + + class CX a where c :: a -> Int + + instance CX (a,Int) where c (x,y) = y + instance CX (Int,a) where c (x,y) = x + +are not allowed because the two predicates overlap: + + ERROR "misctest" (line 346): Overlapping instances for class "CX" + *** This instance : CX (Int,a) + *** Overlaps with : CX (a,Int) + *** Common instance : CX (Int,Int) + + + 17 + + + + +Release Notes v2.28 3.2 Overlapping instance declarations + + +As the error message indicates, given an expression c (1,2) it is not +clear whether we should use the first or the second instance +declarations to evaluate this, with potentially different results, 2 or +1 respectively. + +On the other hand, there are cases where this sort of thing might be +quite reasonable. For example, the standard function show prints lists +of characters as strings, but any other kind of list is printed using +the [ ... ] notation with the items separated by commas: + + ? show "Hello" + "Hello" + ? show [True,False,True] + [True,False,True] + ? show [1..10] + [1,2,3,4,5,6,7,8,9,10] + ? + +Haskell deals with this by an encoding using the showList function, but +a more obvious approach might be to define two instances: + + instance Text a => Text [a] where ... print using [ ... ] notation + instance Text [Char] where ... print as string + +Other examples might include providing optimized versions of primitives +for particular frequently use operators, or providing a default +behaviour as in: + + class Eq a where (==) = error "no definition of equality specified" + +Haskell requires the context of an overloaded function to be reduced to +a form where the only predicates that it contains are of the form C a. +This means that the inferred type of an object may be simplified before +the full type of that object is known. For example, we might define a +function: + + f x = show [x,x] + +The inferred type in Haskell is f :: Text a => a -> String and the +decision about which of the two instance declarations above should be +used has already been forced on us. To see this, note that f 'a' would +evaluate to the string "['a', 'a']". But if we allowed the second +instance declaration above to be used, show ['a', 'a'] would evaluate +to "aa". This breaks a fundamental property of the language where we +expect to be able to replace one subexpression with another equal term +and obtain the same result. + +In Gofer, the type system is a little different and the inferred type +is f :: Text [a] => a -> String. The decision about which instance +declaration to use is postponed until the type assigned to 'a' is +known. Thus both f 'a' and show ['a', 'a'] evaluate to "aa" without +any contradiction. + +Although the type system in Gofer has always been able to support the +use of certain overlapping instance declarations, previous versions of +the system imposed stronger static restrictions which prohibited their + + + 18 + + + + +Release Notes v2.28 3.2 Overlapping instance declarations + + +use. Gofer 2.28 relaxes these restrictions by allowing a program to +contain overlapping instance declarations so long as: + + o One of the instance predicates being declared is a substitution + instance of the other. Thus: + + instance Eq [Char] where ... -- OK + instance Eq a => Eq [a] where ... + + is permitted because the second predicate, Eq [a], is more general + than the first, Eq [Char], which can be obtained by substituting + Char for the type variable a. However, the example at the + beginning of this section: + + instance CX (a,Int) where ... -- ILLEGAL + instance CX (Int,a) where ... + + is not allowed since neither (a,Int) or (Int,a) is a substitution + instance of the other (even though they have a common instance + (Int,Int)). + + o The two instances declared are not identical. This rules out + examples like: + + instance Eq Char where ... -- ILLEGAL + instance Eq Char where ... + +The features described here are added principally for experimentation. +I have some particular applications that I want to try out (which is +why I actually implemented these ideas) but I would also be very +interested to hear from anyone else that makes use of this extension. + + +3.3 Parsing Haskell syntax +--------------------------- +From correspondence that I have received, quite a few people use Gofer +to develop programs which, ultimately, will be compiled and executed +using a Haskell system. Although the syntax of the two languages is +quite similar, it has been necessary to comment out module headers and +other constructs in Haskell programs before they could be used with +previous version of Gofer. + +The new version of the Gofer system is now able to parse these +additional constructs (and will generate an error message if a syntax +error occurs). However: NO ATTEMPT IS MADE TO INTERPRET OR USE THE +INFORMATION PROVIDED BY THESE ADDITIONAL CONSTRUCTS. This feature is +provided purely for the convenience of those people using Gofer and +Haskell in the manner described above. Gofer does not currently +support any notion of modules beyond the use of separate script files. + +The following changes have been made: + + o The identifiers: + + deriving default module interface + import renaming hiding to + + + 19 + + + + +Release Notes v2.28 3.3 Parsing Haskell syntax + + + are now reserved words in Gofer. Any program that uses one of + these as an identifier with an older version of Gofer will need + to be modified to use a different name instead. + + o Module headers and import declarations may be included in a Gofer + program using the syntax set out in version 1.2 of the Haskell + report. Several modules may be included in a single file (but of + course, Gofer makes no distinction between the sections of code + appearing in different `modules'). + + o Datatype definitions may include deriving clauses such as: + + data Maybe a = Just a | Nothing deriving (Eq, Text) + + although no derived instances will actually be generated. + If you need these facilities, you might consider writing out + the instances of the type classes concerned yourself in a + separate file which can be loaded when you run your program + with Gofer, but which are omitted when you compile it with a + proper Haskell system. + + o Programs may include default declarations, although, once again, + these are ignored; for example, there is no restriction on the + forms of type that can be included in a default declaration, nor + will an error occur if a single module includes multiple default + declarations. + + +3.4 Local definitions in comprehensions +---------------------------------------- +We all make mistakes. The syntax for Gofer currently permits a local +definition to appear in a list comprehension (and indeed, in the monad +comprehensions described in the next section): + + [ (x,y) | x <- xs, y = f x, p y ] + +This example is implemented by translating it to something equivalent +to: + + map h xs where h [] = [] + h (x:xs) = let y = f x + in if p y then (x,y) : h xs + else h xs + +It is cumbersome to rewrite this using list comprehensions without +local definitions: + + concat [ let y = f x in [ (x,y) | p y ] | x <- xs ] + +so we might resort to the `hack' of writing: + + [ y | x <- xs, y <- [f x], p y ] + +which works (but doesn't extend to recursive bindings, and is really an +inappropriate use for a list; a list is used to represent a sequence of +zero or more objects, so using a list when you know that there is + + + 20 + + + + +Release Notes v2.28 3.4 Local definitions in comprehensions + + +always going to be exactly one element seems unnecessary). So, to +summarize, I still think that local definitions can be useful in +comprehensions. + +So where is the mistake I mentioned? The problem is with the SYNTAX. +First, it is rather easy to confuse the comprehension above with the +comprehension: + + [ (x,y) | x <- xs, y == f x, p y ], + +leading to errors which are hard to detect. The second is that the +syntax is too restrictive; you can only give relatively simple local +declarations -- mutually recursive definitions and function bindings +are not permitted. + +Gofer 2.28 now supports a new syntax for local definitions in +comprehensions. The old syntax is still supported, for compatibility +with previous releases, but will be deleted in the next public release +(assuming I remember). Local declarations can now be included in a +comprehension using a qualifier of the form let { decls }. So the +comprehension at the beginning of this section can also be written: + + [ (x,y) | x <- xs, let {y = f x}, p y ] + +Note that the braces cannot usually be omitted in Gofer due to an +undocumented extension to the syntax of Gofer function declarations. +The braces would not be needed if this syntax were added to a standard +Haskell system. + +This extension means that it is now possible to write comprehensions +such as: + + [ (x,y,z) | x <- xs, let { y = f x z; + z = g x y; + f n = h n [] }, p x y z ] + +Once again, this is still an experimental feature. I suspect it will +be of most use to anyone making substantial use of monad comprehensions +as described in the next section. + + +4. CONSTRUCTOR CLASSES + +[This is a long section; if you are not interested in experimenting +with Gofer's system of constructor classes, you can skip straight ahead +to the next section without missing anything. Of course, if you don't +know what a constructor class is, you might want to read at least some +of this section before you can make that decision.] + +One of the biggest changes in Gofer version 2.28 is the provision of +support for constructor classes. This section provides an overview of +constructor classes which should hopefully, in conjunction with the +example supplied with the full distribution, be enough to get you +started. More technical details about constructor classes can be +obtained by contacting me. + + + + 21 + + + + +Release Notes v2.28 4. CONSTRUCTOR CLASSES + + +Some of the following introduction here (particularly sections 4.1 and +4.2) may seem somewhat familiar to those of you have already read one +of the papers that I have written on the subject although I have added +some more information about the Gofer implementation. + +Others may find that this section of the documentation seems rather +technical; try not to be put off at first sight. Looking through the +examples and the documentation, you may find it is easier to understand +than you expect! + +A final comment before starting: there is, as yet, no strong consensus +on the names and syntax that would be best for monad operations, +comprehensions etc. If you have any opinions, or proposals which +differ from what you see here, please let me know ... I'd be very +interested to hear other people's opinions on this. + + +4.1 An overloaded map function +------------------------------- +Many functional programs use the map function to apply a function to +each of the elements in a given list. The type and definition of this +function as given in the Gofer standard prelude are as follows: + + map :: (a -> b) -> ([a] -> [b]) + map f [] = [] + map f (x:xs) = f x : map f xs + +It is well known that the map function satisfies the familiar laws: + + map id = id + map f . map g = map (f . g) + +A category theorist will recognize these observations as indicating +that there is a functor from types to types whose object part maps any +given type a to the list type [a] and whose arrow part maps each +function f::a -> b to the function map f :: [a] -> [b]. A functional +programmer will recognize that similar constructions are also used with +a wide range of other data types, as illustrated by the following +examples: + + data Tree a = Leaf a | Tree a :^: Tree a + + mapTree :: (a -> b) -> (Tree a -> Tree b) + mapTree f (Leaf x) = Leaf (f x) + mapTree f (l :^: r) = mapTree f l :^: mapTree f r + + data Maybe a = Just a | Nothing + + mapMaybe :: (a -> b) -> (Maybe a -> Maybe b) + mapMaybe f (Just x) = Just (f x) + mapMaybe f Nothing = Nothing + +Each of these functions has a similar type to that of the original map +and also satisfies the functor laws given above. With this in mind, it +seems a shame that we have to use different names for each of these +variants. + + + 22 + + + + +Release Notes v2.28 4.1 An overloaded map function + + +A more attractive solution would allow the use of a single name map, +relying on the types of the objects involved to determine which +particular version of the map function is required in a given +situation. For example, it is clear that map (1+) [1,2,3] should be +a list, calculated using the original map function on lists, while +map (1+) (Just 1) should evaluate to Just 2 using mapMaybe. + +Unfortunately, in a language using standard Hindley/Milner type +inference, there is no way to assign a type to the map function that +would allow it to be used in this way. Furthermore, even if typing +were not an issue, use of the map function would be rather limited +unless some additional mechanism was provided to allow the definition +to be extended to include new datatypes perhaps distributed across a +number of distinct program files. + + +4.1.1 An attempt to define map using type classes +-------------------------------------------------- +The ability to use a single function symbol with an interpretation that +depends on the type of its arguments is commonly known as overloading. +In Gofer, overloading is implemented using type classes -- which can be +thought of as sets of types. For example, the Eq class defined by: + + class Eq a where + (==), (/=) :: a -> a -> Bool + +(together with an appropriate set of instance declarations) is used to +describe the set of types whose elements can be compared for equality. +The standard prelude for Gofer includes integers, floating point +numbers, characters, booleans, lists (in which the type of the members +is also in Eq) and so forth. There is no need for all the definitions +of equality to be combined in a single script file; new definitions of +equality are typically included each time a new datatype is defined. + +Functions such as nub, defined in the standard prelude as: + + nub :: Eq a => [a] -> [a] -- remove duplicates from list + nub [] = [] + nub (x:xs) = x : nub (filter (x/=) xs) + +can be used with any choice of type for the type variable a so long as +it is an instance of Eq. Only a single definition of the nub function +is required. + +Unfortunately, the system of type classes is not sufficiently powerful +to give a satisfactory treatment for the map function; to do so would +require a class Map and a type expression m(t) involving the type +variable t such that S = { m(t) | t is a member of Map } includes (at +least) the types: + + { (a -> b) -> ([a] -> [b]), + (a -> b) -> (Tree a -> Tree b), + (a -> b) -> (Maybe a -> Maybe b), .... + | a and b arbitrary types } + + + + + 23 + + + + +Release Notes v2.28 4.1.1 An attempt to define map using type classes + + +The only possibility is to take m(t) = t and choose Map as the set of +types S for which the map function is required: + + class Map t where map :: t + + instance Map ((a -> b) -> ([a] -> [b])) where ... + instance Map ((a -> b) -> (Tree a -> Tree b)) where ... + instance Map ((a -> b) -> (Maybe a -> Maybe b)) where ... + +This syntax is permitted in Gofer (but not in Haskell) but it does not +give a sufficiently accurate characterization of the type of map to be +of much use. For example, the principal type of \i j -> map j . map i +is: + + (Map (a -> c -> e), Map (b -> e -> d)) => a -> b -> c -> d + +(a and b are the types of i and j respectively). This is complicated +and does not enforce the condition that i and j have function types. +Furthermore, the type is ambiguous (the type variable e does not appear +to the right of the => symbol or in the assumptions). Under these +conditions, we cannot guarantee a well-defined semantics for this +expression. Other attempts to define the map function, for example +using multiple parameter type classes, have also failed for essentially +the same reasons. + + +4.1.2 A solution using constructor classes +------------------------------------------- +A much better approach is to notice that each of the types for which +the map function is required is of the form: + + (a -> b) -> (f a -> f b). + +The variables a and b here represent arbitrary types while f ranges +over the set of type constructors for which a suitable map function has +been defined. In particular, we would expect to include the list +constructor (which we write as [] in Gofer), Tree and Maybe as elements +of this set. Motivated by our earlier comments we will call this set +Functor. With only a small extension to the Gofer syntax for type +classes this can be described by: + + class Functor f where + map :: (a -> b) -> (f a -> f b) + + instance Functor [] where + map f [] = [] + map f (x:xs) = f x : map f xs + + instance Functor Tree where + map f (Leaf a) = Leaf (f a) + map f (l :^: r) = map f l :^: map f r + + instance Functor Maybe where + map f (Just x) = Just (f x) + map f Nothing = Nothing + + + + 24 + + + + +Release Notes v2.28 4.1.2 A solution using constructor classes + + +Functor is our first example of a constructor class. The following +extract illustrates how the definitions for Functor work in practice: + + ? map (1+) [1,2,3] + [2, 3, 4] + (15 reductions, 44 cells) + ? map (1+) (Leaf 1 :^: Leaf 2) + Leaf 2 :^: Leaf 3 + (10 reductions, 46 cells) + ? map (1+) (Just 1) + Just 2 + (4 reductions, 17 cells) + ? + +Furthermore, by specifying the type of map function more precisely, +we avoid the ambiguity problems mentioned above. For example, the +principal type of \i j -> map j . map i is simply: + + Functor f => (a -> b) -> (b -> c) -> f a -> f c + +which is not ambiguous, and makes the types of i and j as (a -> b) +and (b -> c) respectively. + +[You can try these examples yourself using the Gofer system. The first +thing you need to do is start Gofer using the file cc.prelude instead +of the usual Gofer standard.prelude. The cc.prelude includes the +definition of the functor class and the instance for Functor []. The +remaining two instance declarations are included (along with lots of +other examples) in the file ccexamples.gs in the demos/Ccexamples +subdirectory of the standard distribution.] + + +4.1.3 The kind system +---------------------- +Each instance of Functor can be thought of as a function from types to +types. It would be nonsense to allow the type Int of integers to be an +instance of Functor, since the type (a -> b) ->(Int a -> Int b) is +obviously not well-formed. To avoid unwanted cases like this, we have +to ensure that all of the elements in any given class are of the same +kind. + +To do this, we formalize the notion of kind, writing * for the kind of +all types and k1 -> k2 for the kind of a constructor which takes +something of kind k1 and returns something of kind k2. This notion +comes is motivated by some theoretical work by Henk Barendregt on the +subject of `Generalized type systems'; Do not confuse this with the use +of the symbol * in a certain well-known functional language where it +represents a type variable. These things are completely different! + +Rather than thinking only of types we work with constructors which +include types as a special case. Constructors take the form: + + Constructor ::= ConstructorConstant + | Constructor1 Constructor2 + | variable + + + + 25 + + + + +Release Notes v2.28 4.1.3 The kind system + + +This corresponds very closely to the way that most type expressions +are already written in Gofer. For example, Tree a is an application +of the constructor constant Tree to the variable a. Gofer has some +special syntax for tuple, list and function types. The corresponding +constructors can also be written directly in Gofer. For example: + + a -> b = (->) a b + [a] = [] a + (a,b) = (,) a b + (a,b,c) = (,,) a b c + etc ... + +Each constructor constant has a corresponding kind. For example: + + Int, Float, () :: * + [], Tree, Maybe :: * -> * + (->), (,) :: * -> * -> * + (,,) :: * -> * -> * -> * + +Applying one constructor C :: k1 -> k2 to a construct C' :: k1 gives +a constructor expression C C' with kind k2. Notice that this is just +the same sort of thing you would expect from applying a function of +type a -> b to an value of type b; kinds really are very much like +`types for constructors'. + +Instead of checking that type expressions contain the correct number of +arguments for each type constructor, we need to check that any type +expression has kind *. In a similar way, all of the elements of a +constructor class must have the same kind; for example, a constructor +class constraint of the form Functor f is only valid if f is a +constructor expression of kind * -> *. Note also that our system +includes Gofer/Haskell type classes as a special case; a type class is +simply a constructor class for which each instance has kind *. Multiple +parameter classes can also be dealt with in the same way, using a tuple +of kinds (k1,...,kn) to indicate the kind of constructors required for +each argument. + +The language of constructors is essentially a system of combinators +without any reduction rules. As such, standard techniques can be +used to infer the kinds of constructor variables, constructor constants +introduced by new datatype definitions and the kind of the elements +held in any particular constructor class. The important point is that +there is no need -- and indeed, in our current implementation, no +opportunity -- for the programmer to supply kind information +explicitly. We regard this as a significant advantage since it means +that the programmer can avoid much of the complexity that might +otherwise result from the need to annotate type expressions with +kinds. + + +4.2 Monads as an application of constructor classes +---------------------------------------------------- +Motivated by the work of Moggi and Spivey, Wadler has proposed a style +of functional programming based on the use of monads. While the theory +of monads had already been widely studied in the context of abstract +category theory, Wadler introduced the idea that monads could be used + + + 26 + + + + +Release Notes v2.28 4.2 Monads as an application of constructor classes + + +as a practical method for modeling so-called `impure' features in a +purely functional programming language. + +The examples in this and following sections illustrate that the use of +constructor classes can be particularly convenient for programming in +this style. You will also find a lot more examples prepared for use +with Gofer in the file ccexamples in the demos/Ccexamples subdirectory +of the standard distribution. + + +4.2.1 A framework for programming with monads +---------------------------------------------- +The basic motivation for the use of monads is the need to distinguish +between computations and the values that they produce. If m is a monad +then an object of type (m a) represents a computation which is expected +to produce a value of type a. These types reflect the fact that the +use of particular programming language features in a given calculation +is a property of the computation itself and not of the result that it +produces. + +Taking the approach outlined by Wadler in his paper `The Essence of +Functional Programming' (POPL '92), we introduce a constructor class of +monads using the definition: + + class Functor m => Monad m where + result :: a -> m a + join :: m (m a) -> m a + bind :: m a -> (a -> m b) -> m b + + join x = bind x id + x `bind` f = join (map f x) + +The expression Functor m => Monad m defines Monad as a subclass of +Functor ensuring that, for any given monad, there will also be a +corresponding instance of the overloaded map function. The use of a +hierarchy of classes enables us to capture the fact that not every +instance of Functor can be treated as an instance of Monad in any +natural way. + +[If you are familiar with either my previous papers or Wadler's +writings on the use of monads, you might notice that the declaration +above uses the name `result' in place of `return' or `unit' that have +been previously used for the same thing. The latter two choices have +been used elsewhere for rather different purposes, and there is +currently no clear picture of which names should be used. The +identifier `result' is the latest in a long line of attempts to find a +name which both conveys the appropriate meaning and is not already in +use for other applications.] + +By including default definitions for bind and join we only need to give +a definition for one of these (in addition to a definition for result) +to completely define an instance of Monad. This is often quite +convenient. On the other hand, it would be an error to omit +definitions for both operators since the default definitions are +clearly circular. We should also mention that the member functions in +an instance of Monad are expected to satisfy a number of laws which are + + + 27 + + + + +Release Notes v2.28 4.2.1 A framework for programming with monads + + +not reflected in the class definition above. + +The following declaration defines the standard monad structure for the +list constructor [] which can be used to describe computations +producing multiple results, corresponding to a simple form of +non-determinism: + + instance Monad [] where + result x = [x] + [] `bind` f = [] + (x:xs) `bind` f = f x ++ (xs `bind` f) + +As a second example, the monad structure for the Maybe datatype, which +might be used to describe computations which fail to produce any value +at all if an error condition occurs, can be described by: + + instance Monad Maybe where + result x = Just x + Just x `bind` f = f x + Nothing `bind` f = Nothing + +Another interesting use of monads is to model programs that make use of +an internal state. Computations of this kind can be represented by +functions of type s-> (a,s) (often referred to as state transformers) +mapping an initial state to a pair containing the result and final +state. In order to get this into the appropriate form for the Gofer +system of constructor classes, we introduce a new datatype: + + data State s a = ST (s -> (a,s)) + +The functor and monad structures for state transformers are as follows: + + instance Functor (State s) where + map f (ST st) = ST (\s -> let (x,s') = st s in (f x, s')) + + instance Monad (State s) where + result x = ST (\s -> (x,s)) + ST m `bind` f = ST (\s -> let (x,s') = m s + ST f' = f x + in f' s') + +Notice that the State constructor has kind * -> * -> * and that the +declarations above define State s as a monad and functor for any state +type s (and hence State s has kind * -> * as required for an instance +of these classes). There is no need to assume a fixed state type. + +From a user's point of view, the most interesting properties of a monad +are described, not by the result, bind and join operators, but by the +additional operations that it supports. The following examples are +often useful when working with state monads. The first can be used to +`run' a program given an initial state and discarding the final state, +while the second might be used to implement an integer counter in a +State Int monad: + + startingWith :: State s a -> s -> a + ST m `startingWith` s0 = result where (result,_) = m s0 + + + 28 + + + + +Release Notes v2.28 4.2.1 A framework for programming with monads + + + incr :: State Int Int + incr = ST (\s -> (s,s+1)) + +To illustrate the use of state monads, consider the task of labeling +each of the nodes in a binary tree with distinct integer values. One +simple definition is: + + label :: Tree a -> Tree (a,Int) + label tree = fst (lab tree 0) + where lab (Leaf n) c = (Leaf (n,c), c+1) + lab (l :^: r) c = (l' :^: r', c'') + where (l',c') = lab l c + (r',c'') = lab r c' + +This uses an explicit counter (represented by the second parameter to +lab) and great care must be taken to ensure that the appropriate +counter value is used in each part of the program; simple errors, such +as writing c in place of c' in the last line, are easily made but can +be hard to detect. + +An alternative definition, using a state monad and following the +layout suggested in Wadler's POPL paper, can be written as follows: + + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = incr `bind` \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l `bind` \l' -> + lab r `bind` \r' -> + result (l' :^: r') + +While this program is perhaps a little longer than the previous +version, the use of monad operations ensures that the correct counter +value is passed from one part of the program to the next. There is no +need to mention explicitly that a state monad is required: The use of +startingWith and the initial value 0 (or indeed, the use of incr on its +own) are sufficient to determine the monad State Int needed for the +bind and result operators. It is not necessary to distinguish between +different versions of the monad operators bind, result and join or to +rely on explicit type declarations. + + +4.2.2 Monad comprehensions +--------------------------- +Several functional programming languages provide support for list +comprehensions, enabling some common forms of computation with lists to +be written in a concise form resembling the standard syntax for set +comprehensions in mathematics. In his paper `Comprehending Monads' +(ACM Lisp and Functional Programming, 1990), Wadler made the +observation that the comprehension notation can be generalized to +arbitrary monads, of which the list constructor is just one special +case. + +In Wadler's notation, a monad comprehension is written using the syntax +of a list comprehension but with a superscript to indicate the monad in +which the comprehension is to be interpreted. This is a little awkward + + + 29 + + + + +Release Notes v2.28 4.2.2 Monad comprehensions + + +and makes the notation less powerful than might be hoped since each +comprehension is restricted to a particular monad. Using the +overloaded operators described in the previous section, Gofer provides +a more flexible form of monad comprehension which relies on overloading +rather than superscripts. At the time of writing, this is the only +concrete implementation of monad comprehensions known to us. + +In our system, a monad comprehension is an expression of the form +[e | qs ] where e is an expression and gs is a list of generators of +the form p <- exp. As a special case, if gs is empty then the +comprehension [ e | qs ] is written as [ e ]. The implementation of +monad comprehensions is based on the following translation of the +comprehension notation in terms of the result and bind operators +described in the previous section: + + [ e ] = result e + [ e | p <- exp, qs ] = exp `bind` \p -> [ e | qs ] + +In this notation, the label function from the previous section can +be rewritten as: + + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = [ Leaf (n,c) | c <- incr ] + lab (l :^: r) = [ l :^: r | l <- lab l, r <- lab r ] + +Applying the translation rules for monad comprehensions to this +definition yields the previous definition in terms of result and bind. +The principal advantage of the comprehension syntax is that it is often +more concise and, in the author's opinion, sometimes more attractive. + + +4.2.3 Monads with a zero +------------------------- +Assuming that you are familiar with Gofer's list comprehensions, you +will know that it is also possible to include boolean guards in +addition to generators in the definition of a list comprehension. Once +again, Wadler showed that this was also possible in the more general +setting of monad comprehensions, so long as we restrict such +comprehensions to monads that include a special element zero satisfying +a small number of laws. This can be dealt with in our framework by +defining a subclass of Monad: + + class Monad m => Monad0 m where + zero :: m a + +For example, the List monad has the empty list as a zero element: + + instance Monad0 [] where zero = [] + +Note that not there are also some monads which do not have a zero +element and hence cannot be defined as instances of Monad0. The +State s monads described in Section 4.2.1 are a simple example of +this. + +Working in a monad with a zero, a comprehension involving a boolean + + + 30 + + + + +Release Notes v2.28 4.2.3 Monads with a zero + + +guard can be implemented using the translation: + + [ e | guard, qs ] = if guard then [ e | qs ] else zero + +Notice that, as far as the type system is concerned, the use of +zero in the translation of a comprehension involving a guard automatically +captures the restriction to monads with a zero: + + ? :t \x p -> [ x | p x ] + \x p -> [ x | p x ] :: Monad0 b => a -> (a -> Bool) -> b a + ? + +The inclusion of a zero element also allows a slightly different +translation for generators in comprehensions: + + [ e | p <- exp, qs ] = exp `bind` f + where f p = [ e | qs ] + f _ = zero + +This corresponds directly to the semantics of standard Gofer list +comprehensions, but only differs from the semantics of the translation +given in the previous section when p is an irrefutable pattern; i.e. +when p is a pattern which may not match the value (or values) generated +by exp. You can see the difference by trying the following example +in Gofer: + + ? [ x | [x] <- [[1],[],[2]]] + [1, 2] + (9 reductions, 31 cells) + ? map (\[x] -> x) [[1],[],[2]] + [1, + Program error: {v157 []} + (8 reductions, 66 cells) + + ? + +In order to retain compatibility with the standard list comprehension +notation, Gofer always uses the second translation above for generators +if the pattern p is refutable. This may sometimes give inferred types +which are more restrictive than you expect. For example, tuples are +not irrefutable patterns in Gofer or Haskell, and so the function: + + ? :t \xs -> [ x | (x,y) <- xs ] + \xs -> [ x | (x,y)<-xs ] :: Monad0 a => a (b,c) -> a b + ? + +is restricted to monads with a zero because the expanded translation +above is used. You can always avoid this problem by using the lazy +pattern construct (i.e. the tilde operator, ~p) as in: + + ? :t \xs -> [ x | ~(x,y) <- xs ] + \xs -> [ x | ~(x,y)<-xs ] :: Monad a => a (b,c) -> a b + ? + +[At one stage, I was using a different form of brackets to represent +monad comprehensions, implemented using the original translation to + + + 31 + + + + +Release Notes v2.28 4.2.3 Monads with a zero + + +avoid changing the semantics of list comprehensions. But I finally +decided that it would be better to use standard comprehension notation +with lazy pattern annotations where necessary since this is less +cumbersome than writing \xs -> [| x | (x,y) <- xs |] in place of the +comprehension above. Please let me know what you think!] + + +4.2.4 Generic operations on monads +----------------------------------- +The combination of polymorphism and constructor classes in our system +makes it possible to define generic functions which can be used on a +wide range of different monads. A simple example of this is the +`Kleisli composition' for an arbitrary monad, similar to the usual +composition of functions except that it also takes care of `side +effects'. The general definition is as follows: + + (@@) :: Monad m => (a -> m b) -> (c -> m a) -> (c -> m b) + f @@ g = join . map f . g + +For example, in a monad of the form State s, the expression f @@ g +denotes a state transformer in which the final state of the computation +associated with g is used as the initial state for the computation +associated with f. More precisely, for this particular kind of monad, +the general definition given above is equivalent to: + + (@@) :: (b -> State s c) -> (a -> State s b) -> (a -> State s c) + f @@ g = \a -> STM (\s0 -> let ST g' = g a + (b,s1) = g' s0 + ST f' = f b + (c,s2) = f' s1 + in (c,s2)) + +The biggest advantage of the generic definition is that there is no +need to construct new definitions of (@@) for every different monad. +On the other hand, if specific definitions were required for some +instances, perhaps in the interests of efficiency, we could simply +include (@@) as a member function of Monad and use the generic +definition as a default implementation. + +Generic operations can also be defined using the comprehension +notation: + + mapl :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapl f [] = [ [] ] + mapl f (x:xs) = [ y:ys | y <- f x, ys <- mapl f xs ] + +This is the same as mapping a function down the elements of a list +using the normal map function except that, in the presence of side +effects, the order in which the applications are carried out is +important. For mapl, we start on the left (i.e. the front of the list) +and work towards the right. There is a corresponding dual which works +in the reverse direction: + + mapr :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapr f [] = [ [] ] + mapr f (x:xs) = [ y:ys | ys <- mapr f xs, y <- f x ] + + + 32 + + + + +Release Notes v2.28 4.2.4 Generic operations on monads + + +These general functions have applications in several kinds of monad +with examples involving state and output. + +The comprehension notation can also be used to define a generalization +of Haskell's filter function which works in an arbitrary monad with a +zero: + + filter :: Monad0 m => (a -> Bool) -> m a -> m a + filter p xs = [ x | x<-xs, p x ] + +There are many other general purpose functions that can be defined +in the current framework and used in arbitrary monads. To give you +some further examples, here are generalized versions of the foldl and +foldr functions which work in an arbitrary monad: + + mfoldl :: Monad m => (a -> b -> m a) -> a -> [b] -> m a + mfoldl f a [] = result a + mfoldl f a (x:xs) = f a x `bind` (\fax -> mfoldl f fax xs) + + mfoldr :: Monad m => (a -> b -> m b) -> b -> [a] -> m b + mfoldr f a [] = result a + mfoldr f a (x:xs) = mfoldr f a xs `bind` (\y -> f x y) + +[Generalizing these definitions (and those of mapl, mapr) to work with +a second arbitrary monad (in place of the list monad) is left as an +entertaining exercise for the reader :-)] + +As a final example, here is a definition of a `while' loop for an +arbitrary monad: + + while :: Monad m => m Bool -> m b -> m () + while c s = c `bind` \b -> + if b then s `bind` \x -> + while c s + else result () + + +4.2.5 A family of state monads +------------------------------- +We have already described the use of monads to model programs with +state using the State datatype in Section 4.2.1. The essential +property of any such monad is the ability to update the state and we +might therefore consider a more general class of state monads given by: + + class Monad (m s) => StateMonad m s where + update :: (s -> s) -> m s s + set :: s -> m s s + fetch :: m s s + set new = update (\old -> new) + fetch = update id + +An expression of the form update f denotes the computation which +updates the state using f and result the old state as its result. For +example, the incr function described above can be defined as: + + incr :: StateMonad m Int => m Int Int + + + 33 + + + + +Release Notes v2.28 4.2.5 A family of state monads + + + incr = update (1+) + +in this more general setting. The class declaration above also +includes set and fetch functions which set the state to a particular +value or return its value. These are easily defined in terms of the +update function as illustrated by the default definitions. + +The StateMonad class has two parameters; the first should be a +constructor of kind (* -> * -> *) while the second gives the state +type (of kind *); both are needed to specify the type of update. +The implementation of update for a monad of the form State s is +straightforward and provides us with our first instance of the +StateMonad class: + + instance StateMonad State s where + update f = ST (\s -> (s, f s)) + +A rather more interesting family of state monads can be described using +the following datatype definition: + + data STM m s a = STM (s -> m (a,s)) -- a more sophisticated example, + -- where the state monad is + -- parameterized by a second, + -- arbitrary monad. + +Note that the first parameter to StateM has kind (* -> *), a +significant extension from Haskell (and previous versions of Gofer) +where all of the arguments to a type constructor must be types. This +is another benefit of the kind system. + +The functor and monad structure of a StateM m s constructor are given +by: + + instance Monad m => Functor (STM m s) where + map f (STM xs) = STM (\s -> [ (f x, s') | ~(x,s') <- xs s ]) + + instance Monad m => Monad (STM m s) where + result x = STM (\s -> result (x,s)) + STM xs `bind` f = STM (\s -> xs s `bind` (\(x,s') -> + let STM f' = f x + in f' s')) + +Note the condition that m is an instance of Monad in each of these +definitions. If we hadn't used the lazy pattern construct ~(x,s') in +the instance of Functor, it would have been necessary to strengthen +this further to instances of Monad0 -- i.e. monads with a zero. + +The definition of StateM m as an instance of StateMonad is also +straightforward: + + instance StateMonad (STM m) s where + update f = STM (\s -> result (s, f s)) + +The following two functions are also useful for work with STM m s +monads. The first, protect, allows an arbitrary computation to be +embedded in a state based computation without access to the state. + + + 34 + + + + +Release Notes v2.28 4.2.5 A family of state monads + + +The second, execute, is similar to the startingWith function in +Section 4.2.1, running a state based computation with a given initial +state and returning a computation as the result. + +protect :: Monad m => m a -> STM m s a +protect m = STM (\s -> [ (x,s) | x<-m ]) + +execute :: Monad m => s -> STM m s a -> m a +execute s (STM f) = [ x | ~(x,s') <- f s ] + +Support for monads like StateM m s seems to be an important step +towards solving the problem of constructing monads by combining +features from simpler monads, in this case combining the use of state +with the features of an arbitrary monad m. I hope that the system of +constructor classes in Gofer will be a useful tool for people working +in this area. + + +4.2.6 Monads and substitution +------------------------------ +The previous sections have concentrated on the use of monads to +describe computations. Monads also have a useful interpretation as a +general approach to substitution. This in turn provides another +application for constructor classes. + +Taking a fairly general approach, a substitution can be considered as a +function s::v-> t w where the types v and w +represent sets of variables and the type t a represents a set +of terms, typically involving elements of type a. If t is +a monad and x::t v, then x `bind` s gives the result of +applying the substitution s to the term x by replacing +each occurrence of a variable v in x with the corresponding +term s v in the result. For example: + + instance Monad Tree where + result = Leaf + Leaf x `bind` f = f x + (l :^: r) `bind` f = (l `bind` f) :^: (r `bind` f) + +With this interpretation in mind, the Kleisli composition (@@) in +Section 4.2.4 is just the standard way of composing substitutions, +while the result function corresponds to a null substitution. The fact +that (@@) is associative with result as both a left and right identity +follows from the standard algebraic properties of a monad. + + +4.3 Constructor classes in Gofer +--------------------------------- +The previous two sections should have given you some ideas about the +motivation and use for constructor classes. It remains to say a few +words about the way that constructor classes fit into the general Gofer +framework. In practice, this means giving a more detailed description +of the way that the kind system works. + + + + + + 35 + + + + +Release Notes v2.28 4.3.1 Kind errors and the k command line option + + +4.3.1 Kind errors and the k command line option +------------------------------------------------ +As has already been mentioned, Gofer 2.28 uses kind information to +check that type expressions are well-formed rather than simply checking +that each type constructor is applied to an appropriate number of +arguments. For example, having defined a tree datatype: + + data Tree a = Leaf a | Tree a :^: Tree a + +the following definition will be rejected as an error: + + type Example = Tree Int Bool + +as follows: + + ERROR "file" (line 42): Illegal type "Tree Int Bool" in + constructor application + +The problem here is that the Tree constructor has kind * -> * so that +it expects to take one argument (a type) and deliver a type as the +result. On the other hand, in the definition of Example, the Tree +constructor is treated as having (at least) two arguments; i.e. as +having a kind of the form (* -> * -> k) for some kind k. Rather than +confuse a user who is not familiar with the use of kinds, Gofer +normally just prints an error message like the one above for examples +like this. + +If you would like Gofer to give a more detailed description of the +problem, you can use the :set +k command line option as follows: + + ? :set +k + ? :r + Reading script file "file": + + ERROR "file" (line 42): Kind error in constructor application + *** expression : Tree Int Bool + *** constructor : Tree + *** kind : * -> * + *** does not match : * -> a -> b + + ? + +When the k command line option has been selected, the :info command +described in Section 2.3.2 also includes kind information about the +kinds of type constructors defined in a program. For example, given +the definition of Tree above and the datatypes: + + data STM m s x = STM (s -> m (s, x)) + data Queue a = Empty | a :< Queue a | Queue a :> a + +The :info command gives the following kinds (editing the output to +remove details about constructor functions for each datatype): + + ? :info Tree STM Queue + -- type constructor with kind * -> * + data Tree a + + + 36 + + + + +Release Notes v2.28 4.3.1 Kind errors and the k command line option + + + -- type constructor with kind (* -> *) -> * -> * -> * + data STM a b c + + -- type constructor with kind * -> * + data Queue a + + ? + +In addition to calculating a kind of each type constructor introduced +in a datatype declaration, Gofer also determines a kind for each +constructor defined by means of a type synonym. For example, the +following definitions: + + type Subst m v = v -> m v + type Compose f g x = f (g x) + type Pointer a = Int + type Apply f x = f x + type Fusion f g x = f x (g x) + type Const x y = x + +are treated as having kinds: + + ? :info Subst Compose Pointer Apply Fusion Const + -- type constructor with kind (* -> *) -> * -> * + type Subst a b = b -> a b + + -- type constructor with kind (* -> *) -> (* -> *) -> * -> * + type Compose a b c = a (b c) + + -- type constructor with kind * -> * + type Pointer a = Int + + -- type constructor with kind (* -> *) -> * -> * + type Apply a b = a b + + -- type constructor with kind (* -> * -> *) -> (* -> *) -> * -> * + type Fusion a b c = a c (b c) + + -- type constructor with kind * -> * -> * + type Const a b = a + + ? + +Note however type synonyms are only used as abbreviations for other +type expressions. It is not permitted to use a type synonym +constructor in a type expression without giving the correct number of +arguments. + + ? undefined :: Const Int + + ERROR: Wrong number of arguments for type synonym "Const" + ? + +Assuming that you are familiar with polymorphic functions in Gofer, you +might be wondering why some of the kinds given for the type synonyms +above are not also polymorphic in some sense. After all, the standard + + + 37 + + + + +Release Notes v2.28 4.3.1 Kind errors and the k command line option + + +prelude function const, is defined by + + const x y = x + +with type a -> b -> a, which looks very similar to the definition of +the Const type synonym above, except that the kinds of the two +arguments have both been fixed as *. In fact, the right hand side of +a type synonym declaration is always required to have kind *, so this +would mean that the most general kind that could be assigned to the +Const constructor would be * -> a -> *. + +Gofer does not currently support the use of polymorphic kinds (let's +call them polykinds from now on). First of all, it is not clear what +practical applications polykinds might offer (I have yet to find an +example where they are useful). Furthermore, some of the deeper +theoretical issues about type inference and related topics have not yet +been studied and I suspect that polykinds would introduce significant +complications without any significant benefits. + +The current approach is to replace any unknown part of an inferred kind +with the kind *. Any polymorphism in the kind of a constructor +corresponds much more closely to the idea of a value that is not +actually used at all than in the language of normal expressions and +their types so this is unlikely to cause any problems. And of course, +in Haskell and previous versions of Gofer, any variable used in a type +expression was assumed to be a type variable with kind *, so all of the +kinds above are consistent with this interpretation. + +The rest of this section is likely to get a bit hairy. Read on at your +peril, or skip to the start of Section 4.3.2. Only those with a strong +interest in the type theory and pragmatics of constructor classes will +miss anything. + +The same approach is used to determine the kinds of constructor +variables in type expressions. In theory, this can sometimes lead to +problems. In practice, this only happens in very contrived examples +and I doubt that any problems will occur for serious applications. The +following example illustrates the kind of `problem' that can occur. +Suppose that we use a script containing the definitions: + + undefined :: a -- the `bottom' value + undefined = undefined + + strange :: f Tree -> f a + strange = undefined + +The type signature for the `strange' function is indeed very strange; +the constructor variables f and a have kinds (* -> *) -> * and (* -> *) +respectively. What's more, the type is very restrictive. Without +including additional primitive constructs in the language, I very much +doubt that you will be able to find an alternative definition for +strange which is not semantically equivalent to the definition above. +And of course, the definition above doesn't really have any practical +applications anyway. [In case you don't get my point, I'm trying to +show that this really is a very contrived example.] I would be very +surprised to see a genuine example of a polymorphic operator which + + + 38 + + + + +Release Notes v2.28 4.3.1 Kind errors and the k command line option + + +involves constructor variables of higher kinds in a non-trivial way +that does not also include overloading constraints as part of the +type. For example, it is not at all difficult to think of an +interesting value of type Monad m => a -> m a, but much harder to think +of something with type a -> m a (remember this means for all a and for +all m). + +The definitions of undefined and strange above will be accepted by the +Gofer system as will the following definition: + + contrived = strange undefined + +The type of contrived will now be f a where f :: (* -> *) -> * and +a :: (* -> *). However, if we modify the definition of contrived to +include a type signature: + + contrived :: f a + contrived = strange undefined + +then we get a type checking error: + + ? :l file + Reading script file "file": + Type checking + ERROR "file" (line 24): Type error in function binding + *** term : contrived + *** type : a b + *** does not match : c d + *** because : constructor variable kinds do not match + + ? + +The problem is that for the declared type signature, the variables f and +a are treated as having kinds (* -> *) and * respectively. These do not +agree with the real kinds for these variables. + +To summarize, what this all means is that it is possible to define +values whose principal types cannot be expressed within the language of +Gofer types in the current implementation. The values defined can +actually be used within a program, but it would not, for example, be +possible to allow such values to be exported from a module in a Haskell +system unless kind annotations were added to the inferred types. + + +4.3.2 The kind of values in a constructor class +------------------------------------------------ +The previous section indicated that, if the :set +k command line option +has been set, the :info command will include information about the +kinds of type constructor constants in its output. This will also +cause the :info command to display information about the kinds of +classes and constructor classes. Notice for example in the following +how the output distinguishes between Eq, a type class, and Functor, a +constructor class in which each instance has kind (* -> *): + + ? :info Eq Functor + -- type class + + + 39 + + + + +Release Notes v2.28 4.3.2 The kind of values in a constructor class + + + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + ... + + -- constructor class with arity (* -> *) + class Functor a where + map :: Functor a => (b -> c) -> a b -> a c + + -- instances: + instance Functor [] + ... + + ? + + +4.3.3 Implementation of list comprehensions +-------------------------------------------- +The implementation of overloaded monad comprehensions is cute, but also +has a couple of potential disadvantages. These are discussed in this +section. As you will see, they really aren't very much to worry +about. + +First of all, the decision to overload the notation for singleton lists +so that [ exp ] == result exp can sometimes cause a few surprises: + + ? map (1+) [1] + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) [ 1 ] + + ? + +Note that this will only occur if you are actually using a prelude +which includes the definition of the Monad class given in Section 4.2 +This can be solved using the command line toggle :set -1 which forces +any expression of the form [ exp ] to be treated as a singleton list +rather than being interpreted in an arbitrary monad. You really +have to write `result' if you do want an arbitrary monad: + + ? :set -1 + ? map (1+) [1] + [2] + (7 reductions, 18 cells) + ? map (1+) (result 1) + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) (result 1) + + ? + +This should probably be the default setting, but I have left things as +they are for the time being, partly so that other people might get the + + + 40 + + + + +Release Notes v2.28 4.3.3 Implementation of list comprehensions + + +chance to find out about this and decide what setting they think would +be best. As usual, the default setting can be recovered using the +:set +1 command. + +A second concern is that the implementation of list comprehensions may +be less efficient in the presence of monad comprehensions. Gofer +usually uses Wadler's `optimal' translation for list comprehensions as +described in Simon Peyton Jones book. In fact, this translation will +always be used if either the prelude being used does not include the +standard Monad class or the type system is able to guarantee that a +given monad comprehension is actually a list comprehension. + +If you use a prelude containing the Monad class, you may notice some +small differences in performance in examples such as: + + ? [ x * x | x <- [1..10] ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (98 reductions, 203 cells) + + ? f [1..10] where f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (139 reductions, 268 cells) + + ? + +The second expression is a little more expensive since the local +definition of f is polymorphic with f :: (Num b, Monad a) => a b -> a b +and hence the implementation of the comprehension in f does not use the +standard translation for lists. To be honest, the difference between +these two functions really isn't anything to worry about in the context +of an interpreter like Gofer. And of course, if you really want to +avoid this problem, an explicit type signature will do the trick (as in +other cases where overloading is involved): + + ? f [1..10] where f :: Num b => [b] -> [b]; + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 205 cells) + + ? f [1..10] where f :: [Int] -> [Int] + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 203 cells) + + ? + +As the last example shows, there is only one more reduction in this +case and that is the reduction step that deals with the application of +f to the argument list [1..10]. + + + + + + + + + + 41 + + + + +Release Notes v2.28 5. GOFC, THE GOFER COMPILER + + +5. GOFC, THE GOFER COMPILER + +This release of Gofer includes gofc, a `compiler' for Gofer programs +which translates a large class of Gofer programs into C code which can +then be compiled and executed as a standalone application. + +Before anybody gets too excited, there are a couple of points which I +should mention straight away: + + o To make use of gofc, you will need a C compiler. This is why I + do not intend to distribute any binary versions of gofc; if you + have the C compiler needed to compile the output of gofc then + you should also be able to compile gofc from the sources. + + o First of all, the Gofer compiler was written by modifying the + Gofer interpreter. Most of the modifications and changes were + made in just a few days. The compiler and interpreter still + share a large proportion of code. As such, and in case it isn't + obvious: PLEASE DO NOT expect to gain the same kind of performance + out of gofc as you would from one of the serious Haskell + projects. A considerably greater amount of time and effort has + gone into those systems. + + o The compiler is actually over a year old, but this is the first + time it has been released. Although I have worked with it a bit + myself, it hasn't had half the amount of testing that Gofer user's + have given the interpreter over the last year and a half. It may + not be as reliable as the interpreter. If you have problems with + a compiled program, try running it with the interpreter too just + to check that you haven't found a potential bug in gofc. + +That having been said, I hope that the Gofer compiler will be useful to +many Gofer users. One possible advantage is that the executables may +be smaller than with some other systems. And of course, the fact that +gofc runs on some home computers may also be useful. Finally, gofc +provides a simplified system for experimenting with the runtime details +of an implementation. For example, the source code for the runtime +system is set up in such a way as to make it possible to experiment +with alternative garbage collection schemes. + + +5.1 Using gofc +--------------- +Compiling a program with gofc is very much like starting up the Gofer +interpreter. The compiler starts by reading the prelude and then +loads the script files specified by the command line. These scripts +must contain a definition for the value main :: Dialogue which will be +the dialogue expression that is evaluated when the compiled program is +executed. + +For example, if the file apr1.gs contains the simple program: + + main :: Dialogue + main = appendChan "stdout" "Hello, world\n" exit done + +then this can be compiled as: + + + 42 + + + + +Release Notes v2.28 5.1 Using gofc + + + machine% gofc apr1.gs + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "apr1.gs": + + Writing C output file "apr1.c": + [Leaving Gofer->C] + machine% + +The output is written to the file apr1.c -- i.e. the name obtained by +removing the .gs suffix and replacing it with a .c suffix. Other +filename suffixes that are treated in a similar way are: + + .prj .gp for Gofer project files + + .prelude for Gofer prelude files + + .gof .gs for Gofer scripts + + .has .hs for Haskell scripts + + .lhs .lit for literate scripts + .lgs .verb + +If no recognized suffix is found then the name of the output file is +obtained simply by appending the .c suffix to the input name. + +For the benefit of those using Unix systems, let me point out that this +could cause you problems if you are not careful; if you take an input +file called `prog' and compile it to `prog.c' using gofc, make sure +that you do not compile the C program in such a way that the output is +also called `prog' since this will overwrite your original source code! +For this reason, I would always suggest using file extensions such as +the .gs example above if you are using gofc. + +If you run gofc with multiple script files, then the name of the output +file is based on the last script file to be loaded. For example, the +command `gofc prog1.gs prog2.gs' produces an output file `prog2.c'. + +Gofc also works with project files, using the name of the project file +to determine the name of the output file. For example, the miniProlog +interpreter can be compiled using: + + machine% gofc + miniProlog + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "Parse": + Reading script file "Interact": + Reading script file "PrologData": + Reading script file "Subst": + Reading script file "StackEngine": + Reading script file "Main": + + Writing C output file "miniProlog.c": + + + 43 + + + + +Release Notes v2.28 5.1 Using gofc + + + [Leaving Gofer->C] + machine% + +This is another case where it might well have been sensible to have +used a .prj or .gp for the project file miniProlog since compiling the +C code in miniProlog.c to a file named `miniProlog' will overwrite the +project file! Choose filenames with care! + +You can also specify Gofer command line options as part of the command +line used to run gofc. Think of it like this; use exactly the same +command line to start Gofc as you would have done to start Gofer (ok, +replacing the command `gofer' with `gofc') so that you could start your +program immediately by evaluating the main expression. To summarize +what happens next: + + o Gofc will load the prelude file. Do not worry if the prelude + (or indeed, later files) contain lots of definitions that your + program will not actually use; only definitions which are actually + required to evaluate the main expression will be included in the + output file. + + o Gofc will load the script files specified. If an error is found + then an error message will be printed and the compilation will be + aborted. You would probably be sensible to run your program + through the interpreter first to tidy up any errors and avoid this + problem. + + o Gofc will look for a definition of `main' and check that it has + type Dialogue. You will get an error if an appropriate main + value cannot be found. + + o Gofc determines the appropriate name for the output file. + + o Gofc checks to make sure that you haven't used a primitive + function that is not supported by the runtime system (see + Section 5.2 for more details). + + o Gofc outputs a C version of the program in the output file. + +Once you have compiled the Gofer program to C, you need to compile +the C code to build the executable application program. This will +vary from one system to another and is documented elsewhere. + + +5.2 Primitive operations +------------------------- +The Gofer compiler accepts the same source language as the +interpreter. However, there is a small collection of Gofer primitives +which are only implemented in the interpreter. The most likely +omission that you will notice is the primPrint function which is used +to define the show' function in the standard prelude. Omitting this +function is not an indication of laziness on my part; it is impossible +to implement primPrint in the current runtime system because there is +insufficient type information available at program runtime. + + + + + 44 + + + + +Release Notes v2.28 5.2 Primitive operations + + +For example, if you try to compile the program: + + main :: Dialogue + main = appendChan "stdout" (show' 42) exit done + +the compiler will respond with the error message: + + ERROR: Primitive function primPrint is not + supported by the gofc runtime system + (used in the definition of show') + Aborting compilation + +The solution is to use type classes. This is one of the reasons for +including them in the language in the first place. This example can +be compiled by changing the original program to: + + main :: Dialogue + main = appendChan "stdout" (show 42) exit done + +(Remember that show is the overloaded function for converting values of +any type a that is an instance of the Text class to a string value.) + + +5.3 Debugging output +--------------------- +Another potentially useful feature of gofc is it's ability to dump a +listing of all the supercombinator definitions that are created by +loading a particular combination of script files. For the time being, +this is only useful for the purpose of debugging, but with only small +modifications, it might be possible to use this as input to an +alternative backend/code generator system (the format of the output +combinators already uses explicit layout characters to make the task of +parsing easier in an application like this). + +To illustrate how this option might be used, suppose that we were working +on a program containing the definition: + + hidden xs = map (\[x] -> x) xs + +and that somewhere during the execution of our program, this function is +applied to a list value [[1],[1,2]]: + + ? hidden [[1],[1,2]] + [1, + Program error: {v132 [1, 2]} + (13 reductions, 75 cells) + + ? + +The variable v132 which appears here is the name used internally to +represent the lambda expression in the definition of hidden. For this +particular example, it is fairly easy to work this out, but in general, +it may not be so straightforward. Running the program through gofc and +using the +D toggle as follows produces an output file containing Gofer +SuperCombinators, hence the .gsc suffix: + + + + 45 + + + + +Release Notes v2.28 5.3 Debugging output + + + machine% gofc +D file + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + [Writing supercombinators to "file.gsc"] + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "file": + [Leaving Gofer->C] + machine% + +Note that there is no need in this situation for the files loaded to +contain a definition for main :: Dialogue, although the compiler must +be loaded using exactly the same prelude and order of files as in the +original Gofer session to ensure that the same names are used. Scanning +the output file, we find that the only mention of v132 is in the +definitions: + + v132 o1 = case o1 of { + (:) o3 o2 -> case o2 of { + [] -> o3; + } + } + + hidden o1 = map v132 o1; + +This shows fairly clearly where the function v132 comes from. Of +course, this is far from perfect, but it might help someone to track +down a bug that little bit faster one day. It's better than nothing. + +Of course, the debugging output might also be of interest to anyone +that wants to find out more about the implementation of Gofer and +examine the supercombinator definitions generated when list +comprehensions, overloading, local function definitions etc. have all +been eliminated. For example, the standard prelude definitions of map +and filter become: + + map o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> o2 o4 : map o2 o3; + } + + filter o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> let { o5 = filter o2 o3; + } in | o2 o4 -> o4 : o5; + | otherwise -> o5; + } + +This is one of the tools I'll be using if anyone ever reports another +bug in the code generator... + + + + + + + + + + 46 + + + + +Release Notes v2.28 6. SOME HISTORY + + +6. SOME HISTORY + +Ever since the first version of Gofer was released I've had requests +from Gofer users around the world asking how Gofer got its name and how +it came into being. This section is an attempt to try and answer those +questions. + +6.1 Why Gofer? +--------------- +Everything has to have a name. You may type in an `anonymous function' +as a lambda expression but Gofer will still go ahead and give it a +name. To tell the truth, I always intended the name `Gofer' to be +applied to my particular implementation of a functional programming +environment, not to the language on which it is based. I wanted that +to be an anonymous language. But common usage has given it the same +name, Gofer. + +If you take a look in a dictionary (as some puzzled Gofer users have) +you'll find that `gofer' means: + + ``an employee whose duties include running errands'' + +(although you'd better choose a dictionary printed since the 70s for +this). I'd not thought about this when I chose the name (and I would +have used a lower case g instead of an upper case G if I had). In +fact, Gofer was originally conceived as a system for machine assisted +equational reasoning. One of the properties of functional languages +that I find particularly attractive is that they are: + + GOod For Equational Reasoning. + ^^ ^ ^ ^ +So now you know. The fact that you can also tell someone who is having +a problem with their C program to ``Gofer it!'' (unsympathetic, I know) +is nothing more than a coincidence. Fairly recently, somebody wrote to +ask if Gofer stood for ``GOod Functional programming EnviRonment''. I +was flattered; I wish I'd thought of that one. + +Some people have asked me why I didn't choose a title including the +name `Haskell', a language on which Gofer is very strongly based. +There are two reasons for this. To start with, the original version of +Gofer was based on a different syntax, Orwell + type classes. The +Haskell influence only crept in when I started on version 2.xx. +Secondly, it's only right to point out that there is quite a large gap +between a system like Gofer and the full blown Haskell systems that +have been developed. Using a name which doesn't involve `Haskell' +directly seemed the right thing to do. Some people tell me that it was +a mistake. One of the objectives of Haskell was to create a standard +language for non-strict functional programming. Gofer isn't intended +as an alternative to Haskell and I hope it will continue to grow closer +as time passes. + +While I'm on the subject of names, I should also talk about an +additional source of confusion that may sometimes crop up. While Gofer +is a functional programming system, there is also a campus wide +information system called `Gopher' (sharing it's name with the North +American rodents). I would guess that the latter has many more users + + + 47 + + + + +Release Notes v2.28 6.1 Why Gofer? + + +than the former. So please be careful to spell Gofer with an `f' not +a `ph' to try and minimize the confusion. + +It has occurred to me that I should try and think of another name for +Gofer to avoid the confusion with Gopher. I hope that won't be +necessary, but if you have a really good suggestion, let me know! One +possibility might be to call it `Gordon'. The younger generation of +brits might know what the connection is. Others may need to ask their +children... + +6.2 The history of Gofer +------------------------- +Here is a summary of the way that I first learnt about functional +programming, and how it started me on the path to writing Gofer. +This, slightly sentimental review is mostly for my own entertainment. +If you're the sort of person that likes to read the acknowledgments +and bibliographic notes in a thesis: this is for you. If not, you +can always stop reading :-) + +My first exposure to lazy functional programming languages was using a +language called `Orwell' developed and used at the Programming Research +Group in Oxford. I've been interested in using and implementing lazy +functional programming languages ever since. + +One of the properties of programming in Orwell that appealed to me was +the ability to use equational reasoning -- a very simple style of +mathematical reasoning -- to establish properties of programs and prove +that they would behave in particular ways. Even more interesting, +equational reasoning can be used to calculate efficient implementations +of programs from a formal specification of what was intended. + +Probably the first non-trivial functional program that I wrote was a +simple Prolog interpreter. (This was originally written in Orwell and +later transcribed to be compiled using the Chalmers Haskell B compiler, +hbc. The remnants of this program live on in the mini Prolog +interpreter that is included with the Gofer distribution and, I +believe, with at least a couple of the big Haskell systems.) Using a +sequence of something like a dozen or so transformations (most of which +were fairly mundane), I discovered that I could turn a relatively +abstract specification of a Prolog inference engine into a program that +could be interpreted as the definition of a low level stack-based +machine for executing Prolog queries. Indeed, I used the result as the +core of a C implementation of mini Prolog. + +The transformations themselves were simple enough but managing the +complexity of the calculations was tough. It was not uncommon to find +that some of the intermediate steps in a calculation would span more +than 200 characters. Even with a relatively small number of +transformation steps, carrying out proofs like this was both tedious +and prone to mistakes. A natural application for a computer! + +Here's an outline of what happened next: + + eqr 1989. Eqr was a crude tool for machine assisted equational + reasoning. It worked well enough for the job I had intended + to use it for, but it also had a number of problems. I + + + 48 + + + + +Release Notes v2.28 6.2 The history of Gofer + + + particularly missed the ability to use and record type + information as part of an automated derivation. + + 1.xx 1990. Gofer 1.xx was intended to be the next step forward + providing machine support for *typed* equational reasoning. + It was based on Orwell syntax and was later extended to + support Haskell style type classes. It had a lexer, parser, + type checker and simple top-level interactive loop. It + couldn't run programs or construct derivations. + + 2.xx January 1991. A complete rewrite. I remember those early + days, several months passed before I ever got compile some of + the earliest code. The emphasis switched to being able to run + programs rather than derive them when I came up with a new + implementation technique for type classes in February 1991. + If I wanted to see it implemented, I was going to have to do + it myself. Around about May, I realized I had something that + might be useful to other people. + + 2.20 The first public release, announced in August 1991 and + distributed shortly after that in September. + + 2.21 November 1991, providing a more comprehensive user + interface, access to command line options and fixing a + small number of embarrassing bugs in the original release. + + 2.23 August 1992, having been somewhat preoccupied with academic + studies for some time, the main purpose of this release + was to correct a number of minor bugs which had again been + discovered, either by myself or by one or more of the many + Gofer users out there. + + 2.28 January 1993. The most substantial update to Gofer since + the original release. I had been doing a lot of work and + experimentation with Gofer during the time between the + release of versions 2.21 and 2.23, but I didn't have the + time to get these extensions suitable for public distribution. + By the time I came to release version 2.23, I also had + several other distinct versions of Gofer (each derived + from the source for version 2.21) including a compiler + and a prototype implementation of constructor classes + which was called `ccgofer'. Work on version 2.28 started + with efforts to merge these developments back into a single + system (I was tired of trying to maintain several different + versions, even though I was the only one using them). + The rough outline of changes was as follows (with the + corresponding version numbers for those who wonder why + 2.28 follows 2.23): + + 2.24 enhancements and bug fixes + 2.25 merging in support for the Gofer compiler + 2.26 a reimplementation of constructor classes + 2.27 reworked code generator and other minor fixes + 2.28 preparation for public release + + + + + 49 + + diff --git a/docs/release.230 b/docs/release.230 new file mode 100644 index 0000000..93b338f --- /dev/null +++ b/docs/release.230 @@ -0,0 +1,726 @@ + + + + + +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.30a + + Copyright Mark P Jones 1994. This release is subject to the same + conditions of use and distribution as previous versions, documented + in src/goferite.h and in the main user manual. + + Release notes +----------------------------------------------------------------------- + +This document is intended to be used as a supplement to the original +user manual ``An introduction to Gofer version 2.20'' and release +notes for Gofer 2.21 and Gofer 2.28. These notes replace the +preliminary version distributed with Gofer 2.30. + +ACKNOWLEDGMENTS: +A lot of people have contributed to the development of Gofer 2.30a +with their support, encouragement, suggestions, comments and bug +reports. There are a lot of people to thank: + + Jim Blandy Jonathan Bowen Rodney Brown + Nick Chapman Derek Charleston Stuart Clayman + Terry Dineen Luc Duponcheel Dirk Dussart + Sebastian Egner Stephen Eldridge Jeroen Fokker + Jeff Fried Andy Gill Michial Gunter + Kevin Hammond Daniel Harris Barney Hilken + Steve Hill Ian Holyer Richard Jones + Fumiaki Kamiya Eak Khoon Hiroyuki Matsuda + Sava Mintchev Torben Mogensen Dirk Nehring + Chin Wei Ngan Kurt Olender Palle Nielsen + Ian Poole Bambang Prastowo Jaan Priisalu + Giuliano Procida Jerry Prothero Laurenz Pruessner + Niklas R\"ojemo Kristoffer Rose Bernhard Rumpe + David Rushall Carsten Schultz Viren Shah + Dave Sherratt Guy Steele Jr. Donald Smith + Matthew Smith Michael Stout Bernard Sufrin + Peter Thiemann Stephen Thomas Bert Thompson + Ignacio Trejos-Zelaya Goeran Uddeborg Robin Watts + Gavin Wraith David Wright Isii Yuuitirou + +This also includes the names of people who sent comments and bug +reports after the release of version 2.28 and who may not have been +credited in previous release notes. The list probably isn't complete, +and I apologize if I have inadvertently left your name out. + +Enjoy! jones-mark@cs.yale.edu (Until mid-July 1994) +Mark mpj@cs.nott.ac.uk (From Sept/Oct 1994) + + + + + 1 + + + + +Release Notes v2.30 1. MINOR ENHANCEMENTS AND BUGFIXES + + +1. MINOR ENHANCEMENTS AND BUGFIXES + +The following sections list the minor enhancements and bugfixes that +have been made to Gofer since the release of version 2.28. More +significant changes are described in Section 2. + + +1.1 Enhancements +----------------- + o A new command, :gc, has been added, making it possible to force the + interpreter to carry out a garbage collection. + + o The infamous `too many variables in type checker' message that has + caused problems with some programs, particularly machine generated + Gofer scripts like the parsers produced by Ratatosk, should now be + a thing of the past. The message may still appear when running + such programs on smaller machines where the amount of free memory + available for such things is very limited. + + o It is now possible to compile Gofer without support for old style + Dialogue based I/O and, independently, without support for (n+k) + and (c*n) patterns. You may take this as a hint that these + features may not be supported in future versions, although no firm + decisions have been made just yet. + + o As a convenience, the parser allows constructor expressions of + the form (t ->) as an abbreviation for ((->) t). + + o Tuple patterns (with irrefutable components) are now treated as + irrefutable patterns, but without changing the previous lifted + semantics. This is marginallly more efficient. It also means + that it is no longer necessary to use ~ for generators of the form + (x,y) <- expr in monad comprehensions, too avoid restricting the + enclosing comprehension to monads with a zero. + + o Type expressions appearing in primitive declarations may now + include synonyms, classes etc. defined in the same script. + + o Other minor tweaks and improvements. + + +1.2 Bug fixes +-------------- +Nobody really likes to dwell on bugs, especially when they have been +eliminated. But for those of you who want to know, here is a summary of +the bugs discovered and fixed in Gofer 2.30: + + o Test programs apr*.gs that were included in previous distributions + are no longer included in the src directory. These programs were + intended only for quick tests, not for public distribution. The + fact that some of the test programs (intentionally) caused errors, + was a source of unnecessary concern for some since the expected + behaviour was not documented. + + o Some minor fixes to the parser/grammar to give better error + messages. + + + 2 + + + + +Release Notes v2.30 1.2 Bug fixes + + + o Fixed problems with the :edit command on some machines, + particularly noticable on the RISCOS version. + + o Large integer constants that are outside the range for Int + values are no longer implicitly coerced to type Float. + + o The implementations of assignment in the LAMBDAVAR and LAMBDANU + extensions, and the implementation of the system primitive for + LAMBDANU contained subtle bugs that have now been fixed. Note + however that these extensions are now regarded as obsolete, and + will probably not be supported in future versions. (LAMBDAVAR and + LAMBDANU where never formally included as an official feature of + Gofer anyway.) + + o Infix data constructors can now be used in a datatype definition + such as: + + data Tree a = Empty | Tree a `Fork` Tree a + + o A very subtle bug in the unification algorithm has been fixed. + + o Some bugs in mildly complicated examples involving pattern + matching of integer constants and singleton lists have been + fixed. + + o Fixed some small problems with a couple of the demonstration + programs. + + o Modified prelude definitions of the index function (in class Ix) + to include a bounds check. + + o Other minor bug fixes and tweaks. + +Someone is bound to find a new one within hours of the release of 2.30, +if past experience is anything to go by. If that someone is you, +please let me know! + + +2. LANGUAGE DIFFERENCES + +This section outlines a number of more substantial extensions that are +supported in Gofer 2.30. One of the most important motivations for +some of these extensions, and part of an ongoing process, is to provide +greater compatibility with standard Haskell. + + +2.1 Contexts in datatype definitions +------------------------------------- +For greater compatibility with Haskell, it is now possible to include +contexts in datatype definitions. These are treated in exactly the +same way as in Haskell. For example, the only effect of using a +context in the datatype definition: + + data Eq a => Set a = NilSet | ConsSet a (Set a) + + is to treat the ConsSet constructor function as having type: + + + 3 + + + + +Release Notes v2.30 2.1 Contexts in datatype definitions + + + ConsSet :: Eq a => a -> Set a -> Set a + + See Section 4.2.1 of the Haskell report, version 1.2, for further + details. + + +2.2 Contexts in member function types +-------------------------------------- +For greater compatibility with Haskell, it is now possible to include +contexts in the type of member function definitions in a class +specification. For example, you can now try out the class definition +for pseudo monads given in the Yale Research Report YALEU/DCS/RR-1004 +entitled `Composing Monads' by myself and Luc Duponcheel: + + class Premonad m => Pseudomonad m where + pbind :: Monad m => p a -> (a -> m (p b)) -> m (p b) + +Unlike Haskell, Gofer does not make the restriction that the additional +constraints on the types of the member functions should not mention any +of the types in the first line of the class declaration. This appears +to have been a consequence of the formal system underlying the original +theoretical work on type classes by Blott. For the qualified type +system that is used as a basis for Gofer, such restrictions are +unnecessary, although one might argue that they should be retained on +stylistic grounds ... + +See Section 4.3.1 of the Haskell report, version 1.2, for further +details. + + +2.3 Haskell arrays +------------------- +For closer compatibility with Haskell, Gofer now supports a built-in +implementation of Haskell style arrays. To include support for these +arrays, Gofer must be compiled with the HASKELL_ARRAYS flag set to 1. +This is the default for all but the very smallest PC version of Gofer. + +The implementation includes is based on new primitive datatype: + + data Array a b + +The array primitives are not currently incorporated into any of the +preludes supplied with Gofer. However a separate script file, +array.gs, is included in the same directory with the following +interface: + + data Assoc a b = a := b deriving (Eq, Ord, Text) + + array :: Ix a => (a,a) -> [Assoc a b] -> Array a b + listArray :: Ix a => (a,a) -> [b] -> Array a b + (!) :: Ix a => Array a b -> a -> b + bounds :: Ix a => Array a b -> (a,a) + indices :: Ix a => Array a b -> [a] + elems :: Ix a => Array a b -> [b] + assocs :: Ix a => Array a b -> [Assoc a b] + accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) + + + 4 + + + + +Release Notes v2.30 2.3 Haskell arrays + + + -> [Assoc a c] -> Array a b + (//) :: Ix a => Array a b -> [Assoc a b] -> Array a b + accum :: Ix a => (b -> c -> b) -> Array a b + -> [Assoc a c] -> Array a b + amap :: Ix a => (b -> c) -> Array a b -> Array a c + ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) + -> Array b c -> Array a c + + instance (Ix a, Eq [Assoc a b]) => Eq (Array a b) + instance (Ix a, Ord [Assoc a b]) => Ord (Array a b) + instance (Ix a, Text (a,a), Text [Assoc a b]) + => Text (Array a b) + + instance (Ix a, Ix b) => Ix (a,b) + rangeSize :: (Ix a) => (a,a) -> Int + +For example, to use these primitives in a Gofer session, just include +array.gs as the first file that you load, or as the one of the first +file names in a project file. + +Arrays, and the primitives above are supported in both the interpreter +and the compiler. Because of restrictions in memory management, the +current implementation does not provide true O(1) lookup/indexing in +the interpreter or the compiler using the markscan garbage collector. +True O(1) access is supported when the twospace collector is used for +compiled programs. + +See Section 6.9 of the Haskell report, version 1.2, for further details +about the use of arrays and the primitives described above. Please +bear in mind that the current implementation is still preliminary, and +may contain bugs. Please let me know if you encounter any problems +with it! A few short demo programs are included in demos/arrayEx.gs. + + +2.4 Monadic I/O +---------------- +A preliminary implementation of the monadic I/O is supported, built on +top of the framework for lazy functional state threads that has been +proposed by John Launchbury and Simon Peyton Jones (PLDI '94). The +details of monadic I/O can be expected to change in future releases as +a new standard for monadic I/O is established. For the time being, the +primitives described here will be of most interest to those looking to +experiment with simple monadic I/O and the Launchbury/Peyton Jones +system. To include support for monadic I/O, Gofer must be compiled +with the IO_MONAD flag set to 1. This is the default for all but the +very smallest PC version of Gofer. + +The current implementation provides several new primitive types: + + data ST s a -- lazy state threads monad + data World -- representation of `the world' + type IO = ST World -- the I/O monad proper + data MutVar s a -- a mutable variable + +An interface to monadic I/O can be obtained by loading the file +iomonad.gs which may be found in the same directory as the prelude + + + 5 + + + + +Release Notes v2.30 2.4 Monadic I/O + + +files. This provides the following operations: + + returnST :: a -> ST s a + thenST :: ST s a -> (a -> ST s b) -> ST s b + thenST_ :: ST s () -> ST s b -> ST s b + seqST :: [ST s ()] -> ST s () + + newVar :: a -> ST s (MutVar s a) + readVar :: MutVar s a -> ST s a + writeVar :: MutVar s a -> a -> ST s () + mutvarEq :: MutVar s a -> MutVar s a -> Bool + + instance Eq (MutVar s a) + + getch :: IO Char + getchar :: IO Char + putchar :: Char -> IO () + putString :: String -> IO () + thenIO :: ST s a -> (a -> ST s b) -> ST s b + interleaveST :: ST s a -> ST s a + +The thenIO function is a stricter version of thenST that is suitable +only for computations in the IO monad. See the Launchbury and +Peyton Jones paper referenced below for further details. + +There is also a built-in special form, runST expr, which is typed +using the rule: + + expr :: forall s. ST s a (s not appearing in a) + ------------------------ + runST expr :: a + +This special form is used for encapsulating state based computations +within a purely functional program. See references below for more +details. + +If the version of Gofer being used also includes support for arrays, as +described above, you can also use the definitions in ioarray.gs to +support monadic array operations: + + newArr :: Ix a => (a,a) -> b -> ST s (MutArr s a b) + readArr :: Ix a => MutArr s a b -> a -> ST s b + writeArr :: Ix a => MutArr s a b -> a -> b -> ST s () + freezeArr :: Ix a => MutArr s a b -> ST s (Array a b) + +Some sample programs using the functions described here may be found in +the demos/IO directory. For further details about monadic I/O, please +consult the papers: + + Imperative Functional Programming, S.L. Peyton Jones and + P. Wadler, POPL '93. + + Lazy Functional State Threads, J. Launchbury and S.L. Peyton + Jones, PLDI '94. + + + + + 6 + + + + +Release Notes v2.30 2.4 Monadic I/O + + +See also: + + Lazy depth-first search and linear graph algorithms in + Haskell, D. King and J. Launchbury, 1993. + +For some very nice applications of lazy functional state threads. +All of these papers are currently available by anonymous ftp from +the University of Glasgow, ftp.dcs.glasgow.ac.uk. + +Monadic I/O as described above is supported in both the Gofer +interpreter and compiler. No special optimizations are used in +the current implementation which should still be treated as +preliminary, and may contain bugs. Please let me know if you +encounter any problems with it! + + +2.5 Trace primitive +-------------------- +A simple trace function, inspired by the original implementation in +LML, can now be accessed by including the primitive definition: + + primitive trace "primTrace" :: String -> a -> a + +in a Gofer script. When called, trace prints the string in its first +argument, then returns the second argument as its result. The trace +function is not referentially transparent, and should only be used for +debugging, or monitoring execution. That is why it is not included in +any of the preludes. Be warned also that, unless you understand +something about the way that Gofer programs are actually executed, +results obtained using trace may be rather confusing. + +Because of it's intended use, the trace primitive is not supported +by the Gofer compiler, gofc. It is however possible to `hack' in +a version of trace for gofc using the external function call +mechanism described below with the following C program: + + #include + #include "/usr/local/lib/Gofer/gofc.h" + + #define emptyList mkCfun(0) + + extern Cell primTrace(str,val) + Cell str, val; { + eval(str); + while (whnf!=emptyList) { + eval(pop()); + putchar(charOf(whnf)); + eval(pop()); + } + fflush(stdout); + return val; + } + +See Section 2.7 below for further details. + + + + + 7 + + + + +Release Notes v2.30 2.6 Constructor synonyms + + +2.6 Constructor synonyms +------------------------- +Type synonym definitions have been generalized to allow arbitrary +constructor synonyms such as: + + type List = [] + type Function = (->) + type Infer = StateM Int Error + +Previously, it was assumed that both the constructors on the left and +right hand sides were types, i.e. constructors of kind *. This +restriction has now been lifted, although both sides are still required +to have the same kind. However, the restriction that all arguments to +a synonym must be given is still imposed. + + +2.7 External function calls +---------------------------- +The Gofc compiler, translating Gofer programs to C provides a simple +external function calling mechanism. + +External functions are specified using a primitive declaration of the +form: + + primitive foo "bar" :: a1 -> a2 -> a3 -> ... -> an -> r + +where foo is the Gofer name for the function, bar is the name of the +corresponding C function (which must not be a string referring to one +of the built in primitives ... if you avoid the `prim' prefix, this +should not be a problem), the ai are the argument types, and r is the +result type. Arguments of type Int, Bool, Char and Float are evaluated +before the bar function is invoked, and their results passed to bar in +parameters of suitable types. All other values are passed as +unevaluated Cell values. (Special treatment is also provided for +arrays, mutable variables, and mutable arrays for versions of Gofer +that support these facilities.) + +Results of type Int, Bool, Char and Float returned from an external +function are automatically converted to suitable representations for +Gofer. Values of any other type should be passed back as Cell values +by the C code for the external function. + +A result type of the form IO r should be used for external functions +that may have some side effects. A result type of the form IO () can +be used to call a function that does not return any useful value and is +executed only for its effect. + +Here is a simple example using the external function mechanism. It +involves the following short Gofer and C programs: + +(gix1.gs): primitive howdy "sayHello" :: Int -> IO () + + main = howdy (length (filter even [1..5])) + + + + + + 8 + + + + +Release Notes v2.30 2.7 External function calls + + +(cix1.c): #include + #include "gofc.h" + + Void sayHello(i) + Int i; { + while (i-- > 0) + printf("hello, world\n"); + } + +First, we compile gix1.gs to get a C program gix1.c: + + machine% gofc gix1.gs + Gofer->C Version 1.02 (2.30) ... + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "gix1.gs": + + Writing C output file "gix1.c": + [Leaving Gofer->C] + +Now we compile the C programs, and link them into a single executable +file, ix1: + + machine% cc -O -o ix1 gix1.c cix1.c runtime.o + +Finally, we get to run the program: + + machine% ix1 + hello, world + hello, world + +See Section 2.5 above for another example using the external function +mechanism, and also illustrating how values of type String can be +evaluated and used in a C function. You will probably need to refer +to the report described in Section 3 below if you plan to do anything +very ambitious with external function calls. + +Note that the external function call mechanism described here cannot be +used in the Gofer interpreter. The external function call mechanism is +a prototype only. It should also be emphasized that we do not, in +general, regard the Gofc compiler as suitable for serious applications +development. If you want to do something along those lines, try one of +the full Haskell systems available (e.g. the Lisp or C interfaces for +Yale Haskell, or the C interface for Glasgow Haskell). + + +2.8 The do notation +-------------------- +Gofer 2.30 supports a new, experimental syntax for monad comprehensions +which we will refer to as `do {...} notation'. To maintain +compatibility with previous releases of Gofer, the do notation is +only supported if the system is compiled with the DO_COMPS flag in +prelude.h set to to 1, and the DO_COMPS section of parser.y included. +See the comments in these files and in src/Readme for further +details. + + + + 9 + + + + +Release Notes v2.30 2.8 The do notation + + +The do notation is useful for monadic programming. It requires the +cc.prelude, and provides the following syntax: + + ::= do "{" "}" -- uses layout rule + + ::= { ;} + + ::= <- -- generator + | -- command + | let "{" decls "}" -- local definitions + | if -- guard + +With this notation, a guard is written as if , while a single +expression of the form is treated as a command, i.e. a generator +of the form _ <- . For example, a general version of the filter +function can be defined as: + + myFilter :: Monad0 m => (a -> Bool) -> m a -> m a + myFilter p xs = do x <- xs + if p x + result x + +If you prefer, this can be written as follows, using explicit layout: + + myFilter p xs = do { x <- xs; + if p x; + result x + } + +In standard comprehension notation, this would be written: + + myFilter p xs = [ x | x <- xs, p x ] + +Perhaps the most significant difference between these two examples is +the fact that the call to result must be written explicitly in the +first case. In fact, if the comprehension is interpreted in a monad, +m, then any expression of type (m a) can be used as the final +expression in a do comprehension. This is useful for describing `tail +recursive' procedures. For example, compare: + + echo' = do c <- getchar + if c==EOF + then result () + else do putchar c + echo' + +with: + + echo' = [ () | c <- getchar, + () <- if c==EOF then result () + else [ () | _ <- putchar c, + () <- echo' ] ] + +It is, of course, a matter of personal opinion which of these you +prefer. The intention of do notation is to provide a more attractive +syntax for monadic programming, to be compared with programs using + + + 10 + + + + +Release Notes v2.30 2.8 The do notation + + +`bind` in which the example above would be written: + + echo' = getchar `bind` \c -> + if c==EOF then result () + else putchar c `bind` \_ -> + echo' + +See which notation you prefer for practical programming, and let me +know! + +3. THE IMPLEMENTATION OF GOFER + +For those interested in the actual implementation of Gofer, there is +a (relatively new) technical report available that describes the +implementation of Gofer 2.30: + + The implementation of the Gofer functional programming system + Mark P. Jones + Research Report YALEU/DCS/RR-1030 + Yale University, Department of Computer Science, + May 1994. + +Copies of this report are currently available by anonymous ftp from +nebula.cs.yale.edu in the directory pub/yale-fp/reports, together +with a number of other recent reports by members of the Yale Haskell +project. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 11 + + diff --git a/docsrc/Makefile b/docsrc/Makefile new file mode 100644 index 0000000..176ae97 --- /dev/null +++ b/docsrc/Makefile @@ -0,0 +1,18 @@ +# Crude makefile for producing Ascii version of Gofer docs + +all : pfmt + ./pfmt -c < usrguide.doc 2> contents + ./pfmt < usrguide.doc + ./pfmt < notes221.doc + ./pfmt < notes228.doc + ./pfmt < notes230.doc + -mkdir ../docs + mv ch* appx_* release.* ../docs + rm contents + +pfmt : pfmt.c + cc -o pfmt -O pfmt.c + +clean : + -rm contents pfmt + diff --git a/docsrc/Readme b/docsrc/Readme new file mode 100644 index 0000000..86bc66f --- /dev/null +++ b/docsrc/Readme @@ -0,0 +1,12 @@ +This directory contains the source code for the Gofer documentation. +It is made up of three files: + + usrguide.doc User manual for version 2.20 + notes221.doc Release notes for version 2.21 + notes228.doc Release notes for version 2.28 + +and a crude page formatter for producing the plain ascii versions of +these documents. I have no idea where the hacked up source for the +page formatter originally came from, but it is certainly in the public +domain ... + diff --git a/docsrc/notes221.doc b/docsrc/notes221.doc new file mode 100644 index 0000000..c1f5e08 --- /dev/null +++ b/docsrc/notes221.doc @@ -0,0 +1,1093 @@ +.co This is the source form of the release notes for Gofer 2.21 +.co +.co Mark P Jones November 1991 +.co-------------------------------------------------------------------| +.>release.221 +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.21 + + Copyright Mark P Jones 1991. + + + Release notes + +----------------------------------------------------------------------- + +This document is intended as a supplement to the user manual ``An +introduction to Gofer'' supplied with the previous public release of +Gofer, version 2.20.1. It provides brief descriptions of the changes +and new features incorporated in version 2.21. With the exception of +bug fixes, which will be distributed as soon as they become available, +there are no plans to release a further update of Gofer for some time +(at least six months). + +If you would like to be informed when bug-fixes or further versions +become available, please send email to me at mpj@prg.ox.ac.uk or +jones-mark@cs.yale.edu (if you have not already done so) and I will +add your name to the mailing list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + +In addition to PC and Sun workstations, I have now had reports that +Gofer has been successfully compiled and used on a number of other +machines including Apollo, DecStation, Mips, MicroVax and Acorn ARM +machines, with little or no changes to the original source. + + +ACKNOWLEDGMENTS + +Many of the features described in this document were motivated by +comments and suggestions from users of the previously released version +of Gofer. My thanks in particular to Julian Seward, but also to Brent +Benson, Stuart Clayman, Andy Gill, Peter Hancock, Ian Holyer, Hiroyuki +Matsuda, Aiden McCaughey, Tobias Nipkow, Will Partain, Ian Poole, +Bernard Sufrin and Phil Wadler. +.pa +.ti Release Notes +.co-------------------------------------------------------------------| +.ST 1. MINOR ENHANCEMENTS + +A number of small enhancements have been made to make the source code +for Gofer a little more flexible. In particular, this includes: + + o Gofer can now be compiled using the Gnu C compiler gcc, for those + who prefer this to the standard cc compiler provided on their + machine. + + o Default table sizes for the Unix version have been expanded which + makes it possible to support larger programs in Gofer (a program + of over 5000 lines has already been tested with this release). + + o The Makefile has been made less SunOS specific and should be + usable on a wider range of machines without modification. + +.pa +.co-------------------------------------------------------------------| +.ST 2. USER INTERFACE EXTENSIONS + +The user interface of the previous release has been extended to support +a range of new features, intended to make the Gofer environment more +convenient for program development. Further details are given in the +following sections. + +.ST 2.1 Command line options +------------------------ +Although the previous version of Gofer accepted some command line +options, these were not documented. Those who discovered the +Gofer command line options in the previous release by reading the +source code should note that a different syntax is now used which is +not compatible with the older system. + +Options may be set when loading Gofer (on the UNIX/DOS command line) +or within the interpreter itself using the :set command. Using this +command on its own with no arguments prints a menu of all of the +available options and displays the current settings: + + ? :set + Groups of options begin with +/- to turn options on/off resp. + + TOGGLES: + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Treat input files as literate scripts + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + a Use any evidence, not nec. best + E Fail silently if evidence not found + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + xnum Set maximum depth for evidence search + + Current settings: +sdcoaE -tfgleiu -h100000 -p? -x8 + ? + +Most options are toggles meaning that they can either be switched on +(by preceding the option with a `+' character) or off (by using a `-' +character). Several options may be grouped together so that: + + :set +std -le is equivalent to :set +s +t +d -l -e + +In order to distinguish command line options from filenames, a leading +`+' or `-' must also be used with the `h', `p' and `x' options, although +the choice in each case is not significant. + +Options may also be used in :a and :l commands, and within project files +(see section 2.2), although it should be noted that they will be acted +upon as soon as they are encountered and will not be reapplied when +reloading files. + +Most of the options listed above are described in more detail in the +following sections. + + +.ST 2.1.1 Set Gofer prompt +----------------------- +The standard Gofer prompt "? " may be changed using a command line +option of the form -pstr where for any string str. The new prompt is +formed from the given string, followed by a single space: + + ? :set -pGofer> + Gofer> :set -p? + ? + +.ST 2.1.2 Print statistics +----------------------- +In normal operation, Gofer displays the number of reductions and cells +used by a particular calculation when the result has been evaluated or +if the calculation is interrupted: + + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (112 reductions, 204 cells) + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + (18 reductions, 54 cells) + ? + +Printing of these statistics can be suppressed using the -s option +(and subsequently restored using +s): + + ? :set -s + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + ? [1..] + [1, 2, 3, 4, ^C{Interrupted!} + + ? :set +s + ? 2 + 4 + 6 + (2 reductions, 6 cells) + ? + + +.ST 2.1.3 Print type +----------------- +Before evaluating an expression entered into the interpreter, the Gofer +type checker is used to determine the type of the resulting value. +This is used to detect errors in the original input expression, avoid +the use of runtime type checks and determine how the value should be +output. The actual type of the term is not usually displayed unless a +type error is detected. This behaviour can be changed using the +t +option which displays the type of each value as soon as evaluation is +complete. + + ? :set +t + ? map (\x -> x*x) [1..10] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] :: [Int] + (108 reductions, 204 cells) + + ? map concat + map concat :: [[[a]]] -> [[a]] + (2 reductions, 17 cells) + + ? fix where fix f = f (fix f) + v112 :: (a -> a) -> a + (1 reduction, 7 cells) + ? + +Note that values of type String and Dialogue (or equivalent forms) are +displayed in a different manner to other values, and no type information +is printed after such values to avoid any possibility of confusion: + + ? map -- the map function + map :: (a -> b) -> [a] -> [b] + (1 reduction, 6 cells) + + ? "map" -- a string expression + map + (0 reductions, 4 cells) + + ? print "map" -- a dialogue + "map" + (18 reductions, 44 cells) + ? + + +.ST 2.1.4 Show dictionaries +------------------------ +The implementation of overloading in Gofer uses a translation of each +expression entered into the interpreter to a new expression involving +dictionary variables and constants. These additional parameters are +usually included in expressions displayed by the interpreter and are +often useful for understanding and resolving overloading problems: + + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \d125 x -> (+) d125 x x + + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? + +If necessary (perhaps to make the output of Gofer easier for a beginner +to understand), the printing of dictionary parameters may be suppressed +using the -d option: + + ? :set -d + ? \x -> x + x + ERROR: Unresolved overloading + *** type : Num a => a -> a + *** translation : \x -> x + x + + ? :t map (1+) [1..10] + map (1 +) (enumFromTo 1 10) :: [Int] + ? + +The original behaviour can be obtained using :set +d within the +interpreter. + + +.ST 2.1.5 Terminate on error +------------------------- +When an irreducible subexpression is encountered during the evaluation +of a particular expression, the irreducible redex is printed with +surrounding braces and the Gofer interpreter attempts to continue the +evaluation with other parts of the original expression: + + ? take (1/0) [1..] -- value is bottom + {primDivInt 1 0} + (4 reductions, 33 cells) + ? [1/0] -- value is [bottom] + [{primDivInt 1 0}] + (5 reductions, 34 cells) + ? [1/0, 2] -- value is [bottom, 2] + [{primDivInt 1 0}, 2] + (7 reductions, 43 cells) + ? + +Notice that, reading an expression enclosed in {braces} as bottom, each +of the values printed by Gofer gives the correct value. Of course, it +is not possible to arrange for anything to be printed when a value of +bottom is generated by a nonterminating computation: + + ? last [1..] + ^C{Interrupted!} -- nothing printed until interrupted + + (10470 reductions, 15712 cells) + ? + +An alternative behaviour is provided by the +f option, which causes the +evaluation of an expression to be abandoned completely if an error +occurs: + + ? :set +f + ? take (1/0) [1..] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 55 cells) +.pa + ? [1/0] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 54 cells) + + ? [1/0,2] + + Aborting evaluation: {primDivInt 1 0} + (3 reductions, 56 cells) + + ? + +Note that we are no longer able to distinguish between the values +produced by these three terms from the output produced by Gofer -- the +only differences are in the number of reductions and cells used which +tells us nothing about the values of the terms. Note that the basic +method of evaluation in Gofer is unchanged -- the +f option simply +modifies the printing mechanism (i.e the means by which values are +displayed) to be more strict (in the technical sense of the word). + +Although the use of the +f option makes the Gofer printing mechanism +less accurate, it is sometimes useful during program development so +that an error can be detected as soon as it occurs. The original +behaviour can of course be restored at any time using the -f +option. + + +.ST 2.1.6 Heap size +---------------- +The -hnumber option can be used to set the heap size (i.e. total number +of cells available at any one time), but cannot be used once the +interpreter has been loaded. For example, starting the interpreter +with the command: + + gofer -h20000 + +will typically start the Gofer interpreter with a heap of 20000 cells. +Note that the heap is used to hold an intermediate (parsed) form of an +input file while it is being read, type checked and compiled. It +follows that, the larger the input file, the larger the heap required +to enable that file to be loaded into Gofer. In practice, most large +programs are written (and loaded) as a number of separate files (see +section 2.2) which means that this does not usually cause problems. + + +.ST 2.1.7 Garbage collector notification +------------------------------------- +It is sometimes helpful to be able to tell when the garbage collector +is being used, in order to monitor the amount of time involved and the +number of cells recovered with each garbage collection. If the +g +command line option is given (for example, using the command :set +g) +then the garbage collector prints a message of the form {{Gc:num}} each +time that the garbage collector is invoked. The number after the colon +indicates the total number of cells that have been recovered. + +.pa +The garbage collector messages are actually printed in three sections, +which indicate which stage the garbage collector has reached (this is +only noticeable on slower machines of course!): + + {{Gc : number}} + + garbage marking cells preparing garbage + collection which are unused cells collection + begins still in use for reuse completed + +Garbage collector messages may be printed at almost any stage in a +computation (or indeed whilst loading, type checking or compiling a +file of definitions). For this reason, it is often better to turn +the garbage collector messages off (using :set -g for example) when +they are not required. + + +.ST 2.1.8 Conformality testing +--------------------------- +As described briefly in section 9.11 of the documentation for Gofer +version 2.20, pattern bindings of the form pat=expr are implemented +using a `conformality check' to ensure that the value of expr does +indeed match the pattern pat. For example, the pattern binding: + + (x:xs) = [1..] + +is actually implemented as if it had been defined by: + + (x:xs) = conformality [1..] + where conformality v@(_:_) = v + +which is in turn treated as a group of bindings: + + xxs = conformality [1..] where conformality v@(_:_) = v + x = head xxs + xs = tail xxs + +[The variables conformality and xxs used here are given as examples +only -- in practice, Gofer maintains a supply of variable names and +selects new names from this supply to avoid clashes with variables +which are already in use.] + +The conformality check does not cause any problems in the example +above because the list [1..] is always guaranteed to match the +pattern (x:xs) (i.e. a non-empty list). We can however see the +conformality check in action if we try examples in which the pattern +does not match: + + ? x where (x:xs) = [] + {v114 []} + (3 reductions, 25 cells) + + ? xs where (0:xs) = [1..] + {v114 [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1)} + (13 reductions, 94 cells) + ? + +The variable v114 in each of these examples is the variable name +representing the conformality check. As the second example shows, the +value of the expression on the right hand side of the pattern binding +is evaluated as much as necessary to determine whether the pattern +fits. + +[ASIDE: This example also demonstrates a small problem with the printer +in that, when the first element of the list is encountered, it is +unable to detect that the tail of the list has not yet been evaluated. +Consequently, the expression: + + [1] ++ iterate (primPlusInt 1) (primPlusInt 1 1) + +is not enclosed in parentheses as it should be. This is a little +annoying, but not important because the expression only appears in an +error message. The problem cannot in general be solved unless we avoid +the use of the [...] notation for enumerating the elements of a list.] + +The conformality check must be used for compatibility with Haskell. +However, it is sometimes useful to be able to suppress the conformality +check using the -c option (for example, to use some programs written +for a language without conformality checks within Gofer): + + ? :set -c + ? x where (x:xs) = [] + {_SEL (:) [] 1} + (5 reductions, 36 cells) + ? xs where (0:xs) = [1..] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14^C{Interrupted!} + + (55 reductions, 146 cells) + ? + +In the first example, the expression _SEL (:) [] 1 indicates that the +first component of an object constructed using the (:) operator is to +be extracted from the object []. Clearly this is impossible, and hence +the expression _SEL (:) [] 1 is irreducible. In the second case, the +value of xs is equivalent to _SEL (:) (1:[2..]) 2 which reduces to +the infinite list [2..] as shown, despite the fact that [1..] does not +match the pattern (0:xs). + +[ASIDE: The _SEL function is used internally by Gofer and cannot be +entered directly into the the interpreter. One particular reason for +this is that it is not in general possible to assign a sensible type +to _SEL. Constructor functions appearing as the first argument to _SEL +are printed in the normal manner. There is no standard syntax for +writing tuple constructors in Gofer or Haskell which are therefore +printed in the form (,,,) for example, where the number of commas +indicates the number of components in the tuple. In the following +example the constructor (,) denotes the pairing constructor. + + ? f a b where f (n+1) y = n+y; (a,b) = (0,1) + {v113 0 (_SEL (,) (0,1) 2)} + (10 reductions, 63 cells) + ? + +The same notation is sometimes used in the messages produced when type +errors are detected: + + ? (1,2) 3 + ERROR: Type error in application + *** expression : (1,2) 3 + *** term : (,) + *** type : a -> b -> (a,b) + *** does not match : c -> d -> e -> f + + ? + +This syntax for tuple constructor functions cannot be used in +expressions entered directly into Gofer. It may however be a nice +extension to consider for future versions, allowing definitions such +as zip = zipWith (,) and distl x = map (x,).] + + +.ST 2.1.9 Literate scripts +----------------------- +In common with most programming languages, Gofer typically treats input +from a file as a list definitions in which program text is the norm, +and comments play a secondary role, introduced by the character +sequences ``--'' and ``{- ... -}''. + +An alternative approach, using an idea described by Knuth as ``literate +programming'', gives more emphasis to comments and documentation, with +additional characters needed to distinguish program text from comments. +Gofer supports a form of literate programming based on an idea due to +Richard Bird and originally implemented as part of the functional +programming language Orwell. The same idea has subsequently been +adopted by several other functional language systems. + +A literate script contains a sequence of lines. Program lines are +distinguished from comments by a `>' character in the first column. +This makes it particularly easy to write a document which is both an +executable program script and at the same time, without need for any +preprocessing, suitable for use with document preparation software such +as LaTeX. Indeed, this document is itself a literate script containing +the following definition of the squaring function. + +> sqr x = x * x + +The +l option sets Gofer to treat each input file as a literate +script. It should not be used on the command line unless the prelude +file has been edited to make a literate script. + +The effect of using literate scripts can be thought of as applying a +preprocessor to each input file before it is loaded into Gofer. This +program has a particularly simple definition in Gofer: + + illiterate :: String -> String + illiterate cs = unlines [ xs | ('>':xs) <- lines cs ] + +The system of literate scripts used in Orwell is actually a little more +complicated than this and requires that the programmer adopt two simple +conventions in an attempt to try to catch simple errors in literate +scripts: + + o Every input file must contain at least one line whose first + character is `>'. This means that programs containing no + definitions (because the programmer has forgotten to use the `>' + character to mark definitions) from being accepted. + + o Lines containing definitions must be separated from comment lines + by one or more blank lines (i.e. lines containing only space and + tab characters). This is useful for catching programs where the + leading `>' character has been omitted from one or more lines in + the definition of a function. For example: + + > map f [] = [] + map f (x:xs) = f x : map f xs + + would result in an error if the `>' character appeared in the first + column of the first line. + +Gofer will report on errors of this kind if the +l option is combined +with the +e option (for example as +le). + + +.ST 2.1.10 Optimise (&&) and (||) +----------------------------- +The operator symbols (&&) and (||) are usually used to represent the +boolean connectives conjunction (and) and disjunction (or). By +default, Gofer uses the following equations to produce better code for +expressions involving these operators: + + x && y = if x then y else False + x || y = if x then True else y + +This optimization is only valid if the operator symbols (&&) and (||) +are indeed bound to the appropriate values at the top level (the +standard full definitions are required in order to support partial +applications involving these operators). Although this optimization is +in general valid (because the appropriated definitions are included in +the standard prelude), it may be necessary in certain cases (for +example, when working with a non-standard prelude) to suppress the +optimization using the -o option. + +.pa +.ST 2.2 Project Files +------------------ +Project files provide a simple way to use programs which are +spread across a number of source files. Larger programs are often +written in this way, to separate the different components of the +program into smaller pieces which can be developed and tested +independently of other components. + +A project file is a simple text file containing a list of program +filenames. The project file may also contain comments using either of +the Gofer conventions for comments. As a simple example, a simple +project file, in a file named "miniProlog", suitable for the +stack-based version of the mini Prolog interpreter included as a +demonstration program with Gofer 2.21 is as follows: + + -- This is a project file suitable for loading the stack-based + -- version of the mini Prolog interpreter into Gofer 2.21 + -- + -- Load into Gofer using the command: :p miniProlog + -- or from command line using: gofer + miniProlog + + Parse -- general purpose parsing library + Interact -- general purpose library for interactive programs + PrologData -- definition of main data structures + Subst -- substitutions and unification + StackEngine -- inference engine + Main -- top level program + +As indicated in the comments at the top, there are two ways of using +this file with Gofer. Within the interpreter we can use the command +:p miniProlog. Once this command has been entered, Gofer reads the +contents of the project file and then attempts to load each of the +files named. In general, if a particular project file "proj" contains +the options op1, ..., opn and the filenames f1, ..., fm, then the +command :p proj is equivalent to the sequence of commands: + + :l -- clear any previously loaded scripts + :set op1 ... opn -- set options + :l f1 ... fm -- load files + +The project file name may also be specified on the command line used to +start the interpreter by preceding the project file name with a single +`+' character. Note that there must be at least one space on each side +of the `+'. This may be combined with standard command line options, +but any additional filename arguments will be ignored. Starting Gofer +with a command of the form "gofer + proj" is equivalent to starting +Gofer without the "+ project" arguments and then giving the command +:p proj. + +In addition, Gofer records the name of the project file and displays +this with the list of files loaded. For example: + + Gofer session for: (project: miniProlog) + /users/mpj/public/Gofer/prelude + Parse + Interact + PrologData + Subst + StackEngine + Main + ? + +Once a project file has been selected, the command :p (without any +arguments) can be used to force Gofer to reread the project file and +load fresh copies of each of the files listed there. There are two +places in which this is particularly useful: + + o If the project file itself has been modified since the last time + that it was read. + + o To force Gofer to reload all of the files in the project, + regardless of the last time they were modified. + +As usual, the :r command can be used to reload each of the files in the +current project without rereading the project file itself, and avoiding +the need to read certain files which have not been modified since the +previous time they were loaded. + +The use of project files integrates smoothly with the other parts of +the Gofer environment. As an example consider a project file proj +containing the four filenames f1, f2, f3 and f4, and suppose that the +file f3 contains an error of some kind. This leads to the following +sequence of commands and results: + + :p proj -- attempt to load project proj + -- reads filenames f1, f2, f3, f4 from proj + -- load definitions from f1 + -- load definitions from f2 + -- load definitions from f3 -- error occurs + -- error message printed + :e -- starts up editor at relevant line in f3 + -- correct error + -- exit editor + -- load definitions from f3 + -- load definitions from f4 + +After just these two commands, the error in f3 has been corrected and +all of the files mentioned in proj have been loaded, ready for use. + +.pa +.ST 2.3 Other new features +----------------------- + +.ST 2.3.1 :find - find definition +------------------------------ +The command ":f name" starts up an editor to allow you to inspect (and +possibly modify) the definition of a particular name from the files +currently loaded into Gofer. If supported (using the EDITLINE +variable), Gofer will attempt to initialize the editor so that the +cursor is initially positioned at the first line in the definition. +There are three possibilities: + + o If the name is defined by a function or variable binding then + the cursor is positioned at the first line in the definition of + the name (ignoring any type declaration, if present). + + o If the name is a constructor function, then the cursor is + positioned at the first line in the definition of the + corresponding data definition. + + o If the name represents an internal Gofer function, then the + cursor will be positioned at the beginning of the standard + prelude file. + +Note that names of infix operators should be given without any +enclosing them in parentheses. Thus ":f ++" starts an editor on the +standard prelude at the first line in the definition of (++). + + +.ST 2.3.2 :! - shell escape +------------------------ +A command of the form ":! cmd" can be used to execute a specified +system command without leaving the Gofer interpreter. For example, +":! ls" (or ":! dir" on MS DOS machines) can be used to list the +contents of the current directory. + +The command ":!" without any arguments starts a new shell: + + o On a unix machine, the SHELL environment variable is used to + determine which shell to use (the default is "/bin/sh"). + + o On an MS DOS machine, the COMSPEC environment variable is used + to determine which shell to use. This is usually COMMAND.COM + and you may return to Gofer using the EXIT command. + +As usual, it is not possible to use a shell escape to change the +current working directory. The :cd command described in the following +section can be used for this purpose. + + +.ST 2.3.3 :cd - change directory +----------------------------- +The command ":cd dir" changes the current working directory to the path +given by "dir". This command is ignored if the pathname is omitted. + + +.ST 2.3.4 :names - list names +-------------------------- +The :n command lists the names of variables and functions whose +definitions are currently loaded into the Gofer interpreter. Using +this command without any arguments produces the list of all names +known to the system. For example, with just the standard prelude +loaded we obtain: + + ? :n + !! && * + ++ - . / /= : < <= == > >= AppendChan AppendFile Echo + Failure False FormatError OtherError ReadChan ReadError ReadFile + SearchError Str Success True WriteError WriteFile [] \\ ^ abort abs + all and any appendChan appendFile asTypeOf break chr cjustify + concat const copy curry cycle div done drop dropWhile echo elem + enumFrom enumFromThen enumFromThenTo enumFromTo error even exit + filter flip foldl foldl' foldl1 foldr foldr1 fromInteger fst fst3 + gcd head help id inRange index init insert interact isAlpha + isAlphanum isAscii isControl isDigit isLower isPrint isSpace + isUpper iterate last layn lcm length lines ljustify map max maximum + merge min minimum mod negate not notElem nub null odd or ord + otherwise primDivFloat primDivInt primEqFloat primEqInt + primIntToFloat primLeFloat primLeInt primMinusFloat primMinusInt + primMulFloat primMulInt primNegFloat primNegInt primPlusFloat + primPlusInt primPrint print prints product products qsort range + readChan readFile rem repeat reverse rjustify run scanl scanl' + scanl1 scanr scanr1 show show' showChar showList showString shows + showsPrec signum snd snd3 sort space span splitAt stdecho stderr + stdin stdout strDispatch strict subtract succDispatch sum sums tail + take takeUntil takeWhile thd3 toLower toUpper transpose uncurry + undefined unlines until until' unwords words writeFile zip zip3 + zip4 zip5 zip6 zip7 zipWith zipWith3 zipWith4 zipWith5 zipWith6 + zipWith7 || + (201 names listed) + ? + +Note that the names are listed in the standard alphabetical order. + +The :n can also accept one or more pattern strings which limits the list +of names printed to those names matching one or more of the given +pattern strings: + + ? :n fold* + foldl foldl' foldl1 foldr foldr1 + (5 names listed) + ? + +Each pattern string consists of a string of characters and may use the +standard wildcard characters: `*' (matches anything), `?' (matches any +single character), `\c' (matches exactly the character c) and ranges of +characters of the form `[a-zA-Z]' etc. For example: + + ? :n *ap* *[Cc]han \\\\ ? + * + - . / : < > AppendChan ReadChan \\ ^ appendChan appendFile + map readChan + (16 names listed) + ? + + +.ST 2.3.5 $$ - recall last expression +---------------------------------- +The previously entered expression can be recalled at any stage whilst +using the Gofer interpreter (even if the list of currently loaded files +has subsequently been changed) by using the operator symbol $$: + + ? 42 + 42 + (1 reduction, 5 cells) + ? [$$] + [42] + (3 reductions, 12 cells) + ? [$$] + [[42]] + (5 reductions, 19 cells) + ? ($$, length $$) + ([[42]],1) + (14 reductions, 43 cells) + ? + +The $$ symbol is bound to a new value each time that an expression is +evaluated, or its type determined using the :t command: + + ? :t $$ + ([[42]],length [[42]]) :: ([[Int]],Int) + ? :t map (1+) [1..10] + map ((+) {dict} 1) (enumFromTo {dict} 1 10) :: [Int] + ? $$ + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (100 reductions, 189 cells) + ? + +Note that $$ can also be used when the last expression entered used +a where clause (such expressions are simply translated into the +appropriate let expressions): + + ? fibs where fibs = 0:1:zipWith (+) fibs (tail fibs) + [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55^C{Interrupted!} + + (41 reductions, 136 cells) + ? :t $$ + let {...} in fibs :: [Int] + ? take 5 $$ + [0, 1, 1, 2, 3] + (24 reductions, 77 cells) + ? + +Note that $$ expands to the unevaluated form of the expression, so that +a certain amount of computation may be repeated if $$ is used more than +once in a subsequent expression: + + ? sum [1..10] + 55 + (92 reductions, 130 cells) + ? $$ + $$ + 110 + (176 reductions, 254 cells) + ? x + x where x = sum [1..10] + 110 + (89 reductions, 131 cells) + ? + +Note that the value of $$ is updated after the expression has been parsed +but before it is type checked: + + ? 42 + 42 + (1 reduction, 5 cells) + ? 4) + ERROR: Syntax error in input (unexpected `)') + ? $$ 4 + ERROR: Type error in application + *** expression : 42 4 + *** term : 42 + *** type : Int + *** does not match : a -> b + + ? + + +.ST 2.3.6 Command names +-------------------- +Command names of the form :X (where X represents an arbitrary capital +letter) are no longer supported. Each command has a mnemonic full name +of the form :name which can be abbreviated to :n where `n' is the first +letter of the full name. The complete list of commands produced by the +:? command is as follows: + + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :set set command line options + :set help on command line options + :? display this list of commands + evaluate expression + :type print type of expression + :names [pat] list names currently in scope + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + :find edit file containing definition of name + :! command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? + + +.pa +.co-------------------------------------------------------------------| +.ST 3. LANGUAGE DIFFERENCES + +There are very few changes to the language supported by Gofer -- most +programs that ran correctly under the previous release should run +without any changes. The features described in the following sections +are (for the most part) extensions to the previous version. + +.ST 3.1 c*p and p+k patterns +------------------------ +Motivated by recent discussion on the Haskell mailing list, starting +with a posting from Tony Davie, Gofer now supports a more general form +of n+k pattern, together with a new form of pattern, c*p. The syntax +of patterns is extended to include: + + pattern ::= .... | pattern + integer | integer * pattern + +Note that, in the previous version of Gofer, only variables were +permitted for the pattern p in a p+k pattern. Certain restrictions are +placed on the constants c and k used in c*p and p+k patterns; Gofer +currently requires c>1 and k>0. + +The semantics of these new patterns are described by the equations +(suggested by Kent Karlsson): + + case e0 of {p+k -> e; _ -> e'} + = if e0 >= k then case e0-k of {p -> e; _ -> e'} else e' + + case e0 of {c*p -> e; _ -> e'} + = if e0 >= 0 then case e0 `divRem` c of {(p, 0) -> e; _ -> e'} + else e' + +In Gofer, both forms of pattern match nonnegative integers only (there +is no possibility for overloading here as there is in Haskell). + +These features are included in Gofer to enable experimentation with the +use of c*p patterns. They are not currently supported by Haskell, and +are subject to change as we gain more experience using them. To +illustrate the potential uses for these extensions, here are two +examples provided by Tony Davie in his original message which can be +used in Gofer: + + x^^0 = 1 -- fast exponentiation + x^^(2*n) = xn*xn where xn = x^^n -- compare with definition + x^^(2*n+1) = x * x^^(2*n) -- of (^) in the prelude + + fib 1 = 1 -- fast fibonnacci + fib 2 = 1 + fib (2*n) = (fib(n+1))^^2 - (fib(n-1))^^2 + fib (2*n+1) = (fib(n+1))^^2 + (fib n )^^2 + + +.ST 3.2 Errors during output +------------------------ +If an error of the form "error str" occurs during an output request in +a program using the facilities for I/O, the IOError value passed to +the failure continuation is the (WriteError str), rather than +(WriteError "{error str}") as in the previous release. This enables +further evaluation of the string str (for example to produce a +compound error message by concatenating several strings together). + +You are strongly advised to consider using the standard prelude +continuation "exit" in your programs in place of the "abort" predicate; +whereas "abort" causes a program to terminate without any indication of +the problem, "exit" attempts to print a suitable error message before +the program terminates. + + +.ST 3.3 Type synonyms in predicates +------------------------------- +Type synonyms may now be used in predicates (The previous release +allowed only data constructors). This means that programs such as the +cat program described in section 14.2.6 (page 68) of the Gofer +documentation can now be written as: + + class Cat a where cat :: a -> Dialogue + instance Cat String where cat n = showFile n done + instance Cat [String] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) + +This uses the type synonym String in place of the expanded form [Char] +required by the original program. Note that it is still not permitted +to define overlapping instances; an attempt to add an instance for Cat +[Char] to the above will not be accepted. + + +.ST 3.4 Reporting on ambiguous types +-------------------------------- +Class declarations whose member functions have ambiguous types are no +longer permitted. For example, in the class declaration: + + class Box a where + mem :: Int + +The type of the member function mem is Box a => Int which is ambiguous +and produces the error message: + + ERROR "examp" (line 3): Ambiguous type signature in class declaration + *** ambiguous type : Box a => Int + *** assigned to : mem + + ? + +Similar error messages are produced when an explicit type signature +includes an ambiguous type. For example: + + func :: Eq a => Int -> Int + func x = 2*x+1 + +Results in an error of the form: + + ERROR "examp" (line 12): Ambiguous type signature in type declaration + *** ambiguous type : Eq a => Int -> Int + *** assigned to : func + + ? + +By default, no error is signalled if an ambiguous type is assigned to a +variable or function by the type checker. This makes it possible to +write definitions such as: + + f y xs = if xs==[] then 0 else g y + g y = f y [] + +The types obtained for each of these terms is as follows: + + f :: Eq [a] => b -> [a] -> Int + g :: Eq [a] => b -> Int + +Note that the second type is ambiguous. Making the analogy between +these mutually recursive functions and a two state machine, we can +think of a direct call to f as initializing the machine correctly so +that there is no problem when we enter g. On the other hand, entering +the system at g does not initialize the machine correctly, as signalled +by the ambiguity. + +Using the +u command line flag forces Gofer to generate an error when +an attempt to assign an ambiguous type to a top-level function occurs. +For the above example this gives: + + ERROR "examp" (line 20): Ambiguous type signature in inferred type + *** ambiguous type : Eq [a] => b -> Int + *** assigned to : g + + ? + +The restriction to top-level functions means that f can still be +implemented by writing: + + f :: Eq [a] => b -> [a] -> Int + f = f' where f' y xs = if xs==[] then 0 else g y + g' y = f y [] + +which prevents external access to g' (preventing entry to the finite +machine described above in state g). Note that the type signature in +this example is necessary to avoid the monomorphism restriction. + + +.pa +.co-------------------------------------------------------------------| +.ST 4. OTHER MATTERS + +.ST 4.1 Contributions +----------------- +I would like to hear from anyone with interesting Gofer programs or +other useful items which might be included (with full credit to the +original author(s) of course!) in subsequent releases of Gofer. There +is already one example of this in the new release; a small gnuemacs +mode for running the Gofer interpreter from within gnuemacs on Unix +machines, contributed by Stuart Clayman. See the file gofer.el for +more details. + +.ST 4.2 Future directions +--------------------- +There will not be another release of Gofer for some time. There are +however a number of areas which I would like to investigate at some +point as extensions to the Gofer system: + + o The ability to use Haskell style type classes. + + o Facilities for working with modules, based on the approach + described in the Haskell report. A particular problem here is + in finding an elegant way to provide the full power of the + module system from the interactive environment. + + o The ability to write stand alone applications programs using + Gofer. + + o An improved user interface. There are a number of grand ideas + based on the use of windowing/mouse/pulldown-menus etc. The + current user interface is closer to this kind of approach than + might at first be realized. More interesting ideas include the + design of class, data type and value browsers, along the lines + of a Smalltalk system. + +I would be interested to hear from anyone with comments or suggestions +on any of these (or other ideas). +.co-------------------------------------------------------------------| diff --git a/docsrc/notes228.doc b/docsrc/notes228.doc new file mode 100644 index 0000000..ed01c30 --- /dev/null +++ b/docsrc/notes228.doc @@ -0,0 +1,2757 @@ +.co This is the source form of the release notes for Gofer 2.28 +.co +.co Mark P Jones January 1993 +.co-------------------------------------------------------------------| +.>release.228 +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.28 + + Copyright Mark P Jones 1993. + + Release notes +----------------------------------------------------------------------- + +This document is intended to be used as a supplement to the original +user manual ``An introduction to Gofer version 2.20'' and release +notes for Gofer 2.21 (previously supplied in a file called `update'). + +If you would like to be informed when bug-fixes or further versions +become available, please contact me at jones-mark@cs.yale.edu (if you +have not already done so) and I will add your name to the list. + +Please contact me if you have any questions about the Gofer system, or +if you need some advice or help to complete a port of Gofer to a new +platform. + + +ACKNOWLEDGMENTS: +A lot of people have contributed to the development of Gofer 2.28 with +their support, encouragement, suggestions, comments and bug reports. +There are a lot of people to thank: + + Ray Bellis Brent Benson + David Bolton Rodney Brown + Dave Cattrall Manuel Chakravarty + Rami El Charif Stuart Clayman + Andy Duncan Bernd Eckenfels + Stephen Eldridge Jeroen Fokker + Andy Gill Annius Groenink + Dipankar Gupta Guenter Huebel + Jon Hallett Kevin Hammond + Peter Hancock Ian Holyer + Andrew Kennedy Marnix Klooster + Tom Lane Hiroyuki Matsuda + Aiden McCaughey Tobias Nipkow + Rainer Orth Will Partain + Simon Peyton Jones Ian Poole + Mark Raemer Dave Rushall + Julian Seward Carol Tumey + Goran Uddeborg Gavin Wraith + Bryan Scattergood Matthew Smith + Bernard Sufrin Philip Wadler + +This list isn't complete, and I apologize in advance if I have +inadvertently left your name out. +.pa +.ti Release Notes v2.28 +.co-------------------------------------------------------------------| +.ST 1. MINOR ENHANCEMENTS AND BUGFIXES + +The following sections list the minor enhancements and bugfixes that +have been made to Gofer since the release of Gofer version 2.23. More +significant changes are described in later sections. + + +.ST 1.1 Enhancements +----------------- + o For systems without the restrictions of older PCs, Gofer now uses + multiple hash tables to speed the lookup of globally defined + functions. Loading large programs into Gofer is now much faster + as a result. In one example, the time taken to load a 13,000 line + program spread across 40 individual script files was reduced by a + factor of five! + + o For the most most part, internal errors (which shouldn't normally + appear anyway) no longer terminate the interpreter. + + o Better handling for programs with objects whose type involves more + than 26 type variables (though whether anyone has real practical + applications for such beasts, I'm rather doubtful). + + o The Gofer system now supports I/O requests GetProgName, GetArgs + and GetEnv. The first two requests don't have any sensible + interpretation within the interpreter, so GetProgName always + returns "", while GetArgs returns []. These I/O requests are most + useful when producing standalone applications with the Gofer + compiler where they do indeed give the name of the program and the + list of command line arguments as expected. + + o Added primitives for direct comparison of characters. The + original definitions of character equality and ordering in terms + of the equality and ordering on integers was elegant, but for some + examples, a substantial number of the total reductions in a given + program was taken up with calls to ord, an unnecessary + distraction. + + o Small improvements in the speed of execution of the runtime machine, + particularly when Gofer is compiled using the GNU C compiler. + + o Enabled the use of GNU C specific options to store frequently used + global variables in CPU registers. This is perhaps most useful + for speeding up the performance of standalone applications + produced using the Gofer compiler. + + o Changed definitions in standard preludes to provide overloaded + versions of sum, product, sums, products, abs, signum and (^). + Also added a genericLength function as in Haskell. Finally, + added Text as a superclass of Num, again for Haskell compatibility. + + o Added a new primitive function: openfile :: String -> String that + can be used to read the contents of a file (named by the argument + string) as a (lazy) stream of characters. (The implementation is + in terms of a primitive which can also be used to implement the + hbc openFile function, provided that you also define the Either + datatype used there.) + + o Added support for a simple selection of operators for monadic I/O, + mutable variables etc. based on Lambda var (developed at Yale) and + the Glasgow I/O system. I will provide more documentation on this + as soon as there is a better consensus on the names of the + datatypes and functions that should be included in systems like + this. + + o The error function is now implemented using a primitive function. + + o Added support for floating point primitives: + + pi :: Float + + sin, asin, + cos, acos, + tan, atan, + log, log10, + exp, sqrt :: Float -> Float + + atan2 :: Float -> Float -> Float + truncate :: Float -> Int + + o Added support for the use of GNU readline (or equivalent) library + to be used to enhance the user interface with command line + editing. See the source makefile for instructions on how to use + this. + + o Added floating point support to PC version of Gofer (even the + version for humble 8086 PCs will now support floating point). + Thanks to Jeroen Fokker for this! + + o I/O datatype definitions and otherwise symbol are now builtin to + the Gofer system. + + o Other minor tweaks and improvements. + + +.ST 1.2 Bug fixes +-------------- +Nobody really likes to dwell on bugs, especially when they have been +eliminated. But for those of you who want to know, here is a summary of +the bugs discovered and fixed in Gofer 2.28: + + o End of file does not imply end of line (only significant on + certain systems ... I has made an assumption which happens to hold + under DOS and Unix, but was not true for other systems). + + o Code generator produced incorrect code for some conditional + expressions involving local variables (fairly obscure). + + o Some conditional expressions entered into the interpreter were + evaluated incorrectly, leading to unexpected evaluation errors. + + o A small potential space leak concerned with saving the names of + files passed to the editor from within Gofer was eliminated. + + o A subtle bug, which only occurred when a garbage collection + occurred in the middle of an attempt to update a cell with an + indirection has been fixed. + + o Fixing the definitions of the div and quot operators to agree with + Haskell 1.2 (these had been changed in the transition from 1.1 to + 1.2 without my noticing). + + o Corrected bug in string matching code (part of the :names command) + which previously allowed "*e*p" to match with "negate"! + + o Nested comments were not always handled correctly when they + occurred at the very end of a script file. + + o Added new clauses to parser to improve and correct error messages + produced by some examples. + + o Other miscellaneous tweaks and fixes. + +There are no other currently known bugs in Gofer. But someone is bound +to find a new one within hours of the release of 2.28 if past +experience is anything to go by. If that someone is you, please let me +know! + + +.co-------------------------------------------------------------------| +.ST 2. USER INTERFACE EXTENSIONS + +The user interface of the previous release has been extended a little +to support a range of new features, intended to make the Gofer +environment more convenient for program development. Further details +are given in the following sections. + +.ST 2.1 Customizing the Gofer system +--------------------------------- +Often there will be several people using Gofer on the same system. Not +everyone will want to be using the system in the same way. For example, +some users may wish to use their own version of the prelude or start the +interpreter with particular command line options. + +It has always been possible to do this by installing Gofer in an +appropriate manner. But, having had more than a couple of enquiries +about this, I wanted to take some time to spell the process out more +clearly. The following description will be biased towards those people +using Gofer on Unix-like systems, but the same basic principles can be +applied with other operating systems too. + +The Gofer interpreter and prelude files will typically be installed in +a given directory, accessible to all users on the system. For the sake +of this example, let's assume that this is /usr/local/lib/Gofer. Each +user could take a copy of the Gofer interpreter into their own file +space, but a much better option is for each user to use a short script +file stored somewhere on their path. For example, the path on my Unix +account includes a subdirectory called bin and I store the following +script file `gofer' in this directory: + + #!/bin/sh + # + # A simple shell script to invoke the Gofer interpreter and set + # the path to the prelude file. Ultimately, you might want to + # copy this file into your own bin directory so that you can record + # your favourite command line settings or use a different prelude + # file ... + # + GOFER=/usr/local/lib/Gofer/standard.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer $* + +I happen to use the standard prelude file and the default settings for +all the command line options. If, for example, I wanted to use a +different prelude file, a smaller heap and omit the printing of +statistics about the number of reductions and cells used in an +evaluation, I can modify the script to reflect this: + + #!/bin/sh + # + # A modified version of the above script + # + GOFER=/usr/local/lib/Gofer/simple.prelude + export GOFER + exec /usr/local/lib/Gofer/gofer -h20000 -s $* + +Of course, it is also possible to keep both of these short scripts in +my bin directory, so that I have the choice of starting up Gofer in +several different configurations, depending on the kind of work I'm +going to be doing with it. + + +.ST 2.2 Command line options +-------------------------- +Gofer 2.28 supports a number of options which can be set, either on the +command line when Gofer interpreter is started, or using the :set +command within in the interpreter. Using the :set command without any +arguments produces a list of all the command line options available: + + ? :set + TOGGLES: groups begin with +/- to turn options on/off resp. + s Print no. reductions/cells after eval + t Print type after evaluation + d Show dictionary values in output exprs + f Terminate evaluation on first error + g Print no. cells recovered after gc + c Test conformality for pattern bindings + l Literate scripts as default + e Warn about errors in literate scripts + i Apply fromInteger to integer literals + o Optimise use of (&&) and (||) + u Catch ambiguously typed top-level vars + . Print dots to show progress + w Always show which files loaded + 1 Overload singleton list notation + k Show kind errors in full + + OTHER OPTIONS: (leading + or - makes no difference) + hnum Set heap size (cannot be changed within Gofer) + pstr Set prompt string to str + rstr Set repeat last expression string to str + + Current settings: +sfceow1 -tdgliu.k -h100000 -p? -r$$ + ? + +Most of these are the same as in the previous release of Gofer. The +following sections outline the few changes that have been made. The +`1' and `k' toggles are for use with constructor classes and will be +described in Section 4. + + +.ST 2.2.1 Print dots to show progress +---------------------------------- +One of the first differences that you might notice when running the +new version of Gofer is that the rows of dots printed when loading a +script file: + + ? :l examples + Reading script file "examples": + Parsing.................................... + Dependency analysis........................ + Type checking.............................. + Compiling.................................. + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + +are no longer printed while script files are loaded. The rows of dots +are useful for showing progress on slow machines (like the PC on which +Gofer was originally developed) where it is reassuring to know that the +system has not crashed, and is simply working its way through one +particular phase of the system. However, on a faster system, the dots +are not necessary and printing them can impose a surprising overhead on +the time it takes to load files. As a default, Gofer now simply prints +the names of each phase (Parsing, Dependency Analysis, Type checking +and Compiling) and, when that phase is complete, backspaces over it to +erase it from the screen. If you are fortunate enough to be using a +fast machine, you may not always see the individual words as they flash +past. After loading a file, your screen will typically look something +like this: + + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + +On some systems, the use of backspace characters to erase a line may +not work properly. One particular example of this occurs if you try to +run Gofer from within emacs. In this case, you may prefer to use the +original setting, printing the lines of dots by giving the command: + + :set +. + +The default setting is (as illustrated above, :set -.). In practice, +you will probably want to include the appropriate setting for this +option in your startup script (see Section 2.1). + + +.ST 2.2.2 Always show which files loaded +------------------------------------- +Some people may feel that the list of filenames printed by Gofer after +successfully loading one or more script files is redundant. This is +particularly likely if you are using the (usually default) :set -. +option since the list of files loaded will probably still be on the +screen. The list of filenames can be suppressed using the :set -w +option as follows: + + ? :l examples + Reading script file "examples": + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? :set -w + ? :l examples + Reading script file "examples": + ? + +The default setting can be recovered using a :set +w command. + +Note that you can also use the :info command (without any arguments) as +described in Section 2.3.2 to find out the list of files loaded into the +current Gofer session. This should be particularly useful if you choose +the :set -w option. + + +.ST 2.2.3 Set repeat string +------------------------ +The previous expression entered into the Gofer system can be recalled +as part of the next expression using the symbol $$: + + ? map (1+) [1..10] + [2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + (101 reductions, 189 cells) + ? filter even $$ + [2, 4, 6, 8, 10] + (130 reductions, 215 cells) + ? + +This feature was provided and documented in the previous release of +Gofer. However, it is possible that you may prefer to use a different +character string. This is the purpose of the -rstr option which sets +the repeat string to str. For example, user's of SML might be more +comfortable using: + + ? :set -rit + ? 6*7 + 42 + (3 reductions, 7 cells) + ? it + it + 84 + (4 reductions, 11 cells) + ? + +Another reason for making this change might be that you have a program +which uses the symbol $$ as an operator. Each occurrence of the $$ symbol +in a script file will be interpreted as the correct operator, whatever +the value of the repeat string. But, if the default :set -r$$ setting is +used, any occurrence of $$ in an expression entered directly to the +evaluator will be taken as a reference to the previous expression. + +Note that the repeat string must be either a valid Haskell identifier or +symbol, although it will always be parsed as an identifier. If the +repeat string is set to a value which is neither an identifier or symbol +(for example, :set -r0) then the repeat last expression facility will be +disabled altogether. + + +.ST 2.2.4 Other changes +-------------------- +Comparing the list of command line options in Section 2.2 with the list +produced by previous versions of Gofer will reveal some other small +differences not already mentioned above. The changes are as follows: + + o The default setting for the d toggle (show dictionaries in output + expressions) has been changed to off (:set -d). For a lot of + people, the appearance of dictionary values was rather confusing + and of little use. If you still want to see how dictionary values + are used, you will need to do :set +d or add the +d argument to + your startup script. + + o The default setting for the e toggle (warn about errors in + literate scripts) has been changed to :set +e for closer + compatibility with the literate script convention outline in the + Haskell report, version 1.2. In addition, the setting of the l + toggle is now used only as a default if no particular type of + script file is specified by the file extension of a give script. + See Section 2.4 below for further details. + + o The default setting for the f toggle (terminate evaluation on + first error) has been changed to :set +f. The old setting of + :set -f is, in my opinion, better for debugging purposes, but + does not give the behaviour that those using Haskell might + expect. This has caused a certain amount of confusion and was + the motivation for this change. + + o The following three command line options, provided in previous + versions of Gofer, have now been removed: + + TOGGLES: + a Use any evidence, not nec. best + E Fail silently if evidence not found + + OTHER OPTIONS: + xnum Set maximum depth for evidence search + + These options were only ever used for my own research and were + (intentionally) undocumented, so it seemed sensible to remove them + from the distributed system. A quick patch to the source code and + a recompilation is all that is necessary to reinstate these + options; useful if somebody out there found out about these + options and actually uses them (if you do, I'd love to know + why!). + + +.ST 2.3 Commands +------------- +The full list of commands that can be used from within the Gofer +interpreter are summarized using the command :? as follows: + + ? :? + LIST OF COMMANDS: Any command may be abbreviated to :c where + c is the first character in the full name. + + :load load scripts from specified files + :load clear all files except prelude + :also read additional script files + :reload repeat last load command + :project use project file + :edit edit file + :edit edit last file + evaluate expression + :type print type of expression + :? display this list of commands + :set set command line options + :set help on command line options + :names [pat] list names currently in scope + :info describe named objects + :find edit file containing definition of name + :!command shell escape + :cd dir change directory + :quit exit Gofer interpreter + ? + +Almost all of these commands are the same as in the previous release. +The only new features are listed in the following sections. + + +.ST 2.3.1 Shell escapes +-------------------- +The shell escape command :! is used to enable you to run other programs +from within the Gofer interpreter. For example, on a Unix system, you +can print a list of all the files in the current directory by typing: + + ? :!ls + + ? + +The same thing can be achieved on a PC running DOS by typing: + + ? :!dir + + ? + +This is the same as in previous releases of Gofer; the only difference +is that there is no longer any need to type a space between the :! +command and the shell command that follows it. In fact, there is no +longer any need to type the leading colon either. Thus the two commands +above could equally well have been entered as: + + !ls + !dir + +To start a new shell from within Gofer, you can use the command :! or the +abbreviated form ! -- in Unix and DOS you can return to the Gofer system +by entering the shell command `exit'. This is likely to be different if +you use Gofer on other systems. + + +.ST 2.3.2 Information about named values +------------------------------------- +The :info command is a new feature which is useful for obtaining +information about the values currently loaded into a Gofer session. It +can be used to display information about all kinds of different values +including: + + o Datatypes: The name of the datatype and a list of its associated + constructor functions is printed: + + ? :info Request + -- type constructor + data Request + + -- constructors: + ReadFile :: String -> Request + WriteFile :: String -> String -> Request + AppendFile :: String -> String -> Request + ReadChan :: String -> Request + AppendChan :: String -> String -> Request + Echo :: Bool -> Request + GetArgs :: Request + GetProgName :: Request + GetEnv :: String -> Request + + ? + + o Type synonyms: Prints the name and expansion of the synonym: + + ? :info Dialogue + -- type constructor + type Dialogue = [Response] -> [Request] + + ? + + If the type synonym is restricted (see Section 3.1) then the + expansion is not included in the output: + + ? :info Stack + -- type constructor + type Stack a = + + ? + + o Type classes: Lists the type class name, superclasses, member + functions and instances: + + ? :info Eq + -- type class + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + instance Eq Int + instance Eq Float + instance Eq Char + instance Eq a => Eq [a] + instance (Eq a, Eq b) => Eq (a,b) + instance Eq Bool + + ? + + Note that the member functions listed for the class include the + class predicate as part of the type; the output is not intended + to be thought of as a syntactically valid class declaration. + + Overlapping instance declarations (see Section 3.2) are listed in + increasing order of generality. + + o Other values: for example, named functions and individual + constructor and member functions: + + ? :info map : <= + map :: (a -> b) -> [a] -> [b] + + (:) :: a -> [a] -> [a] -- data constructor + + (<=) :: Ord a => a -> a -> Bool -- class member + + ? + +As the last example shows, the :info command can take several arguments +and prints out information about each in turn. A warning message is +displayed if there are no known references to an argument: + + ? :info (:) + Unknown reference `(:)' + ? + +This illustrates that the arguments are treated as textual names for +operators, not syntactic expressions (for example, identifiers). The +type of the (:) operator can be obtained by giving the command :info : +as above. There is no provision for including wildcard characters of +any form in the arguments of :info commands. + +If a particular argument can be interpreted as, for example, a +constructor function, or a type constructor depending on context, both +possibilities are displayed. For example, loading a program containing +the definition: + + data Set a = Set [a] + +We obtain: + + ? :info Set + -- type constructor + data Set a + + -- constructors: + Set :: [a] -> Set a + + Set :: [a] -> Set a -- data constructor + + ? + +If no arguments are supplied to :info, a list of all the script files +currently loaded into the interpreter will be displayed: + + ? :info + + Gofer session for: + /usr/local/lib/Gofer/standard.prelude + examples + ? + + +.ST 2.4 Literate scripts +--------------------- +Support for literate scripts -- files in which program lines begin with +a `>' character and all other lines are treated as comments -- was +provided in previous versions of Gofer. The command line option +:set +l was used to force Gofer to treat each input file as a literate +script, while :set -l (the default) was used to treat each input file +as a standard script of definitions. + +In practice, this turned out to be somewhat inconvenient, particularly +when loading combinations of files, some as literate scripts, some +without. For example, quite a few people kept two versions of the +prelude, one as a literate script, one not, so that they wouldn't have +to fiddle with the settings or using the :set commands to load files. + +Gofer version 2.28 now uses a more sophisticated scheme to determine +how an input script file should be treated, based on the use of file +extensions. More specifically, any script file with a name ending in +one of the following suffixes: + + .hs .has .gs .gof .prelude + +will always be loaded as a normal (i.e. non-literate) script file, +regardless of the setting of the l command line option. In a similar +way, files with names ending in one of the following suffixes: + + .lgs .lhs .verb .lit + +will always be treated as literate scripts. The command line option l +is only used for files with names not ending in one of the above +suffixes. + +For example, the commands: + + :set -l + :load prog1.gs prog2 prog3.lgs + +will load prog1.gs and prog2 as non-literate scripts, and then load +prog3.lhs as a literate script. + + +.ST 2.5 Prelude files +------------------ +The Gofer system comes with a standard prelude, and a small number of +alternative preludes. These have always been there, but a lot of +people don't seem to have noticed these, so I thought I'd say a few +words about the different preludes included with Gofer: Remember that +you can always change the prelude you are using by setting the GOFER +environment variable or by modifying a startup script as described in +Section 2.1: + + standard.prelude The standard Gofer prelude, using type classes + and providing the familiar range of operators + and functions. + + nofloat.prelude A simplified version of the standard.prelude + which does not include any floating point + operators. This is likely to be of most use + for those using Gofer on PCs where memory is + at a premium; compiling a version of the + interpreter (or compiler runtime library) + without floating point support can give an + important saving. + + simple.prelude A prelude file based on the standard prelude + but without type classes. Let me emphasize + that point: YOU CAN USE GOFER WITHOUT HAVING + TO LEARN ABOUT TYPE CLASSES :-) Some people + seem to take to the use of type classes right + from the beginning. For those that have + problems understanding the technical details + or even the motivation, the simple.prelude + can be used to get you familiar with the syntax + of the language and the basic principles. + Then you can move up to the standard.prelude + when you're ready. The principle differences + can be described by listing the types of + commonly used operators in the simple.prelude: + + (==) :: a -> a -> Bool + (<=) :: a -> a -> Bool + (<) :: a -> a -> Bool + (>=) :: a -> a -> Bool + (>) :: a -> a -> Bool + (/=) :: a -> a -> Bool + show :: a -> String + (+) :: Int -> Int -> Int + (-) :: Int -> Int -> Int + (*) :: Int -> Int -> Int + (/) :: Int -> Int -> Int + + The resulting language is closer to the system + in Bird and Wadler (and can be made closer + still by editing the simple.prelude to use + zipwith instead of zipWith etc...). + + cc.prelude An extended version of the standard.prelude + including support for a number of useful + constructor classes. Most of the examples + and applications described in Section 4 are + based on this prelude. + + min.prelude A minimal prelude file. If you really want to + build a very small prelude for a particular + application, start with this and add the extra + things that you need. + +As you can see, the standard extension for prelude files is .prelude +and any file ending with this suffix will be read as a non-literate +script (as described in Section 2.4). Note that, even if you are using +a computer where the full name of a prelude file is not stored (for +example, on a DOS machine the standard.prelude file becomes +STANDARD.PRE) you should still specify the prelude file by its full +name to ensure that the Gofer system treats it correctly as a prelude +file. + +You are also free to construct your own prelude files, typically by +modifying one of the supplied preludes described above. Anyone who +created prelude files for use with previous releases of Gofer will need +to edit these files to ensure that they will work correctly. Note in +particular that there is no longer any need to include definitions of +the I/O datatypes in programs. Furthermore, the error function should +now be bound to the primitive "primError" rather than using the old +definition of error s | False = error s. + + +.co-------------------------------------------------------------------| +.ST 3. LANGUAGE DIFFERENCES + +This section outlines a number of small differences and extensions to +the language used by Gofer. These features are not included in the +definition of Haskell, so you shouldn't be thinking that programs +written using these features can ultimately be used with a full Haskell +system. The use of constructor classes -- a more substantial change is +described in Section 4. + +.ST 3.1 Restricted type synonyms +----------------------------- +Gofer 2.28 supports a form of restricted type synonym that can be used +to restrict the expansion of the synonym to a particular set of +functions. Outside of the selected group of functions, the synonym +constructor behaves like a standard datatype. More precisely, a +restricted type synonym definition is a top level declaration of the +form: + + type T a1 ... am = rhs in f1, ..., fn + +where T is the name of the restricted type synonym constructor and rhs +is a type expression typically involving some of the (distinct) type +variables a1, ..., am. The same kind of restrictions that apply to +normal type synonym declarations are also applied here. The major +difference is that the expansion of the type synonym can only be used +within the binding group of one of the functions f1, ..., fn (all of +which must be defined by top-level definitions in the file containing +the restricted type synonym definition). In the definition of any +other function, the type constructor T is treated as if it had been +introduced by a definition of the form: + + data T a1 ... am = ... + +The original motivation for restricted type synonyms came from my work +with constructor classes as described in Section 4 and you will several +examples of this in the ccexamples.gs file in the demos/Ccexamples +directory of the standard distribution. For a simpler example, +consider the following definition of a datatype of stacks in terms of +the standard list type: + + type Stack a = [a] in emptyStack, push, pop, top, isEmpty + +The definitions for the five functions named here are as follows: + + emptyStack :: Stack a + emptyStack = [] + + push :: a -> Stack a -> Stack a + push = (:) + + pop :: Stack a -> Stack a + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top :: Stack a -> a + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty :: Stack a -> Bool + isEmpty = null + +The type signatures here are particularly important. For example, +since emptyStack is mentioned in the definition of the restricted type +synonym Stack, the definition of emptyStack is type correct. The +declared type for emptyStack is Stack a which can be expanded to [a], +agreeing with the type for the empty list []. However, in an expression +outside the binding group of these functions, the Stack a type is quite +distinct from the [a] type: + + ? emptyStack ++ [1] + ERROR: Type error in application + *** expression : emptyStack ++ [1] + *** term : emptyStack + *** type : Stack a + *** does not match : [Int] + + ? + +The `binding group' of a value refers to the set of values whose +definitions are in the same mutually recursive group of bindings. In +particular, this does not extend to the type class system so we can +define instances such as: + + instance Eq a => Eq (Stack a) where + s1 == s2 | isEmpty s1 = isEmpty s2 + | isEmpty s2 = isEmpty s1 + | otherwise = top s1 == top s2 && pop s1 == pop s2 + +As a convenience, Gofer allows the type signatures of functions +mentioned in the type synonym declaration to be specified within the +definition rather than in a different point in the script. Thus the +example above could equally well have been written as: + + type Stack a = [a] in + emptyStack :: Stack a, + push :: a -> Stack a -> Stack a, + pop :: Stack a -> Stack a, + top :: Stack a -> a, + isEmpty :: Stack a -> Bool + + emptyStack = [] + + push = (:) + + pop [] = error "pop: empty stack" + pop (_:xs) = xs + + top [] = error "top: empty stack" + top (x:_) = x + + isEmpty = null + +However, the first form is necessary when you want to define two or +more restricted type synonyms simultaneously. For example: + + type Pointer = Int in allocate, deref, assign + type Heap a = [a] in newHeap, allocate, deref, assign + newHeap :: Heap a + allocate :: Heap a -> (Heap a, Pointer) + deref :: Heap a -> Pointer -> a + assign :: Heap a -> Pointer -> a -> Heap a + etc ... + +The use of restricted type synonyms doesn't quite provide proper +abstract data types. For example, if you try: + + ? push 1 emptyStack + [1] + (5 reductions, 11 cells) + ? + +then the structure of the stack as a list of values is revealed by the +printing mechanism. This happens because Gofer uses the show' function +to print out a value (in this case of type Stack Int) which looks inside +the structure of the object to see how it is represented. This happens +to be most convenient for use in an interpreter as an aid to debugging. +For the purists (and the preservation of abstraction), Gofer could be +modified to apply the (overloaded) show function to printed values. +This would force the programmer to define the way in which stack values +are printed (distinct from lists) and preserve the abstraction. Without +having set up this machinery, we get: + + ? show (push 1 emptyStack) + ERROR: Cannot derive instance in expression + *** Expression : show (push 1 emptyStack) + *** Required instance : Text (Stack Int) + + ? + +The Gofer compiler described in Section 5 does not implement show' and +hence enforces the abstraction. + + +.ST 3.2 Overlapping instance declarations +-------------------------------------- +This section describes a somewhat technical extension, aimed at those +who work with type classes. Many readers may prefer to skip to the +next section at this point. + +The definition of Haskell and previous versions of Gofer insist that no +two instance declarations for a given class may contain overlapping +predicates. Thus the declarations: + + class CX a where c :: a -> Int + + instance CX (a,Int) where c (x,y) = y + instance CX (Int,a) where c (x,y) = x + +are not allowed because the two predicates overlap: + + ERROR "misctest" (line 346): Overlapping instances for class "CX" + *** This instance : CX (Int,a) + *** Overlaps with : CX (a,Int) + *** Common instance : CX (Int,Int) + +As the error message indicates, given an expression c (1,2) it is not +clear whether we should use the first or the second instance +declarations to evaluate this, with potentially different results, 2 or +1 respectively. + +On the other hand, there are cases where this sort of thing might be +quite reasonable. For example, the standard function show prints lists +of characters as strings, but any other kind of list is printed using +the [ ... ] notation with the items separated by commas: + + ? show "Hello" + "Hello" + ? show [True,False,True] + [True,False,True] + ? show [1..10] + [1,2,3,4,5,6,7,8,9,10] + ? + +Haskell deals with this by an encoding using the showList function, but +a more obvious approach might be to define two instances: + + instance Text a => Text [a] where ... print using [ ... ] notation + instance Text [Char] where ... print as string + +Other examples might include providing optimized versions of primitives +for particular frequently use operators, or providing a default +behaviour as in: + + class Eq a where (==) = error "no definition of equality specified" + +Haskell requires the context of an overloaded function to be reduced to +a form where the only predicates that it contains are of the form C a. +This means that the inferred type of an object may be simplified before +the full type of that object is known. For example, we might define a +function: + + f x = show [x,x] + +The inferred type in Haskell is f :: Text a => a -> String and the +decision about which of the two instance declarations above should be +used has already been forced on us. To see this, note that f 'a' would +evaluate to the string "['a', 'a']". But if we allowed the second +instance declaration above to be used, show ['a', 'a'] would evaluate +to "aa". This breaks a fundamental property of the language where we +expect to be able to replace one subexpression with another equal term +and obtain the same result. + +In Gofer, the type system is a little different and the inferred type +is f :: Text [a] => a -> String. The decision about which instance +declaration to use is postponed until the type assigned to 'a' is +known. Thus both f 'a' and show ['a', 'a'] evaluate to "aa" without +any contradiction. + +Although the type system in Gofer has always been able to support the +use of certain overlapping instance declarations, previous versions of +the system imposed stronger static restrictions which prohibited their +use. Gofer 2.28 relaxes these restrictions by allowing a program to +contain overlapping instance declarations so long as: + + o One of the instance predicates being declared is a substitution + instance of the other. Thus: + + instance Eq [Char] where ... -- OK + instance Eq a => Eq [a] where ... + + is permitted because the second predicate, Eq [a], is more general + than the first, Eq [Char], which can be obtained by substituting + Char for the type variable a. However, the example at the + beginning of this section: + + instance CX (a,Int) where ... -- ILLEGAL + instance CX (Int,a) where ... + + is not allowed since neither (a,Int) or (Int,a) is a substitution + instance of the other (even though they have a common instance + (Int,Int)). + + o The two instances declared are not identical. This rules out + examples like: + + instance Eq Char where ... -- ILLEGAL + instance Eq Char where ... + +The features described here are added principally for experimentation. +I have some particular applications that I want to try out (which is +why I actually implemented these ideas) but I would also be very +interested to hear from anyone else that makes use of this extension. + + +.ST 3.3 Parsing Haskell syntax +--------------------------- +From correspondence that I have received, quite a few people use Gofer +to develop programs which, ultimately, will be compiled and executed +using a Haskell system. Although the syntax of the two languages is +quite similar, it has been necessary to comment out module headers and +other constructs in Haskell programs before they could be used with +previous version of Gofer. + +The new version of the Gofer system is now able to parse these +additional constructs (and will generate an error message if a syntax +error occurs). However: NO ATTEMPT IS MADE TO INTERPRET OR USE THE +INFORMATION PROVIDED BY THESE ADDITIONAL CONSTRUCTS. This feature is +provided purely for the convenience of those people using Gofer and +Haskell in the manner described above. Gofer does not currently +support any notion of modules beyond the use of separate script files. + +The following changes have been made: + + o The identifiers: + + deriving default module interface + import renaming hiding to + + are now reserved words in Gofer. Any program that uses one of + these as an identifier with an older version of Gofer will need + to be modified to use a different name instead. + + o Module headers and import declarations may be included in a Gofer + program using the syntax set out in version 1.2 of the Haskell + report. Several modules may be included in a single file (but of + course, Gofer makes no distinction between the sections of code + appearing in different `modules'). + + o Datatype definitions may include deriving clauses such as: + + data Maybe a = Just a | Nothing deriving (Eq, Text) + + although no derived instances will actually be generated. + If you need these facilities, you might consider writing out + the instances of the type classes concerned yourself in a + separate file which can be loaded when you run your program + with Gofer, but which are omitted when you compile it with a + proper Haskell system. + + o Programs may include default declarations, although, once again, + these are ignored; for example, there is no restriction on the + forms of type that can be included in a default declaration, nor + will an error occur if a single module includes multiple default + declarations. + + +.ST 3.4 Local definitions in comprehensions +---------------------------------------- +We all make mistakes. The syntax for Gofer currently permits a local +definition to appear in a list comprehension (and indeed, in the monad +comprehensions described in the next section): + + [ (x,y) | x <- xs, y = f x, p y ] + +This example is implemented by translating it to something equivalent +to: + + map h xs where h [] = [] + h (x:xs) = let y = f x + in if p y then (x,y) : h xs + else h xs + +It is cumbersome to rewrite this using list comprehensions without +local definitions: + + concat [ let y = f x in [ (x,y) | p y ] | x <- xs ] + +so we might resort to the `hack' of writing: + + [ y | x <- xs, y <- [f x], p y ] + +which works (but doesn't extend to recursive bindings, and is really an +inappropriate use for a list; a list is used to represent a sequence of +zero or more objects, so using a list when you know that there is +always going to be exactly one element seems unnecessary). So, to +summarize, I still think that local definitions can be useful in +comprehensions. + +So where is the mistake I mentioned? The problem is with the SYNTAX. +First, it is rather easy to confuse the comprehension above with the +comprehension: + + [ (x,y) | x <- xs, y == f x, p y ], + +leading to errors which are hard to detect. The second is that the +syntax is too restrictive; you can only give relatively simple local +declarations -- mutually recursive definitions and function bindings +are not permitted. + +Gofer 2.28 now supports a new syntax for local definitions in +comprehensions. The old syntax is still supported, for compatibility +with previous releases, but will be deleted in the next public release +(assuming I remember). Local declarations can now be included in a +comprehension using a qualifier of the form let { decls }. So the +comprehension at the beginning of this section can also be written: + + [ (x,y) | x <- xs, let {y = f x}, p y ] + +Note that the braces cannot usually be omitted in Gofer due to an +undocumented extension to the syntax of Gofer function declarations. +The braces would not be needed if this syntax were added to a standard +Haskell system. + +This extension means that it is now possible to write comprehensions +such as: + + [ (x,y,z) | x <- xs, let { y = f x z; + z = g x y; + f n = h n [] }, p x y z ] + +Once again, this is still an experimental feature. I suspect it will +be of most use to anyone making substantial use of monad comprehensions +as described in the next section. + + +.co-------------------------------------------------------------------| +.ST 4. CONSTRUCTOR CLASSES + +[This is a long section; if you are not interested in experimenting +with Gofer's system of constructor classes, you can skip straight ahead +to the next section without missing anything. Of course, if you don't +know what a constructor class is, you might want to read at least some +of this section before you can make that decision.] + +One of the biggest changes in Gofer version 2.28 is the provision of +support for constructor classes. This section provides an overview of +constructor classes which should hopefully, in conjunction with the +example supplied with the full distribution, be enough to get you +started. More technical details about constructor classes can be +obtained by contacting me. + +Some of the following introduction here (particularly sections 4.1 and +4.2) may seem somewhat familiar to those of you have already read one +of the papers that I have written on the subject although I have added +some more information about the Gofer implementation. + +Others may find that this section of the documentation seems rather +technical; try not to be put off at first sight. Looking through the +examples and the documentation, you may find it is easier to understand +than you expect! + +A final comment before starting: there is, as yet, no strong consensus +on the names and syntax that would be best for monad operations, +comprehensions etc. If you have any opinions, or proposals which +differ from what you see here, please let me know ... I'd be very +interested to hear other people's opinions on this. + + +.ST 4.1 An overloaded map function +------------------------------- +Many functional programs use the map function to apply a function to +each of the elements in a given list. The type and definition of this +function as given in the Gofer standard prelude are as follows: + + map :: (a -> b) -> ([a] -> [b]) + map f [] = [] + map f (x:xs) = f x : map f xs + +It is well known that the map function satisfies the familiar laws: + + map id = id + map f . map g = map (f . g) + +A category theorist will recognize these observations as indicating +that there is a functor from types to types whose object part maps any +given type a to the list type [a] and whose arrow part maps each +function f::a -> b to the function map f :: [a] -> [b]. A functional +programmer will recognize that similar constructions are also used with +a wide range of other data types, as illustrated by the following +examples: + + data Tree a = Leaf a | Tree a :^: Tree a + + mapTree :: (a -> b) -> (Tree a -> Tree b) + mapTree f (Leaf x) = Leaf (f x) + mapTree f (l :^: r) = mapTree f l :^: mapTree f r + + data Maybe a = Just a | Nothing + + mapMaybe :: (a -> b) -> (Maybe a -> Maybe b) + mapMaybe f (Just x) = Just (f x) + mapMaybe f Nothing = Nothing + +Each of these functions has a similar type to that of the original map +and also satisfies the functor laws given above. With this in mind, it +seems a shame that we have to use different names for each of these +variants. + +A more attractive solution would allow the use of a single name map, +relying on the types of the objects involved to determine which +particular version of the map function is required in a given +situation. For example, it is clear that map (1+) [1,2,3] should be +a list, calculated using the original map function on lists, while +map (1+) (Just 1) should evaluate to Just 2 using mapMaybe. + +Unfortunately, in a language using standard Hindley/Milner type +inference, there is no way to assign a type to the map function that +would allow it to be used in this way. Furthermore, even if typing +were not an issue, use of the map function would be rather limited +unless some additional mechanism was provided to allow the definition +to be extended to include new datatypes perhaps distributed across a +number of distinct program files. + + +.ST 4.1.1 An attempt to define map using type classes +-------------------------------------------------- +The ability to use a single function symbol with an interpretation that +depends on the type of its arguments is commonly known as overloading. +In Gofer, overloading is implemented using type classes -- which can be +thought of as sets of types. For example, the Eq class defined by: + + class Eq a where + (==), (/=) :: a -> a -> Bool + +(together with an appropriate set of instance declarations) is used to +describe the set of types whose elements can be compared for equality. +The standard prelude for Gofer includes integers, floating point +numbers, characters, booleans, lists (in which the type of the members +is also in Eq) and so forth. There is no need for all the definitions +of equality to be combined in a single script file; new definitions of +equality are typically included each time a new datatype is defined. + +Functions such as nub, defined in the standard prelude as: + + nub :: Eq a => [a] -> [a] -- remove duplicates from list + nub [] = [] + nub (x:xs) = x : nub (filter (x/=) xs) + +can be used with any choice of type for the type variable a so long as +it is an instance of Eq. Only a single definition of the nub function +is required. + +Unfortunately, the system of type classes is not sufficiently powerful +to give a satisfactory treatment for the map function; to do so would +require a class Map and a type expression m(t) involving the type +variable t such that S = { m(t) | t is a member of Map } includes (at +least) the types: + + { (a -> b) -> ([a] -> [b]), + (a -> b) -> (Tree a -> Tree b), + (a -> b) -> (Maybe a -> Maybe b), .... + | a and b arbitrary types } + +.cc 5 +The only possibility is to take m(t) = t and choose Map as the set of +types S for which the map function is required: + + class Map t where map :: t + + instance Map ((a -> b) -> ([a] -> [b])) where ... + instance Map ((a -> b) -> (Tree a -> Tree b)) where ... + instance Map ((a -> b) -> (Maybe a -> Maybe b)) where ... + +This syntax is permitted in Gofer (but not in Haskell) but it does not +give a sufficiently accurate characterization of the type of map to be +of much use. For example, the principal type of \i j -> map j . map i +is: + + (Map (a -> c -> e), Map (b -> e -> d)) => a -> b -> c -> d + +(a and b are the types of i and j respectively). This is complicated +and does not enforce the condition that i and j have function types. +Furthermore, the type is ambiguous (the type variable e does not appear +to the right of the => symbol or in the assumptions). Under these +conditions, we cannot guarantee a well-defined semantics for this +expression. Other attempts to define the map function, for example +using multiple parameter type classes, have also failed for essentially +the same reasons. + + +.ST 4.1.2 A solution using constructor classes +------------------------------------------- +A much better approach is to notice that each of the types for which +the map function is required is of the form: + + (a -> b) -> (f a -> f b). + +The variables a and b here represent arbitrary types while f ranges +over the set of type constructors for which a suitable map function has +been defined. In particular, we would expect to include the list +constructor (which we write as [] in Gofer), Tree and Maybe as elements +of this set. Motivated by our earlier comments we will call this set +Functor. With only a small extension to the Gofer syntax for type +classes this can be described by: + + class Functor f where + map :: (a -> b) -> (f a -> f b) + + instance Functor [] where + map f [] = [] + map f (x:xs) = f x : map f xs + + instance Functor Tree where + map f (Leaf a) = Leaf (f a) + map f (l :^: r) = map f l :^: map f r + + instance Functor Maybe where + map f (Just x) = Just (f x) + map f Nothing = Nothing + +.cc 5 +Functor is our first example of a constructor class. The following +extract illustrates how the definitions for Functor work in practice: + + ? map (1+) [1,2,3] + [2, 3, 4] + (15 reductions, 44 cells) + ? map (1+) (Leaf 1 :^: Leaf 2) + Leaf 2 :^: Leaf 3 + (10 reductions, 46 cells) + ? map (1+) (Just 1) + Just 2 + (4 reductions, 17 cells) + ? + +Furthermore, by specifying the type of map function more precisely, +we avoid the ambiguity problems mentioned above. For example, the +principal type of \i j -> map j . map i is simply: + + Functor f => (a -> b) -> (b -> c) -> f a -> f c + +which is not ambiguous, and makes the types of i and j as (a -> b) +and (b -> c) respectively. + +[You can try these examples yourself using the Gofer system. The first +thing you need to do is start Gofer using the file cc.prelude instead +of the usual Gofer standard.prelude. The cc.prelude includes the +definition of the functor class and the instance for Functor []. The +remaining two instance declarations are included (along with lots of +other examples) in the file ccexamples.gs in the demos/Ccexamples +subdirectory of the standard distribution.] + + +.ST 4.1.3 The kind system +---------------------- +Each instance of Functor can be thought of as a function from types to +types. It would be nonsense to allow the type Int of integers to be an +instance of Functor, since the type (a -> b) ->(Int a -> Int b) is +obviously not well-formed. To avoid unwanted cases like this, we have +to ensure that all of the elements in any given class are of the same +kind. + +To do this, we formalize the notion of kind, writing * for the kind of +all types and k1 -> k2 for the kind of a constructor which takes +something of kind k1 and returns something of kind k2. This notion +comes is motivated by some theoretical work by Henk Barendregt on the +subject of `Generalized type systems'; Do not confuse this with the use +of the symbol * in a certain well-known functional language where it +represents a type variable. These things are completely different! + +Rather than thinking only of types we work with constructors which +include types as a special case. Constructors take the form: + + Constructor ::= ConstructorConstant + | Constructor1 Constructor2 + | variable + +This corresponds very closely to the way that most type expressions +are already written in Gofer. For example, Tree a is an application +of the constructor constant Tree to the variable a. Gofer has some +special syntax for tuple, list and function types. The corresponding +constructors can also be written directly in Gofer. For example: + + a -> b = (->) a b + [a] = [] a + (a,b) = (,) a b + (a,b,c) = (,,) a b c + etc ... + +Each constructor constant has a corresponding kind. For example: + + Int, Float, () :: * + [], Tree, Maybe :: * -> * + (->), (,) :: * -> * -> * + (,,) :: * -> * -> * -> * + +Applying one constructor C :: k1 -> k2 to a construct C' :: k1 gives +a constructor expression C C' with kind k2. Notice that this is just +the same sort of thing you would expect from applying a function of +type a -> b to an value of type b; kinds really are very much like +`types for constructors'. + +Instead of checking that type expressions contain the correct number of +arguments for each type constructor, we need to check that any type +expression has kind *. In a similar way, all of the elements of a +constructor class must have the same kind; for example, a constructor +class constraint of the form Functor f is only valid if f is a +constructor expression of kind * -> *. Note also that our system +includes Gofer/Haskell type classes as a special case; a type class is +simply a constructor class for which each instance has kind *. Multiple +parameter classes can also be dealt with in the same way, using a tuple +of kinds (k1,...,kn) to indicate the kind of constructors required for +each argument. + +The language of constructors is essentially a system of combinators +without any reduction rules. As such, standard techniques can be +used to infer the kinds of constructor variables, constructor constants +introduced by new datatype definitions and the kind of the elements +held in any particular constructor class. The important point is that +there is no need -- and indeed, in our current implementation, no +opportunity -- for the programmer to supply kind information +explicitly. We regard this as a significant advantage since it means +that the programmer can avoid much of the complexity that might +otherwise result from the need to annotate type expressions with +kinds. + + +.ST 4.2 Monads as an application of constructor classes +---------------------------------------------------- +Motivated by the work of Moggi and Spivey, Wadler has proposed a style +of functional programming based on the use of monads. While the theory +of monads had already been widely studied in the context of abstract +category theory, Wadler introduced the idea that monads could be used +as a practical method for modeling so-called `impure' features in a +purely functional programming language. + +The examples in this and following sections illustrate that the use of +constructor classes can be particularly convenient for programming in +this style. You will also find a lot more examples prepared for use +with Gofer in the file ccexamples in the demos/Ccexamples subdirectory +of the standard distribution. + + +.ST 4.2.1 A framework for programming with monads +---------------------------------------------- +The basic motivation for the use of monads is the need to distinguish +between computations and the values that they produce. If m is a monad +then an object of type (m a) represents a computation which is expected +to produce a value of type a. These types reflect the fact that the +use of particular programming language features in a given calculation +is a property of the computation itself and not of the result that it +produces. + +Taking the approach outlined by Wadler in his paper `The Essence of +Functional Programming' (POPL '92), we introduce a constructor class of +monads using the definition: + + class Functor m => Monad m where + result :: a -> m a + join :: m (m a) -> m a + bind :: m a -> (a -> m b) -> m b + + join x = bind x id + x `bind` f = join (map f x) + +The expression Functor m => Monad m defines Monad as a subclass of +Functor ensuring that, for any given monad, there will also be a +corresponding instance of the overloaded map function. The use of a +hierarchy of classes enables us to capture the fact that not every +instance of Functor can be treated as an instance of Monad in any +natural way. + +[If you are familiar with either my previous papers or Wadler's +writings on the use of monads, you might notice that the declaration +above uses the name `result' in place of `return' or `unit' that have +been previously used for the same thing. The latter two choices have +been used elsewhere for rather different purposes, and there is +currently no clear picture of which names should be used. The +identifier `result' is the latest in a long line of attempts to find a +name which both conveys the appropriate meaning and is not already in +use for other applications.] + +By including default definitions for bind and join we only need to give +a definition for one of these (in addition to a definition for result) +to completely define an instance of Monad. This is often quite +convenient. On the other hand, it would be an error to omit +definitions for both operators since the default definitions are +clearly circular. We should also mention that the member functions in +an instance of Monad are expected to satisfy a number of laws which are +not reflected in the class definition above. + +The following declaration defines the standard monad structure for the +list constructor [] which can be used to describe computations +producing multiple results, corresponding to a simple form of +non-determinism: + + instance Monad [] where + result x = [x] + [] `bind` f = [] + (x:xs) `bind` f = f x ++ (xs `bind` f) + +As a second example, the monad structure for the Maybe datatype, which +might be used to describe computations which fail to produce any value +at all if an error condition occurs, can be described by: + + instance Monad Maybe where + result x = Just x + Just x `bind` f = f x + Nothing `bind` f = Nothing + +Another interesting use of monads is to model programs that make use of +an internal state. Computations of this kind can be represented by +functions of type s-> (a,s) (often referred to as state transformers) +mapping an initial state to a pair containing the result and final +state. In order to get this into the appropriate form for the Gofer +system of constructor classes, we introduce a new datatype: + + data State s a = ST (s -> (a,s)) + +The functor and monad structures for state transformers are as follows: + + instance Functor (State s) where + map f (ST st) = ST (\s -> let (x,s') = st s in (f x, s')) + + instance Monad (State s) where + result x = ST (\s -> (x,s)) + ST m `bind` f = ST (\s -> let (x,s') = m s + ST f' = f x + in f' s') + +Notice that the State constructor has kind * -> * -> * and that the +declarations above define State s as a monad and functor for any state +type s (and hence State s has kind * -> * as required for an instance +of these classes). There is no need to assume a fixed state type. + +From a user's point of view, the most interesting properties of a monad +are described, not by the result, bind and join operators, but by the +additional operations that it supports. The following examples are +often useful when working with state monads. The first can be used to +`run' a program given an initial state and discarding the final state, +while the second might be used to implement an integer counter in a +State Int monad: + + startingWith :: State s a -> s -> a + ST m `startingWith` s0 = result where (result,_) = m s0 + + incr :: State Int Int + incr = ST (\s -> (s,s+1)) + +To illustrate the use of state monads, consider the task of labeling +each of the nodes in a binary tree with distinct integer values. One +simple definition is: + + label :: Tree a -> Tree (a,Int) + label tree = fst (lab tree 0) + where lab (Leaf n) c = (Leaf (n,c), c+1) + lab (l :^: r) c = (l' :^: r', c'') + where (l',c') = lab l c + (r',c'') = lab r c' + +This uses an explicit counter (represented by the second parameter to +lab) and great care must be taken to ensure that the appropriate +counter value is used in each part of the program; simple errors, such +as writing c in place of c' in the last line, are easily made but can +be hard to detect. + +An alternative definition, using a state monad and following the +layout suggested in Wadler's POPL paper, can be written as follows: + + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = incr `bind` \c -> + result (Leaf (n,c)) + lab (l :^: r) = lab l `bind` \l' -> + lab r `bind` \r' -> + result (l' :^: r') + +While this program is perhaps a little longer than the previous +version, the use of monad operations ensures that the correct counter +value is passed from one part of the program to the next. There is no +need to mention explicitly that a state monad is required: The use of +startingWith and the initial value 0 (or indeed, the use of incr on its +own) are sufficient to determine the monad State Int needed for the +bind and result operators. It is not necessary to distinguish between +different versions of the monad operators bind, result and join or to +rely on explicit type declarations. + + +.ST 4.2.2 Monad comprehensions +--------------------------- +Several functional programming languages provide support for list +comprehensions, enabling some common forms of computation with lists to +be written in a concise form resembling the standard syntax for set +comprehensions in mathematics. In his paper `Comprehending Monads' +(ACM Lisp and Functional Programming, 1990), Wadler made the +observation that the comprehension notation can be generalized to +arbitrary monads, of which the list constructor is just one special +case. + +In Wadler's notation, a monad comprehension is written using the syntax +of a list comprehension but with a superscript to indicate the monad in +which the comprehension is to be interpreted. This is a little awkward +and makes the notation less powerful than might be hoped since each +comprehension is restricted to a particular monad. Using the +overloaded operators described in the previous section, Gofer provides +a more flexible form of monad comprehension which relies on overloading +rather than superscripts. At the time of writing, this is the only +concrete implementation of monad comprehensions known to us. + +In our system, a monad comprehension is an expression of the form +[e | qs ] where e is an expression and gs is a list of generators of +the form p <- exp. As a special case, if gs is empty then the +comprehension [ e | qs ] is written as [ e ]. The implementation of +monad comprehensions is based on the following translation of the +comprehension notation in terms of the result and bind operators +described in the previous section: + + [ e ] = result e + [ e | p <- exp, qs ] = exp `bind` \p -> [ e | qs ] + +In this notation, the label function from the previous section can +be rewritten as: + + label :: Tree a -> Tree (a,Int) + label tree = lab tree `startingWith` 0 + where lab (Leaf n) = [ Leaf (n,c) | c <- incr ] + lab (l :^: r) = [ l :^: r | l <- lab l, r <- lab r ] + +Applying the translation rules for monad comprehensions to this +definition yields the previous definition in terms of result and bind. +The principal advantage of the comprehension syntax is that it is often +more concise and, in the author's opinion, sometimes more attractive. + + +.ST 4.2.3 Monads with a zero +------------------------- +Assuming that you are familiar with Gofer's list comprehensions, you +will know that it is also possible to include boolean guards in +addition to generators in the definition of a list comprehension. Once +again, Wadler showed that this was also possible in the more general +setting of monad comprehensions, so long as we restrict such +comprehensions to monads that include a special element zero satisfying +a small number of laws. This can be dealt with in our framework by +defining a subclass of Monad: + + class Monad m => Monad0 m where + zero :: m a + +For example, the List monad has the empty list as a zero element: + + instance Monad0 [] where zero = [] + +Note that not there are also some monads which do not have a zero +element and hence cannot be defined as instances of Monad0. The +State s monads described in Section 4.2.1 are a simple example of +this. + +Working in a monad with a zero, a comprehension involving a boolean +guard can be implemented using the translation: + + [ e | guard, qs ] = if guard then [ e | qs ] else zero + +Notice that, as far as the type system is concerned, the use of +zero in the translation of a comprehension involving a guard automatically +captures the restriction to monads with a zero: + + ? :t \x p -> [ x | p x ] + \x p -> [ x | p x ] :: Monad0 b => a -> (a -> Bool) -> b a + ? + +The inclusion of a zero element also allows a slightly different +translation for generators in comprehensions: + + [ e | p <- exp, qs ] = exp `bind` f + where f p = [ e | qs ] + f _ = zero + +This corresponds directly to the semantics of standard Gofer list +comprehensions, but only differs from the semantics of the translation +given in the previous section when p is an irrefutable pattern; i.e. +when p is a pattern which may not match the value (or values) generated +by exp. You can see the difference by trying the following example +in Gofer: + + ? [ x | [x] <- [[1],[],[2]]] + [1, 2] + (9 reductions, 31 cells) + ? map (\[x] -> x) [[1],[],[2]] + [1, + Program error: {v157 []} + (8 reductions, 66 cells) + + ? + +In order to retain compatibility with the standard list comprehension +notation, Gofer always uses the second translation above for generators +if the pattern p is refutable. This may sometimes give inferred types +which are more restrictive than you expect. For example, tuples are +not irrefutable patterns in Gofer or Haskell, and so the function: + + ? :t \xs -> [ x | (x,y) <- xs ] + \xs -> [ x | (x,y)<-xs ] :: Monad0 a => a (b,c) -> a b + ? + +is restricted to monads with a zero because the expanded translation +above is used. You can always avoid this problem by using the lazy +pattern construct (i.e. the tilde operator, ~p) as in: + + ? :t \xs -> [ x | ~(x,y) <- xs ] + \xs -> [ x | ~(x,y)<-xs ] :: Monad a => a (b,c) -> a b + ? + +[At one stage, I was using a different form of brackets to represent +monad comprehensions, implemented using the original translation to +avoid changing the semantics of list comprehensions. But I finally +decided that it would be better to use standard comprehension notation +with lazy pattern annotations where necessary since this is less +cumbersome than writing \xs -> [| x | (x,y) <- xs |] in place of the +comprehension above. Please let me know what you think!] + + +.ST 4.2.4 Generic operations on monads +----------------------------------- +The combination of polymorphism and constructor classes in our system +makes it possible to define generic functions which can be used on a +wide range of different monads. A simple example of this is the +`Kleisli composition' for an arbitrary monad, similar to the usual +composition of functions except that it also takes care of `side +effects'. The general definition is as follows: + + (@@) :: Monad m => (a -> m b) -> (c -> m a) -> (c -> m b) + f @@ g = join . map f . g + +For example, in a monad of the form State s, the expression f @@ g +denotes a state transformer in which the final state of the computation +associated with g is used as the initial state for the computation +associated with f. More precisely, for this particular kind of monad, +the general definition given above is equivalent to: + + (@@) :: (b -> State s c) -> (a -> State s b) -> (a -> State s c) + f @@ g = \a -> STM (\s0 -> let ST g' = g a + (b,s1) = g' s0 + ST f' = f b + (c,s2) = f' s1 + in (c,s2)) + +The biggest advantage of the generic definition is that there is no +need to construct new definitions of (@@) for every different monad. +On the other hand, if specific definitions were required for some +instances, perhaps in the interests of efficiency, we could simply +include (@@) as a member function of Monad and use the generic +definition as a default implementation. + +Generic operations can also be defined using the comprehension +notation: + + mapl :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapl f [] = [ [] ] + mapl f (x:xs) = [ y:ys | y <- f x, ys <- mapl f xs ] + +This is the same as mapping a function down the elements of a list +using the normal map function except that, in the presence of side +effects, the order in which the applications are carried out is +important. For mapl, we start on the left (i.e. the front of the list) +and work towards the right. There is a corresponding dual which works +in the reverse direction: + + mapr :: Monad m => (a -> m b) -> ([a] -> m [b]) + mapr f [] = [ [] ] + mapr f (x:xs) = [ y:ys | ys <- mapr f xs, y <- f x ] + +These general functions have applications in several kinds of monad +with examples involving state and output. + +The comprehension notation can also be used to define a generalization +of Haskell's filter function which works in an arbitrary monad with a +zero: + + filter :: Monad0 m => (a -> Bool) -> m a -> m a + filter p xs = [ x | x<-xs, p x ] + +There are many other general purpose functions that can be defined +in the current framework and used in arbitrary monads. To give you +some further examples, here are generalized versions of the foldl and +foldr functions which work in an arbitrary monad: + + mfoldl :: Monad m => (a -> b -> m a) -> a -> [b] -> m a + mfoldl f a [] = result a + mfoldl f a (x:xs) = f a x `bind` (\fax -> mfoldl f fax xs) + + mfoldr :: Monad m => (a -> b -> m b) -> b -> [a] -> m b + mfoldr f a [] = result a + mfoldr f a (x:xs) = mfoldr f a xs `bind` (\y -> f x y) + +[Generalizing these definitions (and those of mapl, mapr) to work with +a second arbitrary monad (in place of the list monad) is left as an +entertaining exercise for the reader :-)] + +As a final example, here is a definition of a `while' loop for an +arbitrary monad: + + while :: Monad m => m Bool -> m b -> m () + while c s = c `bind` \b -> + if b then s `bind` \x -> + while c s + else result () + + +.ST 4.2.5 A family of state monads +------------------------------- +We have already described the use of monads to model programs with +state using the State datatype in Section 4.2.1. The essential +property of any such monad is the ability to update the state and we +might therefore consider a more general class of state monads given by: + + class Monad (m s) => StateMonad m s where + update :: (s -> s) -> m s s + set :: s -> m s s + fetch :: m s s + set new = update (\old -> new) + fetch = update id + +An expression of the form update f denotes the computation which +updates the state using f and result the old state as its result. For +example, the incr function described above can be defined as: + + incr :: StateMonad m Int => m Int Int + incr = update (1+) + +in this more general setting. The class declaration above also +includes set and fetch functions which set the state to a particular +value or return its value. These are easily defined in terms of the +update function as illustrated by the default definitions. + +The StateMonad class has two parameters; the first should be a +constructor of kind (* -> * -> *) while the second gives the state +type (of kind *); both are needed to specify the type of update. +The implementation of update for a monad of the form State s is +straightforward and provides us with our first instance of the +StateMonad class: + + instance StateMonad State s where + update f = ST (\s -> (s, f s)) + +A rather more interesting family of state monads can be described using +the following datatype definition: + + data STM m s a = STM (s -> m (a,s)) -- a more sophisticated example, + -- where the state monad is + -- parameterized by a second, + -- arbitrary monad. + +Note that the first parameter to StateM has kind (* -> *), a +significant extension from Haskell (and previous versions of Gofer) +where all of the arguments to a type constructor must be types. This +is another benefit of the kind system. + +The functor and monad structure of a StateM m s constructor are given +by: + + instance Monad m => Functor (STM m s) where + map f (STM xs) = STM (\s -> [ (f x, s') | ~(x,s') <- xs s ]) + + instance Monad m => Monad (STM m s) where + result x = STM (\s -> result (x,s)) + STM xs `bind` f = STM (\s -> xs s `bind` (\(x,s') -> + let STM f' = f x + in f' s')) + +Note the condition that m is an instance of Monad in each of these +definitions. If we hadn't used the lazy pattern construct ~(x,s') in +the instance of Functor, it would have been necessary to strengthen +this further to instances of Monad0 -- i.e. monads with a zero. + +The definition of StateM m as an instance of StateMonad is also +straightforward: + + instance StateMonad (STM m) s where + update f = STM (\s -> result (s, f s)) + +The following two functions are also useful for work with STM m s +monads. The first, protect, allows an arbitrary computation to be +embedded in a state based computation without access to the state. +The second, execute, is similar to the startingWith function in +Section 4.2.1, running a state based computation with a given initial +state and returning a computation as the result. + +protect :: Monad m => m a -> STM m s a +protect m = STM (\s -> [ (x,s) | x<-m ]) + +execute :: Monad m => s -> STM m s a -> m a +execute s (STM f) = [ x | ~(x,s') <- f s ] + +Support for monads like StateM m s seems to be an important step +towards solving the problem of constructing monads by combining +features from simpler monads, in this case combining the use of state +with the features of an arbitrary monad m. I hope that the system of +constructor classes in Gofer will be a useful tool for people working +in this area. + + +.ST 4.2.6 Monads and substitution +------------------------------ +The previous sections have concentrated on the use of monads to +describe computations. Monads also have a useful interpretation as a +general approach to substitution. This in turn provides another +application for constructor classes. + +Taking a fairly general approach, a substitution can be considered as a +function s::v-> t w where the types v and w +represent sets of variables and the type t a represents a set +of terms, typically involving elements of type a. If t is +a monad and x::t v, then x `bind` s gives the result of +applying the substitution s to the term x by replacing +each occurrence of a variable v in x with the corresponding +term s v in the result. For example: + + instance Monad Tree where + result = Leaf + Leaf x `bind` f = f x + (l :^: r) `bind` f = (l `bind` f) :^: (r `bind` f) + +With this interpretation in mind, the Kleisli composition (@@) in +Section 4.2.4 is just the standard way of composing substitutions, +while the result function corresponds to a null substitution. The fact +that (@@) is associative with result as both a left and right identity +follows from the standard algebraic properties of a monad. + + +.ST 4.3 Constructor classes in Gofer +--------------------------------- +The previous two sections should have given you some ideas about the +motivation and use for constructor classes. It remains to say a few +words about the way that constructor classes fit into the general Gofer +framework. In practice, this means giving a more detailed description +of the way that the kind system works. + +.ST 4.3.1 Kind errors and the k command line option +------------------------------------------------ +As has already been mentioned, Gofer 2.28 uses kind information to +check that type expressions are well-formed rather than simply checking +that each type constructor is applied to an appropriate number of +arguments. For example, having defined a tree datatype: + + data Tree a = Leaf a | Tree a :^: Tree a + +the following definition will be rejected as an error: + + type Example = Tree Int Bool + +as follows: + + ERROR "file" (line 42): Illegal type "Tree Int Bool" in + constructor application + +The problem here is that the Tree constructor has kind * -> * so that +it expects to take one argument (a type) and deliver a type as the +result. On the other hand, in the definition of Example, the Tree +constructor is treated as having (at least) two arguments; i.e. as +having a kind of the form (* -> * -> k) for some kind k. Rather than +confuse a user who is not familiar with the use of kinds, Gofer +normally just prints an error message like the one above for examples +like this. + +If you would like Gofer to give a more detailed description of the +problem, you can use the :set +k command line option as follows: + + ? :set +k + ? :r + Reading script file "file": + + ERROR "file" (line 42): Kind error in constructor application + *** expression : Tree Int Bool + *** constructor : Tree + *** kind : * -> * + *** does not match : * -> a -> b + + ? + +When the k command line option has been selected, the :info command +described in Section 2.3.2 also includes kind information about the +kinds of type constructors defined in a program. For example, given +the definition of Tree above and the datatypes: + + data STM m s x = STM (s -> m (s, x)) + data Queue a = Empty | a :< Queue a | Queue a :> a + +The :info command gives the following kinds (editing the output to +remove details about constructor functions for each datatype): + + ? :info Tree STM Queue + -- type constructor with kind * -> * + data Tree a + + -- type constructor with kind (* -> *) -> * -> * -> * + data STM a b c + + -- type constructor with kind * -> * + data Queue a + + ? + +In addition to calculating a kind of each type constructor introduced +in a datatype declaration, Gofer also determines a kind for each +constructor defined by means of a type synonym. For example, the +following definitions: + + type Subst m v = v -> m v + type Compose f g x = f (g x) + type Pointer a = Int + type Apply f x = f x + type Fusion f g x = f x (g x) + type Const x y = x + +are treated as having kinds: + + ? :info Subst Compose Pointer Apply Fusion Const + -- type constructor with kind (* -> *) -> * -> * + type Subst a b = b -> a b + + -- type constructor with kind (* -> *) -> (* -> *) -> * -> * + type Compose a b c = a (b c) + + -- type constructor with kind * -> * + type Pointer a = Int + + -- type constructor with kind (* -> *) -> * -> * + type Apply a b = a b + + -- type constructor with kind (* -> * -> *) -> (* -> *) -> * -> * + type Fusion a b c = a c (b c) + + -- type constructor with kind * -> * -> * + type Const a b = a + + ? + +Note however type synonyms are only used as abbreviations for other +type expressions. It is not permitted to use a type synonym +constructor in a type expression without giving the correct number of +arguments. + + ? undefined :: Const Int + + ERROR: Wrong number of arguments for type synonym "Const" + ? + +Assuming that you are familiar with polymorphic functions in Gofer, you +might be wondering why some of the kinds given for the type synonyms +above are not also polymorphic in some sense. After all, the standard +prelude function const, is defined by + + const x y = x + +with type a -> b -> a, which looks very similar to the definition of +the Const type synonym above, except that the kinds of the two +arguments have both been fixed as *. In fact, the right hand side of +a type synonym declaration is always required to have kind *, so this +would mean that the most general kind that could be assigned to the +Const constructor would be * -> a -> *. + +Gofer does not currently support the use of polymorphic kinds (let's +call them polykinds from now on). First of all, it is not clear what +practical applications polykinds might offer (I have yet to find an +example where they are useful). Furthermore, some of the deeper +theoretical issues about type inference and related topics have not yet +been studied and I suspect that polykinds would introduce significant +complications without any significant benefits. + +The current approach is to replace any unknown part of an inferred kind +with the kind *. Any polymorphism in the kind of a constructor +corresponds much more closely to the idea of a value that is not +actually used at all than in the language of normal expressions and +their types so this is unlikely to cause any problems. And of course, +in Haskell and previous versions of Gofer, any variable used in a type +expression was assumed to be a type variable with kind *, so all of the +kinds above are consistent with this interpretation. + +The rest of this section is likely to get a bit hairy. Read on at your +peril, or skip to the start of Section 4.3.2. Only those with a strong +interest in the type theory and pragmatics of constructor classes will +miss anything. + +The same approach is used to determine the kinds of constructor +variables in type expressions. In theory, this can sometimes lead to +problems. In practice, this only happens in very contrived examples +and I doubt that any problems will occur for serious applications. The +following example illustrates the kind of `problem' that can occur. +Suppose that we use a script containing the definitions: + + undefined :: a -- the `bottom' value + undefined = undefined + + strange :: f Tree -> f a + strange = undefined + +The type signature for the `strange' function is indeed very strange; +the constructor variables f and a have kinds (* -> *) -> * and (* -> *) +respectively. What's more, the type is very restrictive. Without +including additional primitive constructs in the language, I very much +doubt that you will be able to find an alternative definition for +strange which is not semantically equivalent to the definition above. +And of course, the definition above doesn't really have any practical +applications anyway. [In case you don't get my point, I'm trying to +show that this really is a very contrived example.] I would be very +surprised to see a genuine example of a polymorphic operator which +involves constructor variables of higher kinds in a non-trivial way +that does not also include overloading constraints as part of the +type. For example, it is not at all difficult to think of an +interesting value of type Monad m => a -> m a, but much harder to think +of something with type a -> m a (remember this means for all a and for +all m). + +The definitions of undefined and strange above will be accepted by the +Gofer system as will the following definition: + + contrived = strange undefined + +The type of contrived will now be f a where f :: (* -> *) -> * and +a :: (* -> *). However, if we modify the definition of contrived to +include a type signature: + + contrived :: f a + contrived = strange undefined + +then we get a type checking error: + + ? :l file + Reading script file "file": + Type checking + ERROR "file" (line 24): Type error in function binding + *** term : contrived + *** type : a b + *** does not match : c d + *** because : constructor variable kinds do not match + + ? + +The problem is that for the declared type signature, the variables f and +a are treated as having kinds (* -> *) and * respectively. These do not +agree with the real kinds for these variables. + +To summarize, what this all means is that it is possible to define +values whose principal types cannot be expressed within the language of +Gofer types in the current implementation. The values defined can +actually be used within a program, but it would not, for example, be +possible to allow such values to be exported from a module in a Haskell +system unless kind annotations were added to the inferred types. + + +.ST 4.3.2 The kind of values in a constructor class +------------------------------------------------ +The previous section indicated that, if the :set +k command line option +has been set, the :info command will include information about the +kinds of type constructor constants in its output. This will also +cause the :info command to display information about the kinds of +classes and constructor classes. Notice for example in the following +how the output distinguishes between Eq, a type class, and Functor, a +constructor class in which each instance has kind (* -> *): + + ? :info Eq Functor + -- type class + class Eq a where + (==) :: Eq a => a -> a -> Bool + (/=) :: Eq a => a -> a -> Bool + + -- instances: + instance Eq () + ... + + -- constructor class with arity (* -> *) + class Functor a where + map :: Functor a => (b -> c) -> a b -> a c + + -- instances: + instance Functor [] + ... + + ? + + +.ST 4.3.3 Implementation of list comprehensions +-------------------------------------------- +The implementation of overloaded monad comprehensions is cute, but also +has a couple of potential disadvantages. These are discussed in this +section. As you will see, they really aren't very much to worry +about. + +First of all, the decision to overload the notation for singleton lists +so that [ exp ] == result exp can sometimes cause a few surprises: + + ? map (1+) [1] + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) [ 1 ] + + ? + +Note that this will only occur if you are actually using a prelude +which includes the definition of the Monad class given in Section 4.2 +This can be solved using the command line toggle :set -1 which forces +any expression of the form [ exp ] to be treated as a singleton list +rather than being interpreted in an arbitrary monad. You really +have to write `result' if you do want an arbitrary monad: + + ? :set -1 + ? map (1+) [1] + [2] + (7 reductions, 18 cells) + ? map (1+) (result 1) + ERROR: Unresolved overloading + *** type : Monad a => a Int + *** translation : map (1 +) (result 1) + + ? + +This should probably be the default setting, but I have left things as +they are for the time being, partly so that other people might get the +chance to find out about this and decide what setting they think would +be best. As usual, the default setting can be recovered using the +:set +1 command. + +A second concern is that the implementation of list comprehensions may +be less efficient in the presence of monad comprehensions. Gofer +usually uses Wadler's `optimal' translation for list comprehensions as +described in Simon Peyton Jones book. In fact, this translation will +always be used if either the prelude being used does not include the +standard Monad class or the type system is able to guarantee that a +given monad comprehension is actually a list comprehension. + +If you use a prelude containing the Monad class, you may notice some +small differences in performance in examples such as: + + ? [ x * x | x <- [1..10] ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (98 reductions, 203 cells) + + ? f [1..10] where f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (139 reductions, 268 cells) + + ? + +The second expression is a little more expensive since the local +definition of f is polymorphic with f :: (Num b, Monad a) => a b -> a b +and hence the implementation of the comprehension in f does not use the +standard translation for lists. To be honest, the difference between +these two functions really isn't anything to worry about in the context +of an interpreter like Gofer. And of course, if you really want to +avoid this problem, an explicit type signature will do the trick (as in +other cases where overloading is involved): + + ? f [1..10] where f :: Num b => [b] -> [b]; + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 205 cells) + + ? f [1..10] where f :: [Int] -> [Int] + f xs = [ x * x | x <- xs ] + [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] + (99 reductions, 203 cells) + + ? + +As the last example shows, there is only one more reduction in this +case and that is the reduction step that deals with the application of +f to the argument list [1..10]. + + +.co-------------------------------------------------------------------| +.ST 5. GOFC, THE GOFER COMPILER + +This release of Gofer includes gofc, a `compiler' for Gofer programs +which translates a large class of Gofer programs into C code which can +then be compiled and executed as a standalone application. + +Before anybody gets too excited, there are a couple of points which I +should mention straight away: + + o To make use of gofc, you will need a C compiler. This is why I + do not intend to distribute any binary versions of gofc; if you + have the C compiler needed to compile the output of gofc then + you should also be able to compile gofc from the sources. + + o First of all, the Gofer compiler was written by modifying the + Gofer interpreter. Most of the modifications and changes were + made in just a few days. The compiler and interpreter still + share a large proportion of code. As such, and in case it isn't + obvious: PLEASE DO NOT expect to gain the same kind of performance + out of gofc as you would from one of the serious Haskell + projects. A considerably greater amount of time and effort has + gone into those systems. + + o The compiler is actually over a year old, but this is the first + time it has been released. Although I have worked with it a bit + myself, it hasn't had half the amount of testing that Gofer user's + have given the interpreter over the last year and a half. It may + not be as reliable as the interpreter. If you have problems with + a compiled program, try running it with the interpreter too just + to check that you haven't found a potential bug in gofc. + +That having been said, I hope that the Gofer compiler will be useful to +many Gofer users. One possible advantage is that the executables may +be smaller than with some other systems. And of course, the fact that +gofc runs on some home computers may also be useful. Finally, gofc +provides a simplified system for experimenting with the runtime details +of an implementation. For example, the source code for the runtime +system is set up in such a way as to make it possible to experiment +with alternative garbage collection schemes. + + +.ST 5.1 Using gofc +--------------- +Compiling a program with gofc is very much like starting up the Gofer +interpreter. The compiler starts by reading the prelude and then +loads the script files specified by the command line. These scripts +must contain a definition for the value main :: Dialogue which will be +the dialogue expression that is evaluated when the compiled program is +executed. + +For example, if the file apr1.gs contains the simple program: + + main :: Dialogue + main = appendChan "stdout" "Hello, world\n" exit done + +then this can be compiled as: + + machine% gofc apr1.gs + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "apr1.gs": + + Writing C output file "apr1.c": + [Leaving Gofer->C] + machine% + +The output is written to the file apr1.c -- i.e. the name obtained by +removing the .gs suffix and replacing it with a .c suffix. Other +filename suffixes that are treated in a similar way are: + + .prj .gp for Gofer project files + + .prelude for Gofer prelude files + + .gof .gs for Gofer scripts + + .has .hs for Haskell scripts + + .lhs .lit for literate scripts + .lgs .verb + +If no recognized suffix is found then the name of the output file is +obtained simply by appending the .c suffix to the input name. + +For the benefit of those using Unix systems, let me point out that this +could cause you problems if you are not careful; if you take an input +file called `prog' and compile it to `prog.c' using gofc, make sure +that you do not compile the C program in such a way that the output is +also called `prog' since this will overwrite your original source code! +For this reason, I would always suggest using file extensions such as +the .gs example above if you are using gofc. + +If you run gofc with multiple script files, then the name of the output +file is based on the last script file to be loaded. For example, the +command `gofc prog1.gs prog2.gs' produces an output file `prog2.c'. + +Gofc also works with project files, using the name of the project file +to determine the name of the output file. For example, the miniProlog +interpreter can be compiled using: + + machine% gofc + miniProlog + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "Parse": + Reading script file "Interact": + Reading script file "PrologData": + Reading script file "Subst": + Reading script file "StackEngine": + Reading script file "Main": + + Writing C output file "miniProlog.c": + [Leaving Gofer->C] + machine% + +This is another case where it might well have been sensible to have +used a .prj or .gp for the project file miniProlog since compiling the +C code in miniProlog.c to a file named `miniProlog' will overwrite the +project file! Choose filenames with care! + +You can also specify Gofer command line options as part of the command +line used to run gofc. Think of it like this; use exactly the same +command line to start Gofc as you would have done to start Gofer (ok, +replacing the command `gofer' with `gofc') so that you could start your +program immediately by evaluating the main expression. To summarize +what happens next: + + o Gofc will load the prelude file. Do not worry if the prelude + (or indeed, later files) contain lots of definitions that your + program will not actually use; only definitions which are actually + required to evaluate the main expression will be included in the + output file. + + o Gofc will load the script files specified. If an error is found + then an error message will be printed and the compilation will be + aborted. You would probably be sensible to run your program + through the interpreter first to tidy up any errors and avoid this + problem. + + o Gofc will look for a definition of `main' and check that it has + type Dialogue. You will get an error if an appropriate main + value cannot be found. + + o Gofc determines the appropriate name for the output file. + + o Gofc checks to make sure that you haven't used a primitive + function that is not supported by the runtime system (see + Section 5.2 for more details). + + o Gofc outputs a C version of the program in the output file. + +Once you have compiled the Gofer program to C, you need to compile +the C code to build the executable application program. This will +vary from one system to another and is documented elsewhere. + + +.ST 5.2 Primitive operations +------------------------- +The Gofer compiler accepts the same source language as the +interpreter. However, there is a small collection of Gofer primitives +which are only implemented in the interpreter. The most likely +omission that you will notice is the primPrint function which is used +to define the show' function in the standard prelude. Omitting this +function is not an indication of laziness on my part; it is impossible +to implement primPrint in the current runtime system because there is +insufficient type information available at program runtime. + +.cc 5 +For example, if you try to compile the program: + + main :: Dialogue + main = appendChan "stdout" (show' 42) exit done + +the compiler will respond with the error message: + + ERROR: Primitive function primPrint is not + supported by the gofc runtime system + (used in the definition of show') + Aborting compilation + +The solution is to use type classes. This is one of the reasons for +including them in the language in the first place. This example can +be compiled by changing the original program to: + + main :: Dialogue + main = appendChan "stdout" (show 42) exit done + +(Remember that show is the overloaded function for converting values of +any type a that is an instance of the Text class to a string value.) + + +.ST 5.3 Debugging output +--------------------- +Another potentially useful feature of gofc is it's ability to dump a +listing of all the supercombinator definitions that are created by +loading a particular combination of script files. For the time being, +this is only useful for the purpose of debugging, but with only small +modifications, it might be possible to use this as input to an +alternative backend/code generator system (the format of the output +combinators already uses explicit layout characters to make the task of +parsing easier in an application like this). + +To illustrate how this option might be used, suppose that we were working +on a program containing the definition: + + hidden xs = map (\[x] -> x) xs + +and that somewhere during the execution of our program, this function is +applied to a list value [[1],[1,2]]: + + ? hidden [[1],[1,2]] + [1, + Program error: {v132 [1, 2]} + (13 reductions, 75 cells) + + ? + +The variable v132 which appears here is the name used internally to +represent the lambda expression in the definition of hidden. For this +particular example, it is fairly easy to work this out, but in general, +it may not be so straightforward. Running the program through gofc and +using the +D toggle as follows produces an output file containing Gofer +SuperCombinators, hence the .gsc suffix: + + machine% gofc +D file + Gofer->C Version 1.01 (2.28) Copyright (c) Mark P Jones 1992-1993 + + [Writing supercombinators to "file.gsc"] + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "file": + [Leaving Gofer->C] + machine% + +Note that there is no need in this situation for the files loaded to +contain a definition for main :: Dialogue, although the compiler must +be loaded using exactly the same prelude and order of files as in the +original Gofer session to ensure that the same names are used. Scanning +the output file, we find that the only mention of v132 is in the +definitions: + + v132 o1 = case o1 of { + (:) o3 o2 -> case o2 of { + [] -> o3; + } + } + + hidden o1 = map v132 o1; + +This shows fairly clearly where the function v132 comes from. Of +course, this is far from perfect, but it might help someone to track +down a bug that little bit faster one day. It's better than nothing. + +Of course, the debugging output might also be of interest to anyone +that wants to find out more about the implementation of Gofer and +examine the supercombinator definitions generated when list +comprehensions, overloading, local function definitions etc. have all +been eliminated. For example, the standard prelude definitions of map +and filter become: + + map o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> o2 o4 : map o2 o3; + } + + filter o2 o1 = case o1 of { + [] -> []; + (:) o4 o3 -> let { o5 = filter o2 o3; + } in | o2 o4 -> o4 : o5; + | otherwise -> o5; + } + +This is one of the tools I'll be using if anyone ever reports another +bug in the code generator... + + +.co-------------------------------------------------------------------| +.ST 6. SOME HISTORY + +Ever since the first version of Gofer was released I've had requests +from Gofer users around the world asking how Gofer got its name and how +it came into being. This section is an attempt to try and answer those +questions. + +.ST 6.1 Why Gofer? +--------------- +Everything has to have a name. You may type in an `anonymous function' +as a lambda expression but Gofer will still go ahead and give it a +name. To tell the truth, I always intended the name `Gofer' to be +applied to my particular implementation of a functional programming +environment, not to the language on which it is based. I wanted that +to be an anonymous language. But common usage has given it the same +name, Gofer. + +If you take a look in a dictionary (as some puzzled Gofer users have) +you'll find that `gofer' means: + + ``an employee whose duties include running errands'' + +(although you'd better choose a dictionary printed since the 70s for +this). I'd not thought about this when I chose the name (and I would +have used a lower case g instead of an upper case G if I had). In +fact, Gofer was originally conceived as a system for machine assisted +equational reasoning. One of the properties of functional languages +that I find particularly attractive is that they are: + + GOod For Equational Reasoning. + ^^ ^ ^ ^ +So now you know. The fact that you can also tell someone who is having +a problem with their C program to ``Gofer it!'' (unsympathetic, I know) +is nothing more than a coincidence. Fairly recently, somebody wrote to +ask if Gofer stood for ``GOod Functional programming EnviRonment''. I +was flattered; I wish I'd thought of that one. + +Some people have asked me why I didn't choose a title including the +name `Haskell', a language on which Gofer is very strongly based. +There are two reasons for this. To start with, the original version of +Gofer was based on a different syntax, Orwell + type classes. The +Haskell influence only crept in when I started on version 2.xx. +Secondly, it's only right to point out that there is quite a large gap +between a system like Gofer and the full blown Haskell systems that +have been developed. Using a name which doesn't involve `Haskell' +directly seemed the right thing to do. Some people tell me that it was +a mistake. One of the objectives of Haskell was to create a standard +language for non-strict functional programming. Gofer isn't intended +as an alternative to Haskell and I hope it will continue to grow closer +as time passes. + +While I'm on the subject of names, I should also talk about an +additional source of confusion that may sometimes crop up. While Gofer +is a functional programming system, there is also a campus wide +information system called `Gopher' (sharing it's name with the North +American rodents). I would guess that the latter has many more users +than the former. So please be careful to spell Gofer with an `f' not +a `ph' to try and minimize the confusion. + +It has occurred to me that I should try and think of another name for +Gofer to avoid the confusion with Gopher. I hope that won't be +necessary, but if you have a really good suggestion, let me know! One +possibility might be to call it `Gordon'. The younger generation of +brits might know what the connection is. Others may need to ask their +children... + +.ST 6.2 The history of Gofer +------------------------- +Here is a summary of the way that I first learnt about functional +programming, and how it started me on the path to writing Gofer. +This, slightly sentimental review is mostly for my own entertainment. +If you're the sort of person that likes to read the acknowledgments +and bibliographic notes in a thesis: this is for you. If not, you +can always stop reading :-) + +My first exposure to lazy functional programming languages was using a +language called `Orwell' developed and used at the Programming Research +Group in Oxford. I've been interested in using and implementing lazy +functional programming languages ever since. + +One of the properties of programming in Orwell that appealed to me was +the ability to use equational reasoning -- a very simple style of +mathematical reasoning -- to establish properties of programs and prove +that they would behave in particular ways. Even more interesting, +equational reasoning can be used to calculate efficient implementations +of programs from a formal specification of what was intended. + +Probably the first non-trivial functional program that I wrote was a +simple Prolog interpreter. (This was originally written in Orwell and +later transcribed to be compiled using the Chalmers Haskell B compiler, +hbc. The remnants of this program live on in the mini Prolog +interpreter that is included with the Gofer distribution and, I +believe, with at least a couple of the big Haskell systems.) Using a +sequence of something like a dozen or so transformations (most of which +were fairly mundane), I discovered that I could turn a relatively +abstract specification of a Prolog inference engine into a program that +could be interpreted as the definition of a low level stack-based +machine for executing Prolog queries. Indeed, I used the result as the +core of a C implementation of mini Prolog. + +The transformations themselves were simple enough but managing the +complexity of the calculations was tough. It was not uncommon to find +that some of the intermediate steps in a calculation would span more +than 200 characters. Even with a relatively small number of +transformation steps, carrying out proofs like this was both tedious +and prone to mistakes. A natural application for a computer! + +Here's an outline of what happened next: + + eqr 1989. Eqr was a crude tool for machine assisted equational + reasoning. It worked well enough for the job I had intended + to use it for, but it also had a number of problems. I + particularly missed the ability to use and record type + information as part of an automated derivation. + + 1.xx 1990. Gofer 1.xx was intended to be the next step forward + providing machine support for *typed* equational reasoning. + It was based on Orwell syntax and was later extended to + support Haskell style type classes. It had a lexer, parser, + type checker and simple top-level interactive loop. It + couldn't run programs or construct derivations. + + 2.xx January 1991. A complete rewrite. I remember those early + days, several months passed before I ever got compile some of + the earliest code. The emphasis switched to being able to run + programs rather than derive them when I came up with a new + implementation technique for type classes in February 1991. + If I wanted to see it implemented, I was going to have to do + it myself. Around about May, I realized I had something that + might be useful to other people. + + 2.20 The first public release, announced in August 1991 and + distributed shortly after that in September. + + 2.21 November 1991, providing a more comprehensive user + interface, access to command line options and fixing a + small number of embarrassing bugs in the original release. + + 2.23 August 1992, having been somewhat preoccupied with academic + studies for some time, the main purpose of this release + was to correct a number of minor bugs which had again been + discovered, either by myself or by one or more of the many + Gofer users out there. + + 2.28 January 1993. The most substantial update to Gofer since + the original release. I had been doing a lot of work and + experimentation with Gofer during the time between the + release of versions 2.21 and 2.23, but I didn't have the + time to get these extensions suitable for public distribution. + By the time I came to release version 2.23, I also had + several other distinct versions of Gofer (each derived + from the source for version 2.21) including a compiler + and a prototype implementation of constructor classes + which was called `ccgofer'. Work on version 2.28 started + with efforts to merge these developments back into a single + system (I was tired of trying to maintain several different + versions, even though I was the only one using them). + The rough outline of changes was as follows (with the + corresponding version numbers for those who wonder why + 2.28 follows 2.23): + + 2.24 enhancements and bug fixes + 2.25 merging in support for the Gofer compiler + 2.26 a reimplementation of constructor classes + 2.27 reworked code generator and other minor fixes + 2.28 preparation for public release +.co-------------------------------------------------------------------| diff --git a/docsrc/notes230.doc b/docsrc/notes230.doc new file mode 100644 index 0000000..f50b527 --- /dev/null +++ b/docsrc/notes230.doc @@ -0,0 +1,598 @@ +.co This is the source form of the release notes for Gofer 2.30a +.co +.co Mark P Jones June 1994 +.co-------------------------------------------------------------------| +.>release.230 +----------------------------------------------------------------------- + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.30a + + Copyright Mark P Jones 1994. This release is subject to the same + conditions of use and distribution as previous versions, documented + in src/goferite.h and in the main user manual. + + Release notes +----------------------------------------------------------------------- + +This document is intended to be used as a supplement to the original +user manual ``An introduction to Gofer version 2.20'' and release +notes for Gofer 2.21 and Gofer 2.28. These notes replace the +preliminary version distributed with Gofer 2.30. + +ACKNOWLEDGMENTS: +A lot of people have contributed to the development of Gofer 2.30a +with their support, encouragement, suggestions, comments and bug +reports. There are a lot of people to thank: + + Jim Blandy Jonathan Bowen Rodney Brown + Nick Chapman Derek Charleston Stuart Clayman + Terry Dineen Luc Duponcheel Dirk Dussart + Sebastian Egner Stephen Eldridge Jeroen Fokker + Jeff Fried Andy Gill Michial Gunter + Kevin Hammond Daniel Harris Barney Hilken + Steve Hill Ian Holyer Richard Jones + Fumiaki Kamiya Eak Khoon Hiroyuki Matsuda + Sava Mintchev Torben Mogensen Dirk Nehring + Chin Wei Ngan Kurt Olender Palle Nielsen + Ian Poole Bambang Prastowo Jaan Priisalu + Giuliano Procida Jerry Prothero Laurenz Pruessner + Niklas R\"ojemo Kristoffer Rose Bernhard Rumpe + David Rushall Carsten Schultz Viren Shah + Dave Sherratt Guy Steele Jr. Donald Smith + Matthew Smith Michael Stout Bernard Sufrin + Peter Thiemann Stephen Thomas Bert Thompson + Ignacio Trejos-Zelaya Goeran Uddeborg Robin Watts + Gavin Wraith David Wright Isii Yuuitirou + +This also includes the names of people who sent comments and bug +reports after the release of version 2.28 and who may not have been +credited in previous release notes. The list probably isn't complete, +and I apologize if I have inadvertently left your name out. + +Enjoy! jones-mark@cs.yale.edu (Until mid-July 1994) +Mark mpj@cs.nott.ac.uk (From Sept/Oct 1994) +.pa +.ti Release Notes v2.30 +.co-------------------------------------------------------------------| +.ST 1. MINOR ENHANCEMENTS AND BUGFIXES + +The following sections list the minor enhancements and bugfixes that +have been made to Gofer since the release of version 2.28. More +significant changes are described in Section 2. + + +.ST 1.1 Enhancements +----------------- + o A new command, :gc, has been added, making it possible to force the + interpreter to carry out a garbage collection. + + o The infamous `too many variables in type checker' message that has + caused problems with some programs, particularly machine generated + Gofer scripts like the parsers produced by Ratatosk, should now be + a thing of the past. The message may still appear when running + such programs on smaller machines where the amount of free memory + available for such things is very limited. + + o It is now possible to compile Gofer without support for old style + Dialogue based I/O and, independently, without support for (n+k) + and (c*n) patterns. You may take this as a hint that these + features may not be supported in future versions, although no firm + decisions have been made just yet. + + o As a convenience, the parser allows constructor expressions of + the form (t ->) as an abbreviation for ((->) t). + + o Tuple patterns (with irrefutable components) are now treated as + irrefutable patterns, but without changing the previous lifted + semantics. This is marginallly more efficient. It also means + that it is no longer necessary to use ~ for generators of the form + (x,y) <- expr in monad comprehensions, too avoid restricting the + enclosing comprehension to monads with a zero. + + o Type expressions appearing in primitive declarations may now + include synonyms, classes etc. defined in the same script. + + o Other minor tweaks and improvements. + + +.ST 1.2 Bug fixes +-------------- +Nobody really likes to dwell on bugs, especially when they have been +eliminated. But for those of you who want to know, here is a summary of +the bugs discovered and fixed in Gofer 2.30: + + o Test programs apr*.gs that were included in previous distributions + are no longer included in the src directory. These programs were + intended only for quick tests, not for public distribution. The + fact that some of the test programs (intentionally) caused errors, + was a source of unnecessary concern for some since the expected + behaviour was not documented. + + o Some minor fixes to the parser/grammar to give better error + messages. + + o Fixed problems with the :edit command on some machines, + particularly noticable on the RISCOS version. + + o Large integer constants that are outside the range for Int + values are no longer implicitly coerced to type Float. + + o The implementations of assignment in the LAMBDAVAR and LAMBDANU + extensions, and the implementation of the system primitive for + LAMBDANU contained subtle bugs that have now been fixed. Note + however that these extensions are now regarded as obsolete, and + will probably not be supported in future versions. (LAMBDAVAR and + LAMBDANU where never formally included as an official feature of + Gofer anyway.) + + o Infix data constructors can now be used in a datatype definition + such as: + + data Tree a = Empty | Tree a `Fork` Tree a + + o A very subtle bug in the unification algorithm has been fixed. + + o Some bugs in mildly complicated examples involving pattern + matching of integer constants and singleton lists have been + fixed. + + o Fixed some small problems with a couple of the demonstration + programs. + + o Modified prelude definitions of the index function (in class Ix) + to include a bounds check. + + o Other minor bug fixes and tweaks. + +Someone is bound to find a new one within hours of the release of 2.30, +if past experience is anything to go by. If that someone is you, +please let me know! + + +.co-------------------------------------------------------------------| +.ST 2. LANGUAGE DIFFERENCES + +This section outlines a number of more substantial extensions that are +supported in Gofer 2.30. One of the most important motivations for +some of these extensions, and part of an ongoing process, is to provide +greater compatibility with standard Haskell. + + +.ST 2.1 Contexts in datatype definitions +------------------------------------- +For greater compatibility with Haskell, it is now possible to include +contexts in datatype definitions. These are treated in exactly the +same way as in Haskell. For example, the only effect of using a +context in the datatype definition: + + data Eq a => Set a = NilSet | ConsSet a (Set a) + + is to treat the ConsSet constructor function as having type: + + ConsSet :: Eq a => a -> Set a -> Set a + + See Section 4.2.1 of the Haskell report, version 1.2, for further + details. + + +.ST 2.2 Contexts in member function types +-------------------------------------- +For greater compatibility with Haskell, it is now possible to include +contexts in the type of member function definitions in a class +specification. For example, you can now try out the class definition +for pseudo monads given in the Yale Research Report YALEU/DCS/RR-1004 +entitled `Composing Monads' by myself and Luc Duponcheel: + + class Premonad m => Pseudomonad m where + pbind :: Monad m => p a -> (a -> m (p b)) -> m (p b) + +Unlike Haskell, Gofer does not make the restriction that the additional +constraints on the types of the member functions should not mention any +of the types in the first line of the class declaration. This appears +to have been a consequence of the formal system underlying the original +theoretical work on type classes by Blott. For the qualified type +system that is used as a basis for Gofer, such restrictions are +unnecessary, although one might argue that they should be retained on +stylistic grounds ... + +See Section 4.3.1 of the Haskell report, version 1.2, for further +details. + + +.ST 2.3 Haskell arrays +------------------- +For closer compatibility with Haskell, Gofer now supports a built-in +implementation of Haskell style arrays. To include support for these +arrays, Gofer must be compiled with the HASKELL_ARRAYS flag set to 1. +This is the default for all but the very smallest PC version of Gofer. + +The implementation includes is based on new primitive datatype: + + data Array a b + +The array primitives are not currently incorporated into any of the +preludes supplied with Gofer. However a separate script file, +array.gs, is included in the same directory with the following +interface: + + data Assoc a b = a := b deriving (Eq, Ord, Text) + + array :: Ix a => (a,a) -> [Assoc a b] -> Array a b + listArray :: Ix a => (a,a) -> [b] -> Array a b + (!) :: Ix a => Array a b -> a -> b + bounds :: Ix a => Array a b -> (a,a) + indices :: Ix a => Array a b -> [a] + elems :: Ix a => Array a b -> [b] + assocs :: Ix a => Array a b -> [Assoc a b] + accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) + -> [Assoc a c] -> Array a b + (//) :: Ix a => Array a b -> [Assoc a b] -> Array a b + accum :: Ix a => (b -> c -> b) -> Array a b + -> [Assoc a c] -> Array a b + amap :: Ix a => (b -> c) -> Array a b -> Array a c + ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) + -> Array b c -> Array a c + + instance (Ix a, Eq [Assoc a b]) => Eq (Array a b) + instance (Ix a, Ord [Assoc a b]) => Ord (Array a b) + instance (Ix a, Text (a,a), Text [Assoc a b]) + => Text (Array a b) + + instance (Ix a, Ix b) => Ix (a,b) + rangeSize :: (Ix a) => (a,a) -> Int + +For example, to use these primitives in a Gofer session, just include +array.gs as the first file that you load, or as the one of the first +file names in a project file. + +Arrays, and the primitives above are supported in both the interpreter +and the compiler. Because of restrictions in memory management, the +current implementation does not provide true O(1) lookup/indexing in +the interpreter or the compiler using the markscan garbage collector. +True O(1) access is supported when the twospace collector is used for +compiled programs. + +See Section 6.9 of the Haskell report, version 1.2, for further details +about the use of arrays and the primitives described above. Please +bear in mind that the current implementation is still preliminary, and +may contain bugs. Please let me know if you encounter any problems +with it! A few short demo programs are included in demos/arrayEx.gs. + + +.ST 2.4 Monadic I/O +---------------- +A preliminary implementation of the monadic I/O is supported, built on +top of the framework for lazy functional state threads that has been +proposed by John Launchbury and Simon Peyton Jones (PLDI '94). The +details of monadic I/O can be expected to change in future releases as +a new standard for monadic I/O is established. For the time being, the +primitives described here will be of most interest to those looking to +experiment with simple monadic I/O and the Launchbury/Peyton Jones +system. To include support for monadic I/O, Gofer must be compiled +with the IO_MONAD flag set to 1. This is the default for all but the +very smallest PC version of Gofer. + +The current implementation provides several new primitive types: + + data ST s a -- lazy state threads monad + data World -- representation of `the world' + type IO = ST World -- the I/O monad proper + data MutVar s a -- a mutable variable + +An interface to monadic I/O can be obtained by loading the file +iomonad.gs which may be found in the same directory as the prelude +files. This provides the following operations: + + returnST :: a -> ST s a + thenST :: ST s a -> (a -> ST s b) -> ST s b + thenST_ :: ST s () -> ST s b -> ST s b + seqST :: [ST s ()] -> ST s () + + newVar :: a -> ST s (MutVar s a) + readVar :: MutVar s a -> ST s a + writeVar :: MutVar s a -> a -> ST s () + mutvarEq :: MutVar s a -> MutVar s a -> Bool + + instance Eq (MutVar s a) + + getch :: IO Char + getchar :: IO Char + putchar :: Char -> IO () + putString :: String -> IO () + thenIO :: ST s a -> (a -> ST s b) -> ST s b + interleaveST :: ST s a -> ST s a + +The thenIO function is a stricter version of thenST that is suitable +only for computations in the IO monad. See the Launchbury and +Peyton Jones paper referenced below for further details. + +There is also a built-in special form, runST expr, which is typed +using the rule: + + expr :: forall s. ST s a (s not appearing in a) + ------------------------ + runST expr :: a + +This special form is used for encapsulating state based computations +within a purely functional program. See references below for more +details. + +If the version of Gofer being used also includes support for arrays, as +described above, you can also use the definitions in ioarray.gs to +support monadic array operations: + + newArr :: Ix a => (a,a) -> b -> ST s (MutArr s a b) + readArr :: Ix a => MutArr s a b -> a -> ST s b + writeArr :: Ix a => MutArr s a b -> a -> b -> ST s () + freezeArr :: Ix a => MutArr s a b -> ST s (Array a b) + +Some sample programs using the functions described here may be found in +the demos/IO directory. For further details about monadic I/O, please +consult the papers: + + Imperative Functional Programming, S.L. Peyton Jones and + P. Wadler, POPL '93. + + Lazy Functional State Threads, J. Launchbury and S.L. Peyton + Jones, PLDI '94. + +.cc 4 +See also: + + Lazy depth-first search and linear graph algorithms in + Haskell, D. King and J. Launchbury, 1993. + +For some very nice applications of lazy functional state threads. +All of these papers are currently available by anonymous ftp from +the University of Glasgow, ftp.dcs.glasgow.ac.uk. + +Monadic I/O as described above is supported in both the Gofer +interpreter and compiler. No special optimizations are used in +the current implementation which should still be treated as +preliminary, and may contain bugs. Please let me know if you +encounter any problems with it! + + +.ST 2.5 Trace primitive +-------------------- +A simple trace function, inspired by the original implementation in +LML, can now be accessed by including the primitive definition: + + primitive trace "primTrace" :: String -> a -> a + +in a Gofer script. When called, trace prints the string in its first +argument, then returns the second argument as its result. The trace +function is not referentially transparent, and should only be used for +debugging, or monitoring execution. That is why it is not included in +any of the preludes. Be warned also that, unless you understand +something about the way that Gofer programs are actually executed, +results obtained using trace may be rather confusing. + +Because of it's intended use, the trace primitive is not supported +by the Gofer compiler, gofc. It is however possible to `hack' in +a version of trace for gofc using the external function call +mechanism described below with the following C program: + + #include + #include "/usr/local/lib/Gofer/gofc.h" + + #define emptyList mkCfun(0) + + extern Cell primTrace(str,val) + Cell str, val; { + eval(str); + while (whnf!=emptyList) { + eval(pop()); + putchar(charOf(whnf)); + eval(pop()); + } + fflush(stdout); + return val; + } + +See Section 2.7 below for further details. + + +.ST 2.6 Constructor synonyms +------------------------- +Type synonym definitions have been generalized to allow arbitrary +constructor synonyms such as: + + type List = [] + type Function = (->) + type Infer = StateM Int Error + +Previously, it was assumed that both the constructors on the left and +right hand sides were types, i.e. constructors of kind *. This +restriction has now been lifted, although both sides are still required +to have the same kind. However, the restriction that all arguments to +a synonym must be given is still imposed. + + +.ST 2.7 External function calls +---------------------------- +The Gofc compiler, translating Gofer programs to C provides a simple +external function calling mechanism. + +External functions are specified using a primitive declaration of the +form: + + primitive foo "bar" :: a1 -> a2 -> a3 -> ... -> an -> r + +where foo is the Gofer name for the function, bar is the name of the +corresponding C function (which must not be a string referring to one +of the built in primitives ... if you avoid the `prim' prefix, this +should not be a problem), the ai are the argument types, and r is the +result type. Arguments of type Int, Bool, Char and Float are evaluated +before the bar function is invoked, and their results passed to bar in +parameters of suitable types. All other values are passed as +unevaluated Cell values. (Special treatment is also provided for +arrays, mutable variables, and mutable arrays for versions of Gofer +that support these facilities.) + +Results of type Int, Bool, Char and Float returned from an external +function are automatically converted to suitable representations for +Gofer. Values of any other type should be passed back as Cell values +by the C code for the external function. + +A result type of the form IO r should be used for external functions +that may have some side effects. A result type of the form IO () can +be used to call a function that does not return any useful value and is +executed only for its effect. + +Here is a simple example using the external function mechanism. It +involves the following short Gofer and C programs: + +(gix1.gs): primitive howdy "sayHello" :: Int -> IO () + + main = howdy (length (filter even [1..5])) + +.cc 8 +(cix1.c): #include + #include "gofc.h" + + Void sayHello(i) + Int i; { + while (i-- > 0) + printf("hello, world\n"); + } + +First, we compile gix1.gs to get a C program gix1.c: + + machine% gofc gix1.gs + Gofer->C Version 1.02 (2.30) ... + + Reading script file "/usr/local/lib/Gofer/standard.prelude": + Reading script file "gix1.gs": + + Writing C output file "gix1.c": + [Leaving Gofer->C] + +Now we compile the C programs, and link them into a single executable +file, ix1: + + machine% cc -O -o ix1 gix1.c cix1.c runtime.o + +Finally, we get to run the program: + + machine% ix1 + hello, world + hello, world + +See Section 2.5 above for another example using the external function +mechanism, and also illustrating how values of type String can be +evaluated and used in a C function. You will probably need to refer +to the report described in Section 3 below if you plan to do anything +very ambitious with external function calls. + +Note that the external function call mechanism described here cannot be +used in the Gofer interpreter. The external function call mechanism is +a prototype only. It should also be emphasized that we do not, in +general, regard the Gofc compiler as suitable for serious applications +development. If you want to do something along those lines, try one of +the full Haskell systems available (e.g. the Lisp or C interfaces for +Yale Haskell, or the C interface for Glasgow Haskell). + + +.ST 2.8 The do notation +-------------------- +Gofer 2.30 supports a new, experimental syntax for monad comprehensions +which we will refer to as `do {...} notation'. To maintain +compatibility with previous releases of Gofer, the do notation is +only supported if the system is compiled with the DO_COMPS flag in +prelude.h set to to 1, and the DO_COMPS section of parser.y included. +See the comments in these files and in src/Readme for further +details. + +The do notation is useful for monadic programming. It requires the +cc.prelude, and provides the following syntax: + + ::= do "{" "}" -- uses layout rule + + ::= { ;} + + ::= <- -- generator + | -- command + | let "{" decls "}" -- local definitions + | if -- guard + +With this notation, a guard is written as if , while a single +expression of the form is treated as a command, i.e. a generator +of the form _ <- . For example, a general version of the filter +function can be defined as: + + myFilter :: Monad0 m => (a -> Bool) -> m a -> m a + myFilter p xs = do x <- xs + if p x + result x + +If you prefer, this can be written as follows, using explicit layout: + + myFilter p xs = do { x <- xs; + if p x; + result x + } + +In standard comprehension notation, this would be written: + + myFilter p xs = [ x | x <- xs, p x ] + +Perhaps the most significant difference between these two examples is +the fact that the call to result must be written explicitly in the +first case. In fact, if the comprehension is interpreted in a monad, +m, then any expression of type (m a) can be used as the final +expression in a do comprehension. This is useful for describing `tail +recursive' procedures. For example, compare: + + echo' = do c <- getchar + if c==EOF + then result () + else do putchar c + echo' + +with: + + echo' = [ () | c <- getchar, + () <- if c==EOF then result () + else [ () | _ <- putchar c, + () <- echo' ] ] + +It is, of course, a matter of personal opinion which of these you +prefer. The intention of do notation is to provide a more attractive +syntax for monadic programming, to be compared with programs using +`bind` in which the example above would be written: + + echo' = getchar `bind` \c -> + if c==EOF then result () + else putchar c `bind` \_ -> + echo' + +See which notation you prefer for practical programming, and let me +know! + +.co-------------------------------------------------------------------| +.ST 3. THE IMPLEMENTATION OF GOFER + +For those interested in the actual implementation of Gofer, there is +a (relatively new) technical report available that describes the +implementation of Gofer 2.30: + + The implementation of the Gofer functional programming system + Mark P. Jones + Research Report YALEU/DCS/RR-1030 + Yale University, Department of Computer Science, + May 1994. + +Copies of this report are currently available by anonymous ftp from +nebula.cs.yale.edu in the directory pub/yale-fp/reports, together +with a number of other recent reports by members of the Yale Haskell +project. + + +.co-------------------------------------------------------------------| diff --git a/docsrc/pfmt.c b/docsrc/pfmt.c new file mode 100644 index 0000000..4bbce75 --- /dev/null +++ b/docsrc/pfmt.c @@ -0,0 +1,309 @@ +#include + +/* Crude page formatter: + * + * + * .pa start new page + * .co xxx comment + * .ti title set title string + * .TI title set and print title string + * .st title set section title + * .ST title set and print section title + * .in file include contents of file + * .op page headings off + * .po page headings on + * .pn n set page number (numbers <=0 don't print) + * .pl n set page length + * .ht n blank lines above header line + * .hb n blank lines below header line + * .ft n blank lines above page number line + * .fb n blank lines below page number line + * .ss n minimum number of lines on page before new section begins + * .cc n start new page unless at least n clear lines on page + * .mi n only print pages numbered >= n + * .mx n print only pages numbered <= n (if max<=min, all pages printed) + * .off hide output + * .on show output + * .>stdout send following output to stdout + * .>file send following output to named file + */ + +#define MAXLINE 1024 +#define MAXINPUT 32 + +int physicalLines = 66; +int headerLines1 = 2; +int headerLines2 = 2; +int footerLines1 = 2; +int footerLines2 = 2; +int suppressHeaders = 0; +int contentsReqd = 0; +int lastSect = 0; +int sectSkip = 5; +int minPage = 0; +int maxPage = 0; +int outputOn = 1; + +int sofarThisPage; +int linesThisPage; +int pageNumber; + +FILE *outputFile = 0; +FILE *inputs[MAXINPUT]; +int inputLevel=0; +#define in inputs[inputLevel] + +includeFile(n) +char *n; { + if (inputLevel0) { + fclose(in); + inputLevel--; + } + else + return 0; + } + + while ((c=getc(in))!=EOF && c!='\n') + if (c!=26 && c!='\r') + if (i0 && thisSect!=lastSect) || thisSect==0) + fprintf(stderr,"\n.cc 2\n"); + fprintf(stderr," "); + for (i=0; *t; ++i) + fputc(*t++, stderr); + for (; i<66; i++) + fputc(((i&1) ? '.' : ' '), stderr); + fprintf(stderr,"%3d\n",pageNumber); + lastSect = thisSect; + } + + if (sofarThisPage + sectSkip >= linesThisPage) + clearPage(); +} + +outputLine(s) +char *s; { + if (!contentsReqd && outputOn && + (maxPage<=minPage || + (pageNumber>=minPage && pageNumber<=maxPage))) + if (outputFile) { + fputs(s,outputFile); + fputc('\n',outputFile); + } + else + puts(s); + sofarThisPage++; +} + +startPage() { + if (suppressHeaders) + linesThisPage = physicalLines; + else { + static char buffer[MAXLINE+1]; + int i; + for (i=0; i0) { + sprintf(buffer,"%38s%d","",pageNumber); + outputLine(buffer); + } + else + outputLine(""); + + for (i=0; i0; argc--, argv++) + if (strcmp(*argv,"-c")==0) + contentsReqd = 1; + else + fprintf(stderr,"unknown command line argument \"%s\"\n",*argv); + + startDocument(); + + while (readLine(buffer)) { +ugly: + if (matchesFlag(buffer,".pa")) + clearPage(); + else if (matchesFlag(buffer,".on")) + outputOn = 1; + else if (matchesFlag(buffer,".off")) + outputOn = 0; + else if (matchesFlag(buffer,".co")) + continue; + else if (matchesFlag(buffer,".ti ")) + strcpy(title,buffer+4); + else if (matchesFlag(buffer,".TI ")) { + strcpy(title,buffer+4); + strcpy(buffer,title); + goto ugly; + } + else if (matchesFlag(buffer,".st ")) + setSecTitle(buffer+4); + else if (matchesFlag(buffer,".ST ")) { + setSecTitle(buffer+4); + strcpy(buffer,sectitle); + goto ugly; + } + else if (matchesFlag(buffer,".>stdout")) { + if (outputFile) + fclose(outputFile); + outputFile = 0; + } + else if (matchesFlag(buffer,".>")) { + if (outputFile) + fclose(outputFile); + outputFile = fopen(buffer+2,"w"); + } + else if (matchesFlag(buffer,".in ")) + includeFile(buffer+4); + else if (matchesFlag(buffer,".po")) + suppressHeaders = 0; + else if (matchesFlag(buffer,".op")) + suppressHeaders = 1; + else if (setParam(buffer,".pn",&pageNumber) || + setParam(buffer,".pl",&physicalLines) || + setParam(buffer,".ht",&headerLines1) || + setParam(buffer,".hb",&headerLines2) || + setParam(buffer,".ft",&footerLines1) || + setParam(buffer,".fb",&footerLines2) || + setParam(buffer,".ss",§Skip) || + setParam(buffer,".mi",&minPage) || + setParam(buffer,".mx",&maxPage)) + continue; + + else if (setParam(buffer,".cc",&condClear)) { + if (sofarThisPage + condClear >= linesThisPage) + clearPage(); + } + + else if (*buffer || + suppressHeaders || + (sofarThisPage>0 && sofarThisPage=linesThisPage) /* finish off any completed*/ + clearPage(); /* page */ + + if (sofarThisPage==0) /* maybe start a new page */ + startPage(); + outputLine(buffer); /* then print the line */ + } + } + + endDocument(); + exit(0); +} diff --git a/docsrc/usrguide.doc b/docsrc/usrguide.doc new file mode 100644 index 0000000..5166608 --- /dev/null +++ b/docsrc/usrguide.doc @@ -0,0 +1,5690 @@ +.co This is the `source form' of the user documentation for Gofer, to be +.co processed using my simple prn formatter before being printed. +.co +.co Mark P. Jones August 1991 +.co-------------------------------------------------------------------| +.>ch00 +.op +.ti Introduction to Gofer + + + + + + + __________ __________ __________ __________ ________ + / _______/ / ____ / / _______/ / _______/ / ____ \ + / / _____ / / / / / /______ / /______ / /___/ / + / / /_ / / / / / / _______/ / _______/ / __ __/ + / /___/ / / /___/ / / / / /______ / / \ \ + /_________/ /_________/ /__/ /_________/ /__/ \__\ + + Functional programming environment, Version 2.20 + + Copyright Mark P Jones 1991. + + + + + + + A N I N T R O D U C T I O N T O G O F E R + + + draft version only --- please report any errors, suggestions for + improvements, extensions (or deletions!) to jones-mark@cs.yale.edu + + + This version includes a number of small corrections + made since the original release. + + -------------------------------------------------------------------- + Permission to use, copy, modify, and distribute this software and its + documentation for any personal or educational use without fee is hereby + granted, provided that: + a) This copyright notice is retained in both source code and + supporting documentation. + b) Modified versions of this software are redistributed only if + accompanied by a complete history (date, author, description) of + modifications made; the intention here is to give appropriate + credit to those involved, whilst simultaneously ensuring that any + recipient can determine the origin of the software. + c) The same conditions are also applied to any software system + derived either in full or in part from Gofer. + + The name "Gofer" is not a trademark, registered or otherwise, and + you are free to mention this name in published material, public and + private correspondence, or other documents without restriction or + obligation. + + Gofer is provided "as is" without express or implied warranty. + -------------------------------------------------------------------- +.pa +.po +.pn -100 + T A B L E O F C O N T E N T S + + +.in contents +.pa +.pn 1 +.co-------------------------------------------------------------------| +.>ch01 +.ST 1. INTRODUCTION + +Gofer is a functional programming environment (in other words, an +interpreter) that I have implemented for my own personal use as part of +my research into `qualified types'. Nevertheless, the system is +sufficiently complete for me to believe that Gofer may be of interest +and use to others interested in the field of functional programming. + +These notes give a brief introduction to the Gofer system and include +some examples of Gofer programs. They are not the notes that I +originally intended to write, being somewhat longer and perhaps more +tutorial in nature. Nevertheless, you will not be able to learn +functional programming from this document alone. A number of useful +references are given in the reading list at the end of this document. +In particular, the book by Bird and Wadler [1] is particularly good as +a general introduction to the use, techniques and theory of functional +programming. Although their notation is a little different from the +language used by Gofer, it is a relatively straightforward task to +translate between the two, and some suggestions for this are given in a +appendix D. More importantly, the underlying semantics of Gofer do +correspond to those expected by the authors of [1]. + +Whereas the work involved in investigating and implementing the ideas +on which Gofer is based were motivated largely by my own program of +work, the writing of these notes has rather more to do with the hope +that Gofer will be useful to others. I would therefore be very +grateful for any feedback on any aspect of the these notes (or of the +Gofer system itself). Please let me know if you discover any errors, +or if you find particular sections of these notes rather hard to +follow. Suggestions for improvements or extensions are more than +welcome. +.pa +.co-------------------------------------------------------------------| +.>ch02 +.ST 2. BACKGROUND AND ACKNOWLEDGEMENTS + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell [5]. My +principal task in the implementation of Gofer has therefore been to +decide which features I should omit and then to implement what +remains. Features common to both include: + + o Non-strict semantics (lazy evaluation). + o Higher-order functions. + o Extended polymorphic type system with support for user-defined + overloading. + o User-defined algebraic datatypes. + o Pattern matching. + o List comprehensions. + o Facilities for I/O, whilst retaining referential transparency + within a program. + +For the benefit of readers familiar with Haskell, the following +features of Haskell are not supported in the standard version of Gofer: + + o Modules. + o Arrays. + o Defaults for unresolved overloading. + o Derived instances of standard classes. + o Contexts in datatype definitions. + o Full range of numeric types and classes. + +But Gofer is not just a partial implementation of Haskell; it also +includes a number of experimental features which extend the type system +in several ways: + + o An alternative approach to type classes which avoids the need for + construction of dictionaries during the evaluation of an + expression. + o Type classes may take multiple parameters. + o Instances of type classes may be defined at arbitrary + non-overlapping types. + o Contexts may include arbitrary type expressions. + +These extensions stem from my own research [8, 9, 10, 11, 12] and were +among the principal motivations for the development of Gofer. Full +details of the differences between Gofer and Haskell 1.1 are given in +appendix C. + +Gofer would not have been implemented without my original introduction +to functional programming using Orwell [6], and I am particularly +grateful to Quentin Miller for answering so many of my questions about +functional programming and about the Orwell system in particular. I +should also like to mention the influence of the Haskell B. compiler +from Lennart Augustsson and Thomas Johnsson and based on their earlier +LML compiler [7]. + +Right from the beginning, I wanted to be able to use Gofer on a range +of machines - and in particular, on the humble PC that I use at home. +With this in mind, Gofer was actually developed on that same PC using +Borland's Turbo C 1.5 and a public domain version of the yacc parser +generator that I picked up some time ago. Gofer was also written with +some degree of portability in mind and has subsequently been compiled +to run on Sun workstations. I hope it will also be possible to port it +to other platforms. It is my intention that Gofer be distributed +complete with source code and I hope that this will be of interest to +some users. + +Many of the ideas used in the back-end of the Gofer system (i.e. the +compiler and abstract machine) originate from the chapters of Simon +Peyton Jones textbook [2]; I very much doubt whether Gofer would have +been completed without frequent reference to that book. The +lambda-lifter used in Gofer is based on Thomas Johnsson's algorithm +described in [3]. + +On the theoretical side, I'm grateful to Phil Wadler for the +encouragement that he has given me with my work on qualified types. +Many of the basic ideas that I have used were inspired by his original +paper motivating the use of type classes [4]. +.pa +.co-------------------------------------------------------------------| +.>ch03 +.ST 3. STARTING GOFER + +The Gofer interpreter is usually entered by giving the command `gofer', +after which a display something like the following will normally be +produced: + + Gofer Version 2.20 + + Reading script file "/gofer/prelude": + Parsing........................................................ + Dependency analysis............................................ + Type checking.................................................. + Compiling...................................................... + + Gofer session for: + /gofer/prelude + Type :? for help + ? + +The file name "/gofer/prelude" mentioned in the output above is the +name of a file of standard definitions which are loaded into Gofer each +time that the interpreter is started. By default, Gofer reads these +definitions from a file called "prelude" in the current working +directory. Alternatively you can set the environment variable GOFER to +the name of the standard prelude file, which will then be used, +whatever the current working directory might be. + +Most commands in Gofer take the form of a colon followed by one or more +characters which distinguish one command from another. There are two +commands which are particularly worth remembering: + + o :q exits the Gofer interpreter. On most systems, you can also + exit from Gofer by typing the end of file character (^Z on an + MS-DOS machine, usually ^D on a unix based machine). + + o :? prints a list of all the commands, which can be useful if you + forget the name of the command that you want to use. + +The complete range of commands supported by the Gofer interpreter is +described in appendix F. + +Note that the interrupt key (^C on most systems) can be used at any +time whilst using Gofer to abandon the process of reading in a file of +function definitions or the evaluation of an expression. When the +interrupt key is detected, Gofer prints the string "{Interrupted!}" and +prints the "? " prompt so that further commands can be entered. + +.pa +.co-------------------------------------------------------------------| +.>ch04 +.ST 4. USING GOFER - A BASIC INTRODUCTION + +Using Gofer is rather like using a high-level programmable calculator; +Once the interpreter is loaded, the system prints a prompt "?" and +waits for you to enter an expression, and then press the enter (return) +key. Once the input is complete, Gofer evaluates the expression and +prints its value on the terminal, before returning to the original +prompt and waiting for the next expression. For example: + + ? (2+3)*8 + 40 + (5 reductions, 9 cells) + ? sum [1..10] + 55 + (91 reductions, 130 cells) + ? + +In the first example, the user entered the expression "(2+3)*8", which +was evaluated by Gofer and the result "40" printed on the terminal. At +the end of any calculation, Gofer displays the number of reductions (a +measure of the amount of work) and cells (a measure of the amount of +memory) that were used during the calculation. These figures can be +useful for comparing the performance of different ways of carrying out +the same calculation. + +In the second example, the user typed the expression "sum [1..10]". +The notation "[1..10]" represents the list of integers between 1 and 10 +inclusive, and "sum" is a standard function which can be used to +determine the sum of a list of integers. Thus the result obtained by +Gofer is: + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 = 55 + +We could have typed this sum into Gofer directly: + + ? 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 55 + (10 reductions, 23 cells) + ? + +and this calculation is certainly more efficient as it uses only 1/9th +of the number of reductions and 1/5th of the number of cells as the +original calculation. On the other hand, the original expression is +much shorter and you are much less likely to make a mistake typing in +the expression "sum [1..200]" than you would be if you tried to enter +the sum of the integers from 1 to 200 directly. + +You will learn more about the kind of expressions that can be entered +into Gofer in the rest of this document. +.pa +.co-------------------------------------------------------------------| +.>ch05 +.ST 5. STANDARD AND USER-DEFINED FUNCTIONS + +The function "sum" used in the examples above, and indeed the addition +and multiplication functions (+) and (*), are all standard functions +which are included as part of a large collection of functions called +the `standard prelude' which are loaded into the Gofer system each time +that you start the interpreter. Quite a number of useful calculations +can be carried out using these functions alone, but for more general +use you can also define your own functions and store the definitions in +a file so that these functions can be loaded and used by by the Gofer +system. For example, suppose that you create a file "fact" containing +the following definition: + + fact n = product [1..n] + +The "product" function is another standard function which can be used +to calculate the product of a list of integers, and so the line above +defines a function "fact" which calculates the factorial of its +argument. In standard mathematical notation, fact n = n! which is +usually defined informally by an equation of the form: + + n! = 1 * 2 * ... * (n-1) * n + +Once you become familiar with the notation used by Gofer, you will see +that the Gofer definition of the factorial function is really very +similar to this informal mathematical definition. + +In order to use this definition from the Gofer interpreter, we must +first load the definitions of the file into the interpreter. The +simplest way to do this uses the ":l" command: + + ? :l fact + Reading script file "fact": + Parsing...................................................... + Dependency analysis.......................................... + Type checking................................................ + Compiling.................................................... + + Gofer session for: + /gofer/prelude + fact + ? + +Notice the list of filenames displayed after "Gofer session for:"; this +tells you which files of definitions are currently being used by Gofer, +the first of which is the file containing the definitions for the +standard prelude. Since the file containing the definition of the +factorial function has now been loaded, we can make use of this +function in expressions entered to the interpreter: + + ? fact 6 + 720 + (57 reductions, 85 cells) + +For another example, recall the standard mathematical formula which +tells us that the number of ways of choosing r objects from a +collection of n objects is given by n! / (r! * (n-r)!). In Gofer, this +function can be defined by: + + comb n r = fact n /(fact r * fact (n-r)) + +In order to use this function, we can either edit the file "fact" which +contains the definition of the factorial function, adding the +definition of "comb" on a new line, or we can include the definition as +part of an expression entered whilst using Gofer: + + ? comb 5 2 where comb n r = fact n /(fact r * fact (n-r)) + 10 + (110 reductions, 161 cells) + ? + +The ability to define a function as part of an expression like this is +often quite useful. However, if the function "comb" were likely to be +wanted on a number of occasions, it would be more sensible to add its +definition to the contents of the file "fact", instead of having to +repeat the definition each time it is used. + +You will learn more about the functions defined in the standard prelude +and find out how to define your own functions in the following +sections. +.pa +.co-------------------------------------------------------------------| +.>ch06 +.ST 6. FUNCTION NAMES - IDENTIFIERS AND OPERATORS + +As the examples of the previous section show, there are two kinds of +name that can be used for a function; identifiers such as "sum" and +operator symbols such as "+" and "*". Choosing the appropriate kind of +name for a particular function can often help to make expressions +involving that function easier to read. If for example the addition +function was represented by the name "plus" rather than the operator +symbol "+" then the sum of the integers from 1 to 5 would have to be +written as: + + plus (plus (plus (plus 1 2) 3) 4) 5 + +In this particular case, another way of writing the same sum is: + + plus 1 (plus 2 (plus 3 (plus 4 5))) + +Not only does the use of the identifier "plus" make these expressions +larger and more difficult to read than the equivalent expressions using +"+"; it also makes it very much harder to see that these two +expressions do actually have the same value. + +Gofer distinguishes between the two types of name according to the way +that they are written: + + o An identifier begins with a letter of the alphabet optionally + followed by a sequence of characters, each of which is either a + letter, a digit, an apostrophe (') or an underbar (_). + Identifiers representing functions or variables must begin with a + lower case letter (identifiers beginning with an upper case letter + are used to denote a special kind of function called a + `constructor function' described in section 11.1). The following + identifiers are examples of Gofer variable and function names: + + sum f f'' integerSum african_queen do'until'zero + + The following identifiers are reserved words in Gofer and cannot + be used as the name of a function or variable: + + case of where let in if + then else data type infix infixl + infixr primitive class instance + + o An operator symbol is written using one or more of the following + symbol characters: + + : ! # $ % & * + . / < = > ? @ \ ^ | - + + In addition, the tilde character (~) is also permitted, although + only in the first position of an operator name. [N.B. Haskell + also makes the same restriction for the minus/dash character + (-)]. Operator names beginning with a colon are used for + constructor functions in the same way as identifiers beginning + with a capital letter as mentioned above. In addition, the + following operator symbols have special uses in Gofer: + + :: = .. @ \ | <- -> ~ => + + All other operator symbols can be used as variables or function + names, including each of the following examples: + + + ++ && || <= == /= // . + ==> $ @@ -*- \/ /\ ... ? + + [Note that each of the symbols in the first line is used in the + standard prelude. If you are interested in using Gofer to develop + programs for use with a Haskell compiler, you might also want to + avoid using the operator symbols := ! :+ and :% which are used to + support features in Haskell not currently provided by the Gofer + standard prelude.] + +Gofer provides two simple mechanisms which make it possible to use an +identifier as an operator symbol, or an operator symbol as an +identifier: + + o Any identifier will be treated as an operator symbol if it is + enclosed in backquotes (`) -- for example, the expressions using + the "plus" function above are a little easier to read using this + technique: + + (((1 `plus` 2) `plus` 3) `plus` 4) `plus` 5 + + In general, an expression of the form "x `op` y" is equivalent to + the corresponding expression "op x y", whilst an expression such + as "f x y z" can also be written as "(x `f` y) z". + + [NOTE: For those using Gofer on a PC, you may find that your + keyboard does not have a backquote key! In this case you should + still be able to enter a backquote by holding down the key marked + ALT, pressing the keys '9' and then '6' on the numeric keypad and + then releasing the ALT key.] + + o Any operator symbol can be treated as an identifier by enclosing + it in parentheses. For example, the addition function denoted by + the operator symbol "+" is often written as "(+)". Any expression + of the form "x + y" can also be written in the form "(+) x y". + +There are two more technical problems which have to be dealt with when +working with operator symbols: + + o Precedence: Given operator symbols (+) and (*), should "2 * 3 + 4" + be treated as either "(2 * 3) + 4" or "2 * (3 + 4)"? + + This problem is solved by assigning each operator a precedence + value (an integer in the range 0 to 9). In a situation such as + the above, we simply compare the precedence values of the + operators involved, and carry out the calculation associated + with the highest precedence operator first. The standard + precedence values for (+) and (*) are 6 and 7 respectively so that + the expression above will actually be treated as "(2 * 3) + 4". + + o Grouping: The above rule is only useful when the operator symbols + involved have distinct precedences. For example, should the + expression "1 - 2 - 3" be treated as either "(1 - 2) - 3" giving a + result of -4, or as "1 - (2 - 3)" giving a result of 2? + + This problem is solved by giving each operator a `grouping' + (sometimes called its associativity). An operator symbol (-) is + said to: + + o group to the left if "x - y - z" is treated as "(x - y) - z" + + o group to the right if "x - y - z" is treated as "x - (y - z)" + + A third possibility is that an expression of the form "x - y - z" + is to be treated as ambiguous and will be flagged as a syntax + error. In this case we say that the operator (-) is + non-associative. + + The standard approach in Gofer is to treat (-) as grouping to the + left so that "1 - 2 - 3" will actually be treated as "(1-2)-3". + +By default, every operator symbol in Gofer is treated as +non-associative with precedence 9. These values can be changed by a +declaration of one of the following forms: + + infixl digit ops to declare operators which group to the left + infixr digit ops to declare operators which group to the right + infix digit ops to declare non-associative operators + +In each of these declarations ops represents a list of one or more +operator symbols separated by commas and digit is an integer between 0 +and 9 which gives the precedence value for each of the listed operator +symbols. The precedence digit may be omitted in which case a value of +9 is assumed. There are a number of restrictions on the use of these +declarations: + + o Operator declarations can only appear in files of function + definitions which are loaded into Gofer; they cannot be entered + directly whilst using the Gofer interpreter. + + o At most one operator declaration is permitted for any particular + operator symbol (even if repeated declarations all specify the + same precedence and grouping as the original declaration). + + o Any file containing a declaration for an operator precedence and + grouping must also contain a (top-level) declaration for that + operator. + +In theory, it is possible to use an operator declaration at any point +in a file of definitions. In practice, it is sensible to ensure that +each operator is declared before the symbol is used. One way to +guarantee this is to place all operator declarations at the beginning +of the file [this condition is enforced in Haskell]. Note that until +an operator declaration for a particular symbol is encountered, any +occurrence of that symbol will be treated as a non-associative operator +with precedence 9. + +The following operator declarations are taken from the standard prelude: + + -- Operator precedence table + + infixl 9 !! + infixr 9 . + infixr 8 ^ + infixl 7 * + infix 7 /, `div`, `rem`, `mod` + infixl 6 +, - + infix 5 \\ + infixr 5 ++, : + infix 4 ==, /=, <, <=, >=, > + infix 4 `elem`, `notElem` + infixr 3 && + infixr 2 || + +and their use is illustrated by the following examples: + + Expression: Equivalent to: Reasons: + ----------- -------------- -------- + 1 + 2 - 3 (1 + 2) - 3 (+) and (-) have the same precedence + and group to the left. + x : ys ++ zs x : (ys ++ zs) (:) and (++) have the same precedence + and group to the right + x == y || z (x == y) || z (==) has higher precedence than (||). + 3 * 4 + 5 (3 * 4) + 5 (*) has higher precedence than (+). + y `elem` z:zs y `elem` (z:zs) (:) has higher precedence than elem. + 12 / 6 / 3 syntax error ambiguous use of (/); could mean + either (12/6)/3 or 12/(6/3). + +Note that function application always binds more tightly than any infix +operator symbol. For example, the expression "f x + g y" is equivalent +to "(f x) + (g y)". Another example which often causes problems is the +expression "f x + 1", which is treated as "(f x) + 1" and not as +"f (x+1)" as is sometimes expected. +.pa +.co-------------------------------------------------------------------| +.>ch07 +.ST 7. BUILT-IN TYPES + +An important part of Gofer is the type system which is used to detect +errors in expressions and function definitions. Starting with +primitive expressions such as numeric constants, Gofer assigns a type +to each expression that describes the kind of value represented by the +expression. + +In general we write object :: type to indicate that a particular +expression has the indicated type. For example: + + 42 :: Int indicating that 42 is an integer (Int is the + name for the type of integer values). + + fact :: Int -> Int indicating that "fact" is a function which + takes an integer argument and returns an + integer value (its factorial). + +The most important property of the type system is that it is possible +to determine the type of an expression without having to evaluate it. +For example, the information given above is sufficient to determine +that fact 42 :: Int without needing to calculate 42! first. + +Gofer has a wide range of built-in types, described in the following +sections. In addition, Gofer also includes facilities for defining new +types as well as types acting as abbreviations for complicated type +expressions as described in section 11. + + +.ST 7.1 Functions +-------------- +If t1 and t2 are types then t1 -> t2 is the type of a function which, +given an argument of type t1 produces a result of type t2. A function +of type t1 -> t2 is said to have argument type t1 and result type t2. + +In mathematics, the result of applying a function f to an argument x is +traditionally written as f(x). In many situations, these parentheses +are unnecessary and may be omitted when using Gofer. + +e.g. if f :: t1 -> t2 and x :: t1 then f x is the result of applying + f to x and has type t2. + + +If t1, t2, ..., tn are type expressions then: + + t1 -> t2 -> ... -> tn + +can be used as an abbreviation for the type: + + t1 -> (t2 -> ( ... -> tn) ...) + +In a similar way, an expression of the form f x1 x2 ... xn is simply an +abbreviation for the expression ( ... ((f x1) x2) ... xn). + +These two conventions allow us to deal with functions taking more than +one argument rather elegantly. For example, the type of the addition +function (+) is: + Int -> Int -> Int + +In other words, "(+)" is a function which takes an integer argument and +returns a value of type (Int -> Int). For example, "(+) 5" is the +function which takes an integer value n and returns the value of the +integer n plus 5. Hence "(+) 5 4", which is equivalent to "5 + 4", +evaluates to the integer 9 as expected. + + +.ST 7.2 Booleans +------------- +Represented by the type "Bool", there are two boolean values written as +"True" and "False". The standard prelude includes several useful +functions for manipulating boolean values: + + (&&), (||) :: Bool -> Bool -> Bool + + The value of the expression b && d is True if and only if both + b and d are True. If b is False then d is not evaluated. + + The value of the expression b || d is True if either of b or d + is True. If b is True then d is not evaluated. + + not :: Bool -> Bool + + The value of the expression not b is the opposite boolean value + to that of b; not True = False, not False = True. + +Gofer includes a special form of `conditional expression' which enables +an expression to select between two alternatives according to the value +of a boolean expression: + + if b then t else f + +is an expression which is equivalent to t if b evaluates to True, or to +f if b evaluates to False. Note that an expression of this form is +only acceptable if b is an expression of type Bool and if the types of +t and f are the same, in which case the whole expression also has that +type. + + +.ST 7.3 Integers +------------- +Represented by the type "Int", the integer type includes both positive +and negative integers such as -273, 0 and 383. Like many computer +systems, the range of integer values that can be used is restricted and +calculations using large positive or negative numbers may lead to +(undetected) overflow. + +A wide range of operators and functions are defined in the standard +prelude for use with integers: + + (+) addition. + (*) multiplication. + (-) subtraction. + (^) raise to power. + negate unary negation. An expression of the form "-x" is treated + as the expression "negate x". + (/) integer division. + div " " + rem remainder, related to integer division by the law: + (x `div` y)*y + (x `rem` y) == x + mod modulo, like remainder except that the modulo has the same + sign as the divisor. + odd returns True if argument is odd, False otherwise. + even returns True if argument is even, False otherwise. + gcd returns the greatest common divisor of its two arguments. + lcm returns the least common multiple of its two arguments. + abs returns the absolute value of its argument. + signum returns -1, 0 or 1 indicating that its argument is negative, + zero or positive respectively. + +The less familiar operators are illustrated by the following +identities: + + 3^4 == 81, 7 `div` 3 == 2, even 23 == False + 7 `rem` 3 == 1, -7 `rem` 3 == -1, 7 `rem` -3 == 1 + 7 `mod` 3 == 1, -7 `mod` 3 == 2, 7 `mod` -3 == -2 + gcd 32 12 == 4, abs (-2) == 2, signum 12 == 1 + + +.ST 7.4 Floating point numbers +--------------------------- +Represented by the type "Float", elements of this type can be used to +represent fractional values as well as very large or very small +quantities. Such values are however usually only accurate to a fixed +number of digits and rounding errors may occur in some calculations +making significant use of floating point quantities. A numeric value +in an input expression will only be treated as a floating point number +if it either includes a decimal point such as 3.14159, or if the number +is too large to be stored as a value of type Int. Scientific notation +may also be used to enter floating point quantities; for example 1.0e3 +is equivalent to 1000.0, whilst 5.0e-2 is equivalent to 0.05. + +[N.B. floating point numbers are not included in all implementations of +Gofer]. + + +.ST 7.5 Characters +--------------- +Represented by the type "Char", elements of this type represent +individual characters such as those entered at a keyboard. Character +values are written as single characters enclosed by apostrophe +characters: e.g. 'a', '0', 'Z'. Some special characters must be +entered using an `escape code'; each of these begins with a backslash +character '\', followed by one or more characters to select the +required character. Some of the most useful escape codes are: + + '\\' backslash + '\'' apostrophe + '\"' double quote + '\n' newline + '\b' or '\BS' backspace + '\DEL' delete + '\t' or '\HT' tab + '\a' or '\BEL' alarm (bell) + '\f' or '\FF' formfeed + +Additional escape characters include: + + '\^c' control character, where c is replaced by + one of the characters: + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" + For example, '\^A' represents control-A + + '\number' representing the character with ASCII value + specified by the given decimal 'number'. + + '\onumber' representing the character with ASCII value + specified by the given octal 'number'. + + '\xnumber' representing the character with ASCII value + specified by the given 'hexadecimal' number. + + '\name' named ASCII control character, where + `name' is replaced by one of the standard + ascii names e.g. `\DC3`. + +In contrast with some common languages (such as C, for example) +character values are quite distinct from integers; however the standard +prelude does include functions: + + ord :: Char -> Int + chr :: Int -> Char + +which enable you to map a character to its corresponding ASCII value, +or from an ASCII value to the corresponding character: + + ? ord 'a' + 97 + (2 reductions, 6 cells) + ? chr 65 + 'A' + (2 reductions, 7 cells) + ? + + +.ST 7.6 Lists +---------- +If a is a type then [a] is the type whose elements are lists of values +of type a. There are several ways of writing list expressions: + + o The simplest list of any type is the empty list, written []. + + o Non-empty lists can be constructed either by explicitly listing + the members of the list (for example: [1,3,10]) or by adding a + single element onto the front of another list using the (:) + operator (pronounced "cons"). These notations are equivalent: + + [1,3,10] = 1 : [3,10] = 1 : 3 : [10] = 1 : 3 : 10 : [] + + (the (:) operator groups to the right so 1 : 3 : 10 : [] is + equivalent to (1:(3:(10:[]))) -- a list whose first element is 1, + second element is 3 and last element is 10). + +The standard prelude includes a wide range of functions for +calculations involving lists. For example: + + o length xs returns the number of elements in the list xs. + o xs ++ ys returns the list of elements in xs followed by the + elements in ys + o concat xss returns the list of elements in each of the lists in + xss + o map f xs returns the list of values obtained by applying the + function f to each of the values in the list xs in turn. + +Here are some examples using these functions: + + ? length [1,3,10] + 3 + (15 reductions, 28 cells) + + ? [1,3,10] ++ [2,6,5,7] + [1, 3, 10, 2, 6, 5, 7] + (19 reductions, 77 cells) + + ? concat [[1], [2,3], [], [4,5,6]] + [1, 2, 3, 4, 5, 6] + (29 reductions, 93 cells) + + ? map ord ['H', 'e', 'l', 'l', 'o'] + [72, 101, 108, 108, 111] + (22 reductions, 73 cells) + + ? + +Note that all of the elements in a list must be of the same type, so +that an expression such as ['a', 2, False] is not permitted. + +[ASIDE: At this point it might be useful to mention an informal +convention that is used by a number of functional programmers when +choosing names for variables representing elements of lists, lists +themselves, lists of lists and so on. If for example, a typical +element of a list is called x, then it is often useful to use the name +xs for a list of such values, suggesting that a list contains a number +of "x"s. Similarly, a list of lists might be called xss. Once you +have understood this convention it is much easier to remember the +relationship between the variables in the expression (x:xs) than it +would be if different names had been used such as (a:b).] + + +.ST 7.7 Strings +------------ +A string is treated as a list of characters and the type String is +simply an abbreviation for the type [Char]. Strings are written as +sequences of characters enclosed between speech marks. All of the +escape codes that can be used for characters may also be used in a +string: + + ? "hello, world" + hello, world + (0 reductions, 13 cells) + + ? "hello\nworld" + hello + world + (0 reductions, 12 cells) + ? + +In addition, strings may contain the escape sequence "\&" which can be +used to separate otherwise ambiguous pairs of characters within a +string: + + e.g. "\123h" represents the string ['\123', 'h'] + "\12\&3h" represents the string ['\12', '3', 'h'] + +A string expression may be spread over a number of lines using a gap -- +a non-empty sequence of space, tab and new line characters enclosed by +backslash characters: + + ? "hell\ \o" + hello + (0 reductions, 6 cells) + ? + +Notice that strings are printed differently from other values, which +gives the programmer complete control over the format of the output +produced by a program. The only values that Gofer can in fact display +on the terminal are strings. If the type of an expression entered into +Gofer is equivalent to String then the expression is printed directly +by evaluating and printing each character in the list in sequence. +Otherwise, the expression to be evaluated, e, is replaced by the +expression show' e where show' is a built-in function (defined as part +of the standard prelude) which converts any value to a printable +representation. The only way of printing a string value in the same +way as any other value is by explicitly using the show' function: + + ? show' "hello" + "hello" + (7 reductions, 24 cells) + ? + +The careful reader may have been puzzled by the fact the number of +reductions used in the first three examples above was zero. This is in +fact quite correct since these expressions are constants and no further +evaluation can be carried out. For constant expressions of any other +type there will always be at least one reduction needed to print the +value since the constant must first be translated to a printable +representation using the show' function. + +Because strings are represented as lists of characters, all of the +standard prelude functions for manipulating lists can also be used with +strings: + + ? length "Hello" + 5 + (22 reductions, 36 cells) + + ? "Hello, " ++ "world" + Hello, world + (8 reductions, 37 cells) + + ? concat ["super","cali","fragi","listic"] + supercalifragilistic + (29 reductions, 101 cells) + + ? map ord "Hello" + [72, 101, 108, 108, 111] + (22 reductions, 69 cells) + + ? + + +.ST 7.8 Tuples and the unit type +----------------------------- +If t1, t2, ..., tn are types and n>=2, then there is a type of n-tuples +written (t1, t2, ..., tn) whose elements are also written in the form +(x1, x2, ..., xn) where the expressions x1, x2, ..., xn have types t1, +t2, ..., tn respectively. + + e.g. (1, [2], 3) :: (Int, [Int], Int) + ('a', False) :: (Char, Bool) + ((1,2),(3,4)) :: ((Int, Int), (Int, Int)) + +Note that, unlike lists, the elements in a tuple may have different +types, although the number of elements in the tuple is fixed. + +The unit type is written () and has a single element which is also +written as (). The unit type is of particular interest in theoretical +treatments of the type system of Gofer, although you may occasionally +find a use for it in practical programs. +.pa +.co-------------------------------------------------------------------| +.>ch08 +.ST 8. ERRORS + +.ST 8.1 Errors detected on input +----------------------------- +After an expression has been entered, but before any attempt is made to +evaluate it, Gofer carries out a number of checks to make sure that the +expression that you typed does not contain any errors. Here are some +examples of the kind of problem that might occur: + + o Syntax errors. The most common situation in which this happens is + when you make a typing mistake, either leaving out some + characters, or perhaps pressing the wrong keys instead. In the + following example, the user has missed out a `[' character: + + ? sum 1..100] + ERROR: Syntax error in input (unexpected `..') + ? + + o Undefined variables. This happens when you enter an expression + using a variable or function name that is not defined in any of + the files of definitions loaded into Gofer. This can often mean + that you have misspelt the name of a function, or that the files + defining a function have not yet been loaded. For example: + + ? sum [1..n] + ERROR: Undefined variable "n" + ? + + o Type errors. Certain expressions are sensible only when the + functions used in those expressions are applied to values of the + appropriate type. For example, whilst the factorial function can + be used to calculate the factorial of an integer, it is clearly + meaningless to try to determine the factorial of a character + value. This kind of problem can be detected using the types of + the components of an expression. In the expression "fact 'A'", we + can see that the argument 'A' has type Char which does not match + the argument type Int of the factorial function. This error will + be detected by Gofer if you try to evaluate the expression: + + ? fact 'A' + ERROR: Type error in application + *** expression : fact 'A' + *** term : 'A' + *** type : Char + *** does not match : Int + + ? + + +.ST 8.2 Errors during evaluation +----------------------------- +If no errors are detected in an input expression, Gofer then begins to +evaluate that expression. Despite all of the checks that are carried +out before the evaluation begins, it is still possible for an error to +occur during the evaluation of an expression. A typical example of +this is an attempt to divide a number by zero. In this case, Gofer +prints the part of the expression being evaluated that caused the +error, surrounded by braces `{' and `}': + + ? 3/0 + {primDivInt 3 0} + (4 reductions, 30 cells) + ? + +[The function "primDivInt" which appears here is a primitive function +used to divide one integer (its first argument) by another (the +second)]. If an error occurs in just one part of an expression, only +the part causing the problem will be displayed: + + ? 4 + (5/0) + {primDivInt 5 0} + (5 reductions, 32 cells) + ? + +A standard function called "error" is defined in the standard prelude +which is often useful for ensuring that appropriate error messages are +produced when an error occurs: + + ? error "Problem has occurred" + {error "Problem has occurred"} + (23 reductions, 99 cells) + ? +.pa +.co-------------------------------------------------------------------| +.>ch09 +.ST 9. MORE ABOUT VALUE DECLARATIONS + +.ST 9.1 Simple pattern matching +---------------------------- +Although the Gofer standard prelude includes many useful functions, you +will usually need to define a collection of new functions for specific +problems and calculations. The declaration of a function "f" usually +takes the form of a number of equations of the form: + + f ... = + +(or an equivalent expression, if "f" is written as by an operator +symbol). Each of the expressions , , ..., +represents an argument to the function "f" and is called a `pattern'. +The number of such arguments is called the arity of "f". If "f" is +defined by more than one equation then they must be entered together +and each one must give the same arity for "f". + +When a function is defined by more than one equation, it will usually +be necessary to evaluate one or more of the arguments to the function +to determine which equation applies. This process is called +`pattern-matching'. In all of the previous examples we have used only +the simplest kind of pattern -- a variable. As an example, consider +the factorial function defined in section 5: + + fact n = product [1..n] + +If we then wish to evaluate the expression "fact 6" we first match the +expression "6" against the pattern "n" and then evaluate the expression +obtained from "product [1..n]" by replacing the variable "n" with the +expression "6". The process of matching the arguments of a function +against the patterns in its definition and obtaining another expression +to be evaluated is called a `reduction'. Using Gofer, it is easy to +verify that the evaluation of "fact 6" takes one more reduction than +that of "product [1..6]": + + ? fact 6 + 720 + (57 reductions, 85 cells) + ? product [1..6] + 720 + (56 reductions, 85 cells) + ? + +Many kinds of constants such as the boolean values True and False can +also be used in patterns, as in the following definition of the +function "not" taken from the standard prelude: + + not True = False + not False = True + +In order to determine the value of an expression of the form "not b", +we must first evaluate the expression "b". If the result is "True" +then we use the first equation and the value of "not b" will be +"False". If the value of "b" is "False", then the second equation is +used and the value of "not b" will be "True". + +Other constants, including integers, characters and strings may also be +used in patterns. For example, if we define a function "hello" by: + + hello "Mark" = "Howdy" + hello name = "Hello " ++ name ++ ", nice to meet you!" + +then: + + ? hello "Mark" + Howdy + (1 reduction, 12 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? + +Note that the order in which the equations are written is very +important because Gofer always uses the first applicable equation. If +instead we had defined the function with the equations: + + hello name = "Hello " ++ name ++ ", nice to meet you!" + hello "Mark" = "Howdy" + +then the results obtained using this function would have been a little +different: + + ? hello "Mark" + Hello Mark, nice to meet you! + (13 reductions, 66 cells) + ? hello "Fred" + Hello Fred, nice to meet you! + (13 reductions, 66 cells) + ? + +There are a number of other useful kinds of pattern, some of which are +illustrated by the following examples: + + o Wildcard: _ matches any value at all; it is like a + variable pattern, except that there is no + way of referring to the matched value. + + o Tuples: (x,y) matches a pair whose first and second + elements are called x and y respectively. + + o Lists: [x] matches a list with precisely one element + called x. + [_,2,_] matches a list with precisely three + elements, the second of which is the + integer 2. + [] matches the empty list. + (x:xs) matches a non-empty list with head x and + tail xs. + + o As patterns: p@(x,y) matches a pair whose first and second + components are called x and y. The + complete pair can also be referred to + directly as p. + + o (n+k) patterns: (m+1) matches an integer value greater than or + equal to 1. The value referred to by the + variable m is one less than the value + matched. + +A further kind of pattern (called an irrefutable pattern) is introduced +in section 9.11. + +Note that no variable name can be used more than once on the left hand +side of each equation in a function definition. The following example: + + areTheyTheSame x x = True + areTheyTheSame _ _ = False + +will not be accepted by the Gofer system, but should instead be defined +using the notation of guards introduced in the next section: + + areTheyTheSame x y + | x==y = True + | otherwise = False + + +.ST 9.2 Guarded equations +---------------------- +Each of the equations in a function definition may contain `guards' +which require certain conditions on the values of the function's +arguments to be met. As an example, here is a function which uses the +standard prelude function even :: Int -> Bool to determine whether its +argument is an even integer or not, and returns the string "even" or +"odd" as appropriate: + + oddity n | even n = "even" + | otherwise = "odd" + +In general, an equation using guards takes the form: + + f x1 x2 ... xn | condition1 = e1 + | condition2 = e2 + . + . + | conditionm = em + +This equation is used by evaluating each of the conditions in turn +until one of them evaluates to "True", in which case the value of the +function is given by the corresponding expression e on the right hand +side of the `=' sign. In Gofer, the variable "otherwise" is defined to +be equal to "True", so that writing "otherwise" as the condition in a +guard means that the corresponding expression will always be used if no +previous guard has been satisfied. + +[ASIDE: in the notation of [1], the above examples would be written as: + + oddity n = "even", if even n + = "odd", otherwise + + f x1 x2 ... xn = e1, if condition1 + = e2, if condition2 + . + . + = em, if conditionm + +Translation between the two notations is relatively straightforward.] + + +.ST 9.3 Local definitions +---------------------- +Function definitions may include local definitions for variables which +can be used both in guards and on the right hand side of an equation. +Consider the following function which calculates the number of distinct +real roots for a quadratic equation of the form a*x*x + b*x + c = 0: + + numberOfRoots a b c | discr>0 = 2 + | discr==0 = 1 + | discr<0 = 0 + where discr = b*b - 4*a*c + +[ASIDE: The operator (==) is used to test whether two values are equal +or not. You should take care not to confuse this with the single `=' +sign used in function definitions]. + +Local definitions can also be introduced at an arbitrary point in an +expression using an expression of the form: + + let in + +For example: + + ? let x = 1 + 4 in x*x + 3*x + 1 + 41 + (8 reductions, 15 cells) + ? let p x = x*x + 3*x + 1 in p (1 + 4) + 41 + (7 reductions, 15 cells) + ? + + +.ST 9.4 Recursion with integers +---------------------------- +Recursion is a particularly important and powerful technique in +functional programming which is useful for defining functions involving +a wide range of datatypes. In this section, we describe one particular +application of recursion to give an alternative definition for the +factorial function from section 5. + +Suppose that we wish to calculate the factorial of a given integer n. +We can split the problem up into two special cases: + + o If n is zero then the value of n! is 1. + + o Otherwise, n! = 1 * 2 * ... * (n-1) * n = (n-1)! * n and so we + can calculate the value of n! by calculating the value of (n-1)! + and then multiplying it by n. + +This process can be expressed directly in Gofer using a conditional +expression: + + fact1 n = if n==0 then 1 else n * fact1 (n-1) + +This definition may seem rather circular; in order to calculate the +value of n!, we must first calculate (n-1)!, and unless n is 1, this +requires the calculation of (n-2)! etc... However, if we start with +some positive value for the variable n, then we will eventually reach +the case where the value of 0! is required -- and this does not require +any further calculation. The following diagram illustrates how 6! is +evaluated using "fact1": + + fact1 6 ==> 6 * fact1 5 + ==> 6 * (5 * fact1 4) + ==> 6 * (5 * (4 * fact1 3)) + ==> 6 * (5 * (4 * (3 * fact1 2))) + ==> 6 * (5 * (4 * (3 * (2 * fact1 1)))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * fact1 0))))) + ==> 6 * (5 * (4 * (3 * (2 * (1 * 1))))) + ==> 6 * (5 * (4 * (3 * (2 * 1)))) + ==> 6 * (5 * (4 * (3 * 2))) + ==> 6 * (5 * (4 * 6)) + ==> 6 * (5 * 24) + ==> 6 * 120 + ==> 720 + +Incidentally, there are several other ways of writing the recursive +definition of "fact1" above in Gofer. For example, using guards: + + fact2 n + | n==0 = 1 + | otherwise = n * fact2 (n-1) + +or using pattern matching with an integer constant: + + fact3 0 = 1 + fact3 n = n * fact3 (n-1) + +Which of these you use is largely a matter of personal taste. + +Yet another style of definition uses the (n+k) patterns mentioned in +section 9.1: + + fact4 0 = 1 + fact4 (n+1) = (n+1) * fact4 n + +which is equivalent to: + + fact5 n | n==0 = 1 + | n>=1 = n * fact5 (n-1) + +[COMMENT: Although each of the above definitions gives the same result +as the original "fact" function for each non-negative integer, the +functions can still be distinguished by the values obtained when they +are applied to negative integers: + + o "fact (-1)" evaluates to the integer 1. + o "fact1 (-1)" causes Gofer to enter an infinite loop, which is only + eventually terminated when Gofer runs out of `stack space'. + o "fact4 (-1)" causes an evaluation error and prints the + message {fact4 (-1)} on the screen. + +To most people, this suggests that the definition of "fact4" is perhaps +preferable to that of either "fact" or "fact1" as it neither gives the +wrong answer without allowing this to be detected nor causes a +potentially non-terminating computation.] + + +.ST 9.5 Recursion with lists +------------------------- +The same kind of technique that can be used to define recursive +functions with integers can also be used to define recursive functions +on lists. As an example, suppose that we wish to define a function to +calculate the length of a list. As the standard prelude already +includes such a function called "length", we will call the function +developed here "len" to avoid any conflict. Now suppose that we wish +to find the length of a given list. There are two cases to consider: + + o If the list is empty then it has length 0 + + o Otherwise, it is non-empty and can be written in the form (x:xs) + for some element x and some list xs. Thus the original list is + one element longer than xs, and so has length 1 + len xs. + +Writing these two cases out leads directly to the following definition: + + len [] = 0 + len (x:xs) = 1 + len xs + +The following diagram illustrates the way that this function can be +used to determine the length of the list [1,2,3,4] (remember that this +is just an abbreviation for 1 : 2 : 3 : 4 : []): + + len [1,2,3,4] ==> 1 + len [2,3,4] + ==> 1 + (1 + len [3,4]) + ==> 1 + (1 + (1 + len [4])) + ==> 1 + (1 + (1 + (1 + len []))) + ==> 1 + (1 + (1 + (1 + 0))) + ==> 1 + (1 + (1 + 1)) + ==> 1 + (1 + 2) + ==> 1 + 3 + ==> 4 + +As further examples, you might like to look at the following +definitions which use similar ideas to define the functions product and +map introduced in earlier sections: + + product [] = 1 + product (x:xs) = x * product xs + + map f [] = [] + map f (x:xs) = f x : map f xs + + +.ST 9.6 Lazy evaluation +-------------------- +Gofer evaluates expressions using a technique sometimes described as +`lazy evaluation' which means that: + + o No expression is evaluated until its value is needed. + + o No shared expression is evaluated more than once; if the + expression is ever evaluated then the result is shared between all + those places in which it is used. + +The first of these ideas is illustrated by the following function: + + ignoreArgument x = "I didn't need to evaluate x" + +Since the result of the function "ignoreArgument" doesn't depend on the +value of its argument "x", that argument will not be evaluated: + + ? ignoreArgument (1/0) + I didn't need to evaluate x + (1 reduction, 31 cells) + ? + +In some situations, it is useful to be able to force Gofer to evaluate +the argument to a function before the function is applied. This can be +achieved using the function "strict" defined in the standard prelude; +An expression of the form "strict f x" is evaluated by first evaluating +the argument "x" and then applying the function "f" to the result: + + ? strict ignoreArgument (1/0) + {primDivInt 1 0} + (4 reductions, 29 cells) + ? + +The second basic idea behind lazy evaluation is that no shared +expression should be evaluated more than once. For example, the +following two expressions can be used to calculate 3*3*3*3: + + ? square * square where square = 3 * 3 + 81 + (3 reductions, 9 cells) + ? (3 * 3) * (3 * 3) + 81 + (4 reductions, 11 cells) + ? + +Notice that the first expression requires one less reduction than the +second. Excluding the single reduction step needed to convert each +integer into a string, the sequences of reductions that will be used in +each case are as follows: + +.cc 5 + square * square where square = 3 * 3 + -- calculate the value of square by reducing 3 * 3 ==> 9 + -- and replace each occurrence of square with this result + ==> 9 * 9 + ==> 81 + + (3 * 3) * (3 * 3) -- evaluate first (3 * 3) + ==> 9 * (3 * 3) -- evaluate second (3 * 3) + ==> 9 * 9 + ==> + +Lazy evaluation is a very powerful feature of programming in a language +like Gofer, and means that only the minimum amount of calculation is +used to determine the result of an expression. The following example +is often used to illustrate this point. + +Consider the task of finding the smallest element of a list of +integers. The standard prelude includes a function "minimum" which can +be used for this very purpose: + + ? minimum [100,99..1] + 1 + (809 reductions, 1322 cells) + ? + +(The expression [100,99..1] denotes the list of integers from 1 to 100 +arranged in decreasing order, as described in section 10.1). + +A rather different approach involves sorting the elements of the list +into increasing order (using the function "sort" defined in the +standard prelude) and then take the element at the head of the +resulting list (using the standard function "head"). Of course, +sorting the list in its entirety is likely to require significantly +more work than the previous approach: + + ? sort [100,99..1] + [1, 2, 3, 4, 5, 6, 7, 8, ... etc ..., 99, 100] + (10712 reductions, 21519 cells) + ? + +However, thanks to lazy-evaluation, calculating just the first element +of the sorted list actually requires less work in this particular case +than the first solution using "minimum": + + ? head (sort [100,99..1]) + 1 + (713 reductions, 1227 cells) + ? + +Incidentally, it is probably worth pointing out that this example +depends rather heavily on the particular algorithm used to "sort" a +list of elements. The results are rather different if we compare the +same two approaches used to calculate the maximum value in the list: + + ? maximum [100,99..1] + 100 + (812 reductions, 1225 cells) + ? last (sort [100,99..1]) + 100 + (10612 reductions, 20732 cells) + ? + +This difference is caused by the fact that each element in the list +produced by "sort" is only known once the values of all of the +preceding elements are also known. Thus the complete list must be +sorted in order to obtain the last element. + + +.ST 9.7 Infinite data structures +----------------------------- +One particular benefit of lazy evaluation is that it makes it possible +for functions in Gofer to manipulate `infinite' data structures. +Obviously we cannot hope either to construct or store an infinite +object in its entirety -- the advantage of lazy evaluation is that it +allows us to construct infinite objects piece by piece as necessary +(and to reuse the storage space used by parts of the object when they +are no longer required). + +As a simple example, consider the following function which can be used +to produce infinite lists of integer values: + + countFrom n = n : countFrom (n+1) + +If we evaluate the expression "countFrom 1", Gofer just prints the list +of integer values beginning with 1 until it is interrupted. Once each +element in the list has been printed, the storage used to hold that +element can be reused to hold later elements in the list. Evaluating +this expression is equivalent to using an `infinite' loop to print the +list of integers in an imperative programming language: + + ? countFrom 1 + [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,^C{Interrupted!} + (53 reductions, 160 cells) + ? + +For practical applications, we are usually only interested in using a +finite portion of an infinite data structure (just as loops in an +imperative programming language are usually terminated after finitely +many iterations). For example, using "countFrom" together with the +function "take" defined in the standard prelude, we can repeat the +calculation from section 4 to find the sum of the integers 1 to 10: + + ? sum (take 10 (countFrom 1)) + 55 + (62 reductions, 119 cells) + ? + +[ASIDE: The expression "take n xs" evaluates to a list containing the +first n elements of the list xs (or to xs itself if the list contains +fewer than n elements). Thus "countFrom 1" generates the infinite list +of integers, "take 10" ensures that only the first ten elements are +calculated, and "sum" calculates the sum of those integers as before.] + +A particular advantage of using infinite data structures is that it +enables us to describe an object without being tied to one particular +application of that object. Consider the following definition for the +infinite list of powers of two [1, 2, 4, 8, ...]: + + powersOfTwo = 1 : map double powersOfTwo + where double n = 2*n + +This list be used in a variety of ways; using the operator (!!) defined +in the standard prelude [xs!!n evaluates to the nth element of the list +xs], we can define a function to find the nth power of 2 for any given +integer n: + + twoToThe n = powersOfTwo !! n + +Alternatively, we can use the list "powersOfTwo" to define a function +mapping lists of bits (represented by integers 0 and 1) to the +corresponding decimal number: simply reverse the order of the digits, +multiply each by the corresponding power of two and calculate the sum. +Using functions from the standard prelude, this translates directly +into the definition: + + binToDec ds = sum (zipWith (*) (reverse ds) powersOfTwo) + +For example: + + ? twoToThe 12 + 4096 + (15 reductions, 21 cells) + ? binToDec [1,0,1,1,0] + 22 + (40 reductions, 85 cells) + ? + +.ST 9.8 Polymorphism +----------------- +Given the definition of "product" in section 9.5, it is easy to see +that product takes a single argument which is a list of integers and +returns a single integer value -- the product of the elements of the +list. In other words, "product" has type [Int] -> Int. On the other +hand, it is not immediately clear what the type of the function "map" +should be. Clearly the first argument of "map" must be a function and +both the second argument and the result are lists, so that the type of +"map" must be of the form: + + (a -> b) -> [c] -> [d] + \______/ \___/ \___/ + type of 1st type of 2nd type of result + argument "f" argument "xs" "map f xs" + +But what can be said about the types a, b, c and d? One possibility +would be to choose a = b = c = d = Int which would be acceptable for +expressions such as "map fact [1,2,3,4]", but this would not be +suitable in an expression such as "map chr [65,75,32]" because the +"chr" function does not have type Int -> Int. + +Notice however that the argument type of "f" must be the same as the +type of elements in the second argument (i.e. a = c) since "f" is +applied to each element in that list. Similarly, the result type of +"f" must be the same as the type of elements in the result list (i.e. b += d) since each element in this list is obtained as a result of +applying the function "f" to some value. It is therefore reasonable to +treat the "map" function as having any type of the form: + + (a -> b) -> [a] -> [b] + +The letters "a" and "b" used in this type expression represent +arbitrary types and are called type variables. An object whose type +includes one or more type variables can be thought of as having many +different types and is often described as having a `polymorphic type' +(literally: its type has `many shapes'). + +The ability to define and use polymorphic functions in Gofer turns out +to be very useful. Here are the types of some of the other polymorphic +functions which have been used in previous examples which illustrate +this point: + + length :: [a] -> Int + (++) :: [a] -> [a] -> [a] + concat :: [[a]] -> [a] + +Thus we can use precisely the same "length" function to determine both +the length of a list of integers as well as finding the length of a +string: + + ? length [1..10] + 10 + (98 reductions, 138 cells) + ? length "Hello" + 5 + (22 reductions, 36 cells) + ? + + +.ST 9.9 Higher-order functions +--------------------------- +In Gofer, function values are treated in much the same way as any other +kind of value; in particular, they can be used both as arguments to, +and results of other functions. + +.cc 5 +Functions which manipulate other functions in this way are often +described as `higher-order functions'. Consider the following example, +taken from the standard prelude: + + (.) :: (b -> c) -> (a -> b) -> (a -> c) + (f . g) x = f (g x) + +As indicated by the type declaration, we think of the (.) operator as a +function taking two function arguments and returning another function +value as its result. If f and g are functions of the appropriate +types, then (f . g) is a function called the composition of f with g. +Applying (f . g) to a value is equivalent to applying g to that value, +and then applying f to the result [As described, far more eloquently, +by the second line of the declaration above!]. + +Many problems can often be described very elegantly as a composition of +other functions. Consider the problem of calculating the total number +of characters used in a list of strings. A simple recursive function +provides one solution: + + countChars [] = 0 + countChars (w:ws) = length w + countChars ws + + ? countChars ["super","cali","fragi","listic"] + 20 + (96 reductions, 152 cells) + ? + +An alternative approach is to notice that we can calculate the total +number of characters by first combining all of the words in the +argument list into a single word (using concat) and then finding the +length of that word: + + ? (length . concat) ["super","cali","fragi","listic"] + 20 + (113 reductions, 211 cells) + ? + +Another solution is to first find the length of each word in the list +(using the "map" function to apply "length" to each word) and then +calculate the sum of these individual lengths: + + ? (sum . map length) ["super","cali","fragi","listic"] + 20 + (105 reductions, 172 cells) + ? + + +.ST 9.10 Variable declarations +-------------------------- +A variable declaration is a special form of function definition, +almost always consisting of a single equation of the form: + + var = rhs + +(i.e. a function declaration of arity 0). Whereas the values defined +by function declarations of arity>0 are guaranteed to be functions, the +values defined by variable declarations may or may not be functions: + + odd = not . even -- if an integer is not even then it must be odd + val = sum [1..100] + +Note that variables defined like this at the top level of a file of +definitions will be evaluated using lazy evaluation. The first time we +refer to the variable "val" defined above (either directly or +indirectly), Gofer evaluates the sum of the integers from 1 to 100 and +overwrites the definition of "val" with this number. This calculation +can then be avoided for each subsequent use of "val" (unless the file +containing the definition of "val" is reloaded). + + ? val + 5050 + (809 reductions, 1120 cells) + + ? val + 5050 + (1 reduction, 7 cells) + + ? + +Because of this behaviour, we should probably try to avoid using +variable declarations where the resulting value will require a lot of +storage space. If we load a file of definitions including the line: + + longList = [1..10000] + +and then evaluate the expression "length longList" (eventually +obtaining the expected result of 10000), then Gofer will evaluate the +definition of "longList" and replace it with the complete list of +integers from 1 upto 10000. Unlike other memory used during a +calculation, it will not be possible to reuse this space for other +calculations without reloading the file defining "longList", or loading +other files instead. + + +.ST 9.11 Pattern bindings and irrefutable patterns +---------------------------------------------- +Another useful way of defining variables uses `pattern bindings' which +are equations of the form: + + pat = rhs + +where the expression on the left hand side is a pattern as described in +section 9.1. As a simple example of pattern bindings, here is one +possible definition for the function "head" which returns the first +element in a list of values: + + head xs = x where (x:ys) = xs + +[The definition "head (x:_) = x" used in the standard prelude is +slightly more efficient, but otherwise equivalent.] + +[ASIDE: Note that pattern bindings are treated quite differently from +function bindings (of which the variable declarations described in the +last section are a special case). There are two situations in which an +ambiguity may occur; i.e. if the left hand side of an equation is a +simple variable or an (n+k) pattern of the kind described in section +9.1. In both cases, these are treated as function bindings, the former +being a variable declaration whilst the latter will be treated as a +definition for the operator symbol (+).] + +Pattern bindings are often useful for defining functions which we might +think of as `returning more than one value' -- although they are +actually packaged up in a single value such as a tuple. As an example, +consider the function "span" defined in the standard prelude. + + span :: (a -> Bool) -> [a] -> ([a],[a]) + +If xs is a list of values and p is a predicate, then span p xs returns +the pair of lists (ys,zs) such that ys++zs == xs, all of the elements +in ys satisfy the predicate p and the first element of zs does not +satisfy p. A suitable definition, using a pattern binding to obtain +the two lists resulting from the recursive call to "span" is as +follows: + + span p [] = ([],[]) + span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) + + +For consistency with the lazy evaluation strategy used in Gofer, the +right hand side of a pattern binding is not evaluated until the value +of one of the variables bound by that pattern is required. The +definition: + + (0:xs) = [1,2,3] + +will not cause any errors when it is loaded into Gofer, but will cause +an error if we attempt to evaluate the variable xs: + + ? xs + {v120 [1, 2, 3]} + (11 reductions, 46 cells) + ? + +The variable name "v120" appearing in this expression is the name of a +function called a `conformality check' which is defined automatically +by Gofer to ensure that the value on the right hand side of the pattern +binding conforms with the pattern on the left. + +Compare this with the behaviour of pattern matching in function +definitions such as: + + ? example [1] where example (0:xs) = "Hello" + {v126 [1]} + (4 reductions, 22 cells) + ? + +where the equivalent of the conformality check is carried out +immediately even if none of the values of the variables in the pattern +are actually required. The reason for this difference is that the +arguments supplied to a function must be evaluated to determine which +equation in the definition of the function should be used. The error +produced by the example above was caused by the fact that the argument +[1] does not match the pattern used in the equation defining "example" +(represented by an internal Gofer function called "v126"). + +A different kind of behaviour can be obtained using a pattern of the +form ~pat, known as an irrefutable (or lazy) pattern. This pattern can +initially be matched against any value, delaying the check that this +value does indeed match pat until the value of one of the variables +appearing in it is required. The basic idea (together with the method +used to implement irrefutable patterns in Gofer) is illustrated by the +identity: + + f ~pat = rhs is equivalent to f v = rhs where pat=v + +The following examples, based very closely on those given in the +Haskell report [5], illustrate the use of irrefutable patterns. The +variable "undefined" used in these examples is included in the standard +prelude and causes a run-time error each time it is evaluated +(technically speaking, it represents the bottom element of the relevant +semantic domain, and is the only value having all possible types): + + (\ (x,y) -> 0) undefined = {undefined} + (\~(x,y) -> 0) undefined = 0 + + (\ [x] -> 0) [] = {v113 []} + (\~[x] -> 0) [] = 0 + + (\~[x, (a,b)] -> x) [(0,1),undefined] = {undefined} + (\~[x,~(a,b)] -> x) [(0,1),undefined] = (0,1) + + (\ (x:xs) -> x:x:xs) undefined = {undefined} + (\~(x:xs) -> x:x:xs) undefined = {undefined}:{undefined}:{undefined} + +Irrefutable patterns are not used very frequently, although they are +particularly convenient in some situations (see section 12 for some +examples). Be careful not to use irrefutable patterns where they are +not appropriate. An attempt to define a map function "map'" using: + + map' f ~(x:xs) = f x : map' f xs + map' f [] = [] + +turns out to be equivalent to the definition: + + map' f ys = f x : map f xs where (x:xs) = ys + +and will not behave as you might have intended: + + ? map' ord "abc" + [97, 98, 99, {v124 []}, {v124 []}, {v^C{Interrupted!} + (35 reductions, 159 cells) + ? + + +.ST 9.12 Type declarations +----------------------- +The type system used in Gofer is sufficiently powerful to enable Gofer +to determine the type of any function without the need to declare the +types of its arguments and the return value as in some programming +languages. Despite this, Gofer allows the use of type declarations of +the form: + + var1, ..., varn :: type + +which enable the programmer to declare the intended types of the +variables var1, ..., varn defined in either function or pattern +bindings. There are a number of benefits of including type +declarations of this kind in a program: + + o Documentation: The type of a function often provides useful + information about the way in which a function is to be used -- + including the number and order of its arguments. + + o Restriction: In some situations, the type of a function inferred + by Gofer is more general than is required. As an example, + consider the following function, intended to act as the identity + on integer values: + + idInt x = x + + Without an explicit type declaration, Gofer treats "idInt" as a + polymorphic function of type a -> a and the expression "idInt 'A'" + does not cause a type error. This problem can be solved by using + an explicit type declaration to restrict the type of "idInt" to a + particular instance of the polymorphic type a -> a: + + idInt :: Int -> Int + + Note that a declaration such as: + + idInt :: Int -> a + + is not a valid type for the function "idInt" (the value of the + expression "idInt 42" is an integer and cannot be treated as + having an arbitrary type, depending on the value of the type + variable "a"), and hence will not be accepted by Gofer. + + o Consistency check: As illustrated above, declared types are always + checked against the definition of a value to make sure that they + are compatible. Thus Gofer can be used to check that the + programmer's intentions (as described by the types assigned to + variables in type declarations) are consistent with the + definitions of those values. + + o Overloading: Explicit type declarations can be used to solve a + number of problems associated with overloaded functions and + values. See section 14 for further details. +.pa +.co-------------------------------------------------------------------| +.>ch10 +.ST 10. INCREASING YOUR POWER OF EXPRESSION + +This section describes a number of useful extensions to the basic range +of expressions used in the previous sections. None of these add any +extra computational power to Gofer -- anything that can be done with +these constructs could also be done with the constructs already +described. They are however included in Gofer because they allow many +expressions and function definitions to be written more clearly and +concisely than the equivalent expressions without these notations. + +.ST 10.1 Arithmetic sequences +------------------------- +A number of useful lists can be generated using the notation of +arithmetic sequences (so named because of their similarity to +arithmetic progressions in mathematics). The following list summarises +the four forms of sequence expression that can be used in Gofer, +together with their translation using the standard functions enumFrom, +enumFromTo, enumFromThen and enumFromThenTo: + + [ n .. ] enumFrom n + + Produces the (potentially infinite) list of values + starting with the value of n and increasing in + single steps. + + e.g. [1..] = [1, 2, 3, 4, 5, 6, 7, 8, 9, etc... + + [ n .. m ] enumFromTo n m + + Produces the list of elements from n upto and + including m in single steps. If m is less than n + then the list is empty. + + e.g. [-3..3] = [-3, -2, -1, 0, 1, 2, 3] + [1..1] = [1] + [9..0] = [] + + [ n, m .. ] enumFromThen n m + + Produces the (potentially infinite) list of values + whose first two elements are given by the values n + and m. If m is greater than n then the following + elements of the list are increasing in steps of + the same size. A similar result is obtained if m + is less than n in which case the elements of + [n,m..] will be decreasing. If n and m are equal + then [n,m..] is an infinite list in which each + element is equal to n. + + e.g. [1,3..] = [1, 3, 5, 7, 9, 11, 13, etc... + [0,0..] = [0, 0, 0, 0, 0, 0, 0, etc... + [5,4..] = [5, 4, 3, 2, 1, 0, -1, etc... + + [ n, n' .. m ] enumFromThenTo n n' m + + Produces the list of elements from [n,n'..] upto + the limit value m. If m is less than n and + [n,n'..] is increasing, or m is greater than n and + [n,n'..] is decreasing the resulting list will be + empty. + + e.g. [1,3..12] = [1, 3, 5, 7, 9, 11] + [0,0..10] = [0, 0, 0, 0, 0, 0, 0, etc... + [5,4..1] = [5, 4, 3, 2, 1] + +In the standard prelude, the functions enumFrom, enumFromTo, +enumFromThen and enumFromThenTo are overloaded and may also be used to +enumerate lists of characters or floating point values: + + ? ['0'..'9'] ++ ['A'..'Z'] + 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ + (397 reductions, 542 cells) + + ? [1.2, 1.35 .. 2.00] + [1.2, 1.35, 1.5, 1.65, 1.8, 1.95] + (56 reductions, 133 cells) + + ? + +Arithmetic sequences such as those described above play the same role +in functional programming languages as the iterative `for' constructs +in traditional imperative languages. A good example of this is the +example in section 4 used to calculate the sum of the integers from 1 +upto 10 -- "sum [1..10]". An equivalent program in an imperative +language might look something like (especially if you think of C!): + + int i; + int total=0; + for (i=1; i<=10; i++) + total = total + i; + return total; + +The advantages of the functional notation in this case are clear: + + o It is more compact. + + o It separates the task of generating the sequence of integers + [1..10] from the task of finding their sum. + + o It does not require the declaration or use of auxiliary variables + such as "i" and "total" in the above. + + +.ST 10.2 List comprehensions +------------------------- +List comprehensions provide another very powerful and compact notation +for describing certain kinds of list expression. The basic form of a +list comprehension is: + + [ | ] + +There are three kinds of qualifier that can be used in Gofer: + + o Generators: A qualifier of the form pat<-exp is used to extract + each element that matches the pattern pat from the list exp in the + order that they elements appear in that list. A simple example of + this is the expression [x*x | x<-[1..10]] which denotes the list + of the squares of the integers between 1 and 10 inclusive and + evaluates to [1, 4, 9, 16, 25, 36, 49, 64, 81, 100] as expected. + + Formally, we can define the meaning of a list comprehension with a + single generator by the equation: + + [ e | pat <- exp ] = loop exp + where loop [] = [] + loop (pat:xs) = e : loop xs + loop (_:xs) = loop xs + + If pat is an irrefutable pattern (for example, a variable) then + this is equivalent to: + + [ e | pat <- exp ] = map f exp + where f pat = e + + The full definition is needed for those cases where the pattern + pat may not match all of the elements in the list exp. This is + the case in expressions such as [ y | (3,y)<-[(1,2),(3,4),(5,6)] ] + which evaluates to the singleton list [4]. + + o Filters: A boolean valued expression may also be used as a + qualifier in which case it is often called a filter. We can + define the meaning of a list comprehension with a single filter by + the equation: + + [ e | condition ] = if condition then [e] else [] + + Whilst this form of list comprehension is occasionally useful as + it stands, it is more common to use filters in conjunction with + generators as described below. + + o Local definitions: A qualifier of the form pat=expr can be used to + introduce a local definition within a list comprehension. Its + meaning can be defined formally using the equation: + + [ e | pat = exp ] = [ let pat=exp in e ] + + As in the case of filters, local definitions are more commonly + used within lists of more than one qualifier as described below. + Particular care should be taken to distinguish a filter of the + form pat==expr from a local definition of the form pat=expr. + + [ASIDE: I originally suggested this form of qualifier in a message + sent to the Haskell mailing list, only to discover that a similar + (and more comprehensive) suggestion had been made by Kevin Hammond + almost a year earlier. There was a certain amount of controversy + surrounding the choice of an appropriate syntax and semantics for + the construct and consequently, this feature is not currently part + of the Haskell standard. The syntax and semantics above is + implemented by Gofer in the hope that it will give functional + programmers an opportunity to experiment with this facility in + their own programs.] + +The real power of this notation is that it is possible to use several +qualifiers, separated by commas on the right of the vertical bar `|' +symbol in a list comprehension. Formally, if qs1 and qs2 are two such +lists of qualifiers, then we can define the meaning of multiple +qualifiers using: + + [ e | qs1, qs2 ] = concat [ [ e | qs2 ] | qs1 ] + +The following examples illustrate how this definition works in +practice: + + o Variables generated by later qualifiers vary more quickly than + those generated by earlier qualifiers: + + ? [ (x,y) | x<-[1..3], y<-[1..2] ] + [(1,1), (1,2), (2,1), (2,2), (3,1), (3,2)] + (107 reductions, 246 cells) + ? + + o Later qualifiers may use the values generated by earlier ones: + + ? [ (x,y) | x<-[1..3], y<-[1..x]] + [(1,1), (2,1), (2,2), (3,1), (3,2), (3,3)] + (107 reductions, 246 cells) + + ? [ x | x<-[1..10], even x ] + [2, 4, 6, 8, 10] + (108 reductions, 171 cells) + ? + + o Variables defined in later qualifiers hide those introduced by + earlier ones. The following expressions are valid list + comprehensions, but this style of definition in which names are + reused can result in programs which are difficult to understand, + and is not recommended: + + ? [ x | x<-[[1,2],[3,4]], x<-x ] + [1, 2, 3, 4] + (18 reductions, 53 cells) + + ? [ x | x<-[1,2], x<-[3,4] ] + [3, 4, 3, 4] + (18 reductions, 53 cells) + ? + + o Changing the order of qualifiers has a direct effect on + efficiency. The following two examples produce the same result, + but the first uses more reductions and cells because it repeats + the evaluation of "even x" for each possible value of "y". + + ? [ (x,y) | x<-[1..3], y<-[1..2], even x ] + [(2,1), (2,2)] + (110 reductions, 186 cells) + + ? [ (x,y) | x<-[1..3], even x, y<-[1..2] ] + [(2,1), (2,2)] + (62 reductions, 118 cells) + ? + + The following example illustrates a similar kind of behaviour with + local definitions; in the first case the expression "fact x" is + evaluated twice for each possible value of "x", whilst the second + expression uses a local definition to ensure that the evaluation + is not repeated: + + ? [ fact x + y | x<-[1..3], y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (246 reductions, 398 cells) + + ? [ factx + y | x<-[1..3], factx = fact x, y<-[1..2] ] + [2, 3, 3, 4, 7, 8] + (173 reductions, 294 cells) + ? + + +.ST 10.3 Lambda expressions +------------------------ +In addition to named function definitions, Gofer also allows the +definition and use of unnamed functions using a `lambda expression' of +the form: + + \ -> + +[ASIDE: This is a slight generalisation of the form of lambda +expression used in most theoretical treatments of functional +programming and dating back to the pioneering work of logicians +including Alonzo Church and Haskell Curry, from whom the programming +language takes its name. The `\' character used at the beginning of a +Gofer lambda expression has been chosen for its resemblance to the +greek letter lambda that might be used if the standard character set +were a little larger.] + +This expression denotes a function taking a number of parameters (one +for each pattern) and producing the result specified by the expression +to the right of the -> symbol. For example, (\x->x*x) represents the +function which takes a single integer argument `x' and produces the +square of that number as its result. Another example is the lambda +expression (\x y->x+y) which takes two integer arguments and outputs +their sum; this expression is in fact equivalent to the (+) operator: + + ? (\x y->x+y) 2 3 + 5 + (3 reductions, 7 cells) + ? + +A lambda expression of the form illustrated above is equivalent to the +following expression using a local definition: + + (let newName = in newName) + +where "newName" is a new variable name, chosen to avoid conflicts with +other variables that are already in use. This name will be printed if +you enter an expression involving a lambda expression without supplying +the full number of parameters for that function: + + ? (\x y -> x+y) 42 + v117 42 + (2 reductions, 14 cells) + ? + +Lambda expressions are particularly useful for certain styles of +functional programming; an example of this is the continuation-based +approach to I/O described in section 12. + + +.ST 10.4 Case expressions +--------------------- +A case expression can be used to evaluate an expression and, depending +on the result, return one of a number of possible values. As such, +case statements are a straightforward generalisation of conditional +expressions. Indeed, an expression of the form "if e then t else f" is +in fact equivalent to the case expression: + + case e of + True -> t + False -> f + +In general, a case expression takes the form "case exp of alts" where +exp is the expression to be evaluated and alts is a list of +alternatives, each of which is of the form: + + pat -> rhs for a simple alternative + + or: pat | condition1 -> rhs1 using guard expressions as + | condition2 -> rhs2 described in section 9.2 for + . function definitions + . + | conditionn -> rhsn + +In Gofer, a case expression of the form case e of alts is implemented +by choosing a new function name "newName" as in the previous section +and using the alternatives in alts to construct an appropriate +definition for this function (essentially by replacing each `->' symbol +with a `=' symbol). The complete case expression is then treated as +being equivalent to the expression "newName e". A simple example of +this is the "scanl" function whose definition in the standard prelude: + + scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +is equivalent to: + + scanl f q xs = q : scanl' xs + where scanl' [] = [] + scanl' (x:xs) = scanl f (f q x) xs + +This latter form is precisely the definition used in [1] (but using the +name "scan" where Gofer uses "scanl"). + +Evaluating a case expression in which none of the alternatives match +the value of the discriminant results in an error such as the +following: + + ? case [1,2] of [] -> "empty list" + {v117 [1, 2]} + (6 reductions, 31 cells) + ? + +The function name "v117" which appears here is the name of the function +which is used internally by Gofer to implement the case expression +whilst the expression "[1, 2]" gives the discriminant value which could +not be matched. + +By combining case expressions with the lambda expressions introduced in +the previous section, any function declaration can be translated into a +single equation of the form = . For example, the +standard function "map" whose definition is usually written as: + + map f [] = [] + map f (x:xs) = f x : map f xs + +can also be defined by the equation: + + map = \f xs -> case xs of + [] -> [] + (y:ys) -> f y : map f ys + +This kind of translation is used in the implementation of many +functional programming languages, including Gofer. See Simon Peyton +Jones book [2] for more details of this. + + +.ST 10.5 Operator sections +---------------------- +As we have seen, most functions in Gofer taking more than one argument +are treated as a function of a single argument, whose result is a +function which can then be applied to the remaining arguments. Thus +"(+) 1" denotes the function which takes an integer argument "n" and +returns the integer value "1+n". Functions of this kind involving +operator symbols are sufficiently common that Gofer provides a special +syntax for them. Using e to denote an atomic expression and the symbol +"*" to represent an arbitrary infix operator, there are functions (e *) +and (* e), known as `sections of the operator (*)' defined by: + + (e *) x = e * x + (* e) x = x * e + +or, using lambda expressions as introduced in section 10.3: + + (e *) = \x -> e * x + (* e) = \x -> x * e + +For example: (1+) is the successor function which returns the value + of its argument plus 1, + (1.0/) is the reciprocal function, + (/2) is the halving function, + (:[]) is the function which maps any value to the + singleton list containing that element. + +In Gofer, the expressions "(e *)" and "(* e)" are actually treated as +abbreviations for "(*) e" and "flip (*) e" respectively, where "flip" +is the function defined by: + + flip :: (a -> b -> c) -> b -> a -> c + flip f x y = f y x + +There is an important special case which occurs with an expression of +the form (- e); this is interpreted as "negate e" and not as the +section which subtracts the value of "e" from its argument. The latter +function can be written as the section (+ (- e)) or as "subtract e" +where "subtract" is the function defined in the standard prelude using: + + subtract = flip (-) + + +.ST 10.6 Explicitly typed expressions +---------------------------------- +As described in section 9.12, it is often useful to be able to declare +the type of a variable defined in a function or pattern binding. For +much the same reasons, Gofer allows expressions of the form: + + :: + +so that the type of an expression can be specified explicitly. Note +that the :t command can be used to find the type of a particular +expression that is inferred by Gofer: + + ? :t \x -> [x] + \x -> [x] :: a -> [a] + + ? :t sum . map length + sum . map length :: [[a]] -> Int + + ? + +The types inferred in each case can be modified by including explicit +types in these expressions: + + ? :t (\x -> [x]) :: Char -> String + \x -> [x] :: Char -> String + + ? :t sum . map (length :: String -> Int) + sum . map length :: [String] -> Int + + ? + +Note that an error occurs if the type declared in an explicitly typed +expression is not compatible with the type inferred by Gofer: + + ? :t (\x -> [x]) :: Int -> a + ERROR: Declared type too general + *** Expression : \x -> [x] + *** Declared type : Int -> a + *** Inferred type : Int -> [Int] + + ? + +Explicitly typed expressions are most commonly used together with +overloaded functions and values as described in section 14. +.pa +.co-------------------------------------------------------------------| +.>ch11 +.ST 11. USER-DEFINED DATATYPES AND TYPE SYNONYMS + +.ST 11.1 Datatype definitions +------------------------- +In addition to the wide range of built-in datatypes described in +section 7, Gofer also allows the definition of new datatypes using +declarations of the form: + + data DatatypeName a1 ... an = constr1 | ... | constrm + +where DatatypeName is the name of a new type constructor of arity n>=0, +a1, ..., an are distinct type variables representing the arguments of +DatatypeName and constr1, ..., constrm (m>=1) describe the way in which +elements of the new datatype are constructed. Each constr can take one +of two forms: + + o Name type1 ... typer where Name is a previously unused constructor + function name (i.e. an identifier beginning with a capital + letter). This declaration introduces Name as a new constructor + function of type: type1 -> ...-> typer -> DatatypeName a1 ... an. + + o type1 CONOP type2 where CONOP is a previously unused constructor + function operator (i.e. an operator symbol beginning with a + colon). This declaration introduces (CONOP) as a new constructor + function of type: type1 -> type2 -> DatatypeName a1 ... an. + +[N.B. only the type variables a1, ..., an may appear in the type +expressions in each constr in the definition of DatatypeName.] + + +As a simple example, the following definition introduces a new type Day +with elements Sun, Mon, Tue, Wed, Thu, Fri and Sat: + + data Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat + +Simple functions manipulating elements of type Day can be defined using +pattern matching: + + what_shall_I_do Sun = "relax" + what_shall_I_do Sat = "go shopping" + what_shall_I_do _ = "looks like I'll have to go to work" + +Another example uses a pair of constructors to provide a representation +for temperatures which may be given using either of the centigrade or +fahrenheit scales: + + data Temp = Centigrade Float | Fahrenheit Float + + freezing :: Temp -> Bool + freezing (Centigrade temp) = temp <= 0.0 + freezing (Fahrenheit temp) = temp <= 32.0 + +The following example uses a type variable on the left hand side of the +datatype definition to implement a Set type constructor for +representing sets using a list of values: + + data Set a = Set [a] + +For example, Set [1,2,3] is an element of type Set Int, representing +the set of integers {1, 2, 3} whilst Set ['a'] represents a singleton +set of type Set Char. As this example shows, it is possible to use the +same name simultaneously as both a type constructor and as a +constructor function. + +Datatype definitions may also be recursive, using the name of the +datatype being defined on the right hand side of the datatype +definition (mutually recursive datatype definitions are also +permitted). The following example is taken from the Haskell report [5] +and defines a type representing binary trees with values of a +particular type at their leaves: + + data Tree a = Lf a | Tree a :^: Tree a + +For example, (Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10 has type Tree Int +and represents the binary tree: + + ,--- 12 + ,--| + | | ,--- 23 + | `--| + | `--- 13 + --| + `--- 10 + +As an example of a function defined on trees, here are two definitions +using recursion and pattern matching on tree valued expressions which +calculate the list of elements at the leaves of a tree traversing the +branches of the tree from left to right. The first definition uses a +simple definition, whilst the second uses an `accumulating parameter' +giving a more efficient algorithm: + + leaves, leaves' :: Tree a -> [a] + + leaves (Lf l) = [l] + leaves (l:^:r) = leaves l ++ leaves r + + leaves' t = leavesAcc t [] + where leavesAcc (Lf l) = (l:) + leavesAcc (l:^:r) = leavesAcc l . leavesAcc r + +Using the binary tree above as an example: + + ? leaves ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (24 reductions, 73 cells) + ? leaves' ((Lf 12 :^: (Lf 23 :^: Lf 13)) :^: Lf 10) + [12, 23, 13, 10] + (20 reductions, 58 cells) + ? + + +.ST 11.2 Type synonyms +------------------ +Type synonyms are used to provide convenient abbreviations for type +expressions. A type synonym is introduced by a declaration of the +form: + + type Name a1 ... an = expansion + +where Name is the name of a new type constructor of arity n>=0, a1, +..., an are distinct type variables representing the arguments of Name +and expansion is a type expression. Note that the only type variables +permitted in the expansion type are those on the left hand side of the +synonym definition. Using this declaration any type expression of the +form: + + Name type1 ... typen + +is treated as an abbreviation of the type expression obtained from +expansion by replacing each of the type variables a1, ..., an with the +corresponding type type1, ..., typen. + +The most frequently used type synonym is almost certainly the String +type which is a synonym for [Char]: + + type String = [Char] + +[ASIDE: This definition is actually built in to the Gofer system, but +the effect is the same as if this declaration were included in the +standard prelude.] + +Note that the types of expressions inferred by Gofer will not usually +contain any type synonyms unless an explicit type signature is given, +either using an explicitly typed expression (section 10.6) or a type +declaration (section 9.12): + + ? :t ['c'] + ['c'] :: [Char] + ? :t ['c'] :: String + ['c'] :: String + ? + +Unlike the datatype declarations described in the previous section, +recursive (and mutually recursive) synonym declarations are not +permitted. This rules out examples such as: + + type BadSynonym = [BadSynonym] + +and ensures that the process of expanding all of the type synonyms used +in any particular type expression will always terminate. The same +property does not hold for the illegal definition above, in which any +attempt to expand the type BadSynonym would lead to the non-terminating +sequence: + + BadSynonym ==> [BadSynonym] ==> [[BadSynonym]] ==> .... +.pa +.co-------------------------------------------------------------------| +.>ch12 +.ST 12. DIALOGUES: INPUT AND OUTPUT + +The Gofer system implements a subset of the facilities for programs +involving I/O described in the Haskell report [5]. In particular, this +makes it possible for Gofer programs to be run interactively, and to +make limited use of text files for both reading and writing. A +significant factor in the design of the Haskell I/O facilities is that +it allows the use of such programs without loss of referential +transparency. + +.ST 12.1 Basic description +---------------------- +Programs using the I/O facilities in Gofer are modelled by functions of +type Dialogue, defined by the type synonym: + + type Dialogue = [Response] -> [Request] + +In other words, a Gofer program produces a list of output values, each +of which may be thought of as a request for some particular input or +output action, and obtains the corresponding list of operating system +responses as its input. Note that the input list of responses will be +evaluated lazily; i.e. we can ensure that we do not attempt to obtain +the response to a given request until that request has been completed. + +The current range of requests supported by Gofer is described by the +following datatype definition, taken from the standard prelude: + + data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + +Each response is an element of the type defined by the following +datatype definition, using an auxiliary datatype IOError to describe a +variety of error conditions that may occur: + + data Response = Success + | Str String + | Failure IOError + + data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +The following list describes the kind of I/O behaviour specified by +each form of Request and indicates the possible Response values that +may be obtained in each case: + + o ReadFile string: Read contents of file named by "string". + Possible responses to this request are: + + o Str contents if the request is successful, where "contents" + is a string (evaluated lazily) containing the contents of the + file specified by the ReadFile request. + + o Failure (SearchError name) occurs if file "name" cannot be + accessed. + + o Failure (ReadError name) occurs if some other error occurs + whilst opening the file "name". + + o WriteFile name string: Write the given "string" to the file + "name". If the file does not already exist, it is created before + attempting to write the value to file. If the file already exists + then it will be truncated to zero length before the write begins. + No response is obtained until the string argument has been fully + evaluated and its contents written to file. Possible responses + are: + + o Success if the write to file was completed successfully. + + o Failure (WriteError msg) if an error was detected whilst + trying to perform the output. If the problem occurred whilst + attempting to open the specified file, then "msg" contains + the filename, otherwise it contains a printable + representation of the evaluation error which occurred. + + o AppendFile name string: Similar to the WriteFile request except + that the value of the given "string" is appended onto the file + "name" if that file already exists. The responses that may be + obtained from this request are the same as those for WriteFile. + + o ReadChan name: Read from the input stream "name". Note that + it is an error to attempt to read from the same channel more than + once in the same program. Possible responses are: + + o Str contents if the request is successful, where "contents" + is a string (evaluated lazily) containing the list of + characters entered on the input stream. + + o Failure (SearchError name) if the named channel cannot be + found. The only input channel known to Gofer is the standard + input channel "stdin". For convenience, the standard prelude + defines the variable stdin bound to this string. + + o Failure (ReadError name) if a ReadChan request for the named + channel has already been given by a previous request. + + o AppendChan name string: Output "string" on channel "name". No + response is obtained until the string has been fully evaluated and + written to the named channel. Possible responses are: + + o Success if the append to channel was completed successfully. + + o Failure (SearchError name) if the named channel cannot be + found. The only output channels known to Gofer are "stdout", + "stderr" and "stdecho" (which is actually just another name + for "stdout" in Gofer). For convenience, the standard + prelude defines variables stdout, stderr and stdecho bound to + the corresponding string values. + + o Failure (WriteError msg) if an error is detected whilst + trying to perform the output. The string "msg" contains a + printable representation of the evaluation error which + occurred. + + o Echo status: Set the echo status on the standard input channel + stdin to the given boolean value. If the echo status is True, + then user input will be echoed onto the screen as it is typed and + the usual line editing facilities (such a backspace or delete) + provided by the host system can be used to edit the input lines as + they are entered. If the echo status is False, then individual + characters may be read from the standard input channel without any + echo or line editing features. + + Note that at most one Echo request can be used in a program, and + must precede any ReadChan request for stdin. If not set by an + explicit Echo request, the echo status defaults to True. Possible + responses are: + + o Success if the request was completed successfully. + + o Failure (OtherError msg) if the request could not be + completed either because a readChannel request for stdin has + already been processed, or because a previous Echo request + has already been given. The corresponding values of "msg" + are "stdin already in use" and "repeated Echo request" + respectively. + +A simple example of a program using these facilities to output a short +message on the standard output stream is: + + helloWorld :: Dialogue + helloWorld resps = [AppendChan stdout "hello, world"] + +Any expression entered into Gofer of type "Dialogue" will be treated as +a Gofer program using I/O and will be executed accordingly: + + ? helloWorld + hello, world + (1 reduction, 28 cells) + ? + +Notice that without the explicit type declaration, the type that would +be inferred for helloWorld would be a -> [Request], and hence +helloWorld would not be executed as a Dialogue program. This point can +be illustrated using lambda expressions: + + ? \resps -> [AppendChan stdout "hello, world"] + v128 + (1 reduction, 7 cells) + + ? (\resps -> [AppendChan stdout "hello, world"]) :: Dialogue + hello, world + + (1 reduction, 28 cells) + ? + +In many cases the structure of an expression is enough to fully +determine its type as Dialogue (or equivalently as [Response] -> +[Request]), in which case no explicit types are required to ensure that +the expression is treated as a Gofer program using I/O: + + ? \~[Success] -> [AppendChan stdout "hello, world"] + hello, world + (1 reduction, 29 cells) + ? + +Note the use of the irrefutable pattern ~[Success] for the lambda +expression in the last example; without this, the usual rules of +pattern matching as described in section 9 would force Gofer to try to +match the pattern [Success] against the list of responses, before the +corresponding request had been produced: + + ? \ [Success] -> [AppendChan stdout "hello, world"] + + Aborting Dialogue: + {error "Attempt to read response before request complete"} + (50 reductions, 229 cells) + ? + +The next example takes a single string as a parameter and displays the +contents of the corresponding file: + + showFile :: String -> Dialogue + showFile name ~(read:_) = [ReadFile name, AppendChan stdout result] + where result = case read of Str contents -> contents + Failure _ -> "Can't open " ++ name + +With a few modifications, we can implement a similar program which +prompts for, and reads, a filename from the standard input and then +reads and displays the contents of that file as before. This program +is based on a similar example in the Haskell report [5]: + + main ~(Success : ~(Str userInput : ~(r3 : _))) + = [ AppendChan stdout "Please type a filename: ", + ReadChan stdin, + ReadFile name, + AppendChan stdout (case r3 of Str contents -> contents + Failure _ -> "Can't open " + ++ name) + ] where (name : _) = lines userInput + + +.ST 12.2 Continuation style I/O +--------------------------- +As an alternative to the `stream-based' approach to programs using the +I/O facilities in Gofer, the standard prelude defines a family of +functions which enables such programs to be written in a `continuation' +style. The basic idea is to define a function corresponding to each +different kind of request, whose parameters include the values required +to make the request together with two continuations. The continuations +are functions describing "what to do next", one of which is used if the +request is successful, the other if the request fails. + +As an example, the ReadFile request is represented by the function +"readFile" whose definition is equivalent to: + + readFile name fail succ ~(r:rs) = ReadFile name : rest rs + where rest = case r of Str s -> succ s + Failure ioerror -> fail ioerror + +The first thing to happen when a dialogue expression of the form +"readFile name fail succ" is evaluated is that the corresponding +request "ReadFile name" is added to the list of I/O requests. A new +dialogue value "rest" is chosen, depending on the response to the +ReadFile request, and the program continues by passing the remaining +part of the response list to "rest". The functions "succ" and "fail" +(called the success and failure continuations respectively) describe +the way in which the new dialogue "rest" is obtained. + +The following example (edited a little to fit within the margins of this +document) shows how the readFile function described above can be used to +print the contents of a file called "test" on the display: + + ? readFile "test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + This is a test message + + (4 reductions, 52 cells) + ? + +The success continuation "(\s resps->[AppendChan stdout s])" used here +receives the contents of the file "test" in the the parameter "s" and +uses an AppendChan request to output that string on the display. As +this example shows, the stream based approach of the previous section +can be combined with the continuation based style of I/O without any +difficulty. The failure continuation "(\ioerror resps -> [])" ignores +the error condition "ioerror" which caused the request to fail and +gives a dialogue which terminates immediately without any action. For +example, assuming that the file "Test" cannot be found: + + ? readFile "Test" (\ioerror resps -> []) + (\s resps->[AppendChan stdout s]) + + (4 reductions, 24 cells) + ? + +In practice, it is usually a good idea to produce some kind of +diagnostic message when an error occurs: + + ? readFile "Test" + (\ioerror resps -> [AppendChan stdout (show' ioerror)]) + (\s resps -> [AppendChan stdout s]) + SearchError "Test" + (11 reductions, 59 cells) + ? + +In each of the examples above, the failure continuation has type +"FailCont" as defined by the following type synonym in the standard +prelude: + + type FailCont = IOError -> Dialogue + +Similarly, the success continuation, which takes a string representing +an input string and produces a new Dialogue has type "StrCont": + + type StrCont = String -> Dialogue + +A third kind of continuation is needed for those requests which return +a response of the form "Success" if successful (e.g. output +requests). In this case the continuation is simply another dialogue: + + type SuccCont = Dialogue + +The following list gives the type of each of the six functions +corresponding to the six different kinds of I/O request described in +the previous section. Full definitions for each of these functions are +given in appendix B: + + readFile :: String -> FailCont -> StrCont -> Dialogue + writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue + appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue + readChan :: String -> FailCont -> StrCont -> Dialogue + appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue + echo :: Bool -> FailCont -> SuccCont -> Dialogue + +As an illustration of the use of these functions, we show how each of +the example programs from the previous section can be rewritten using +the continuation based style of I/O, starting with the program +"helloWorld": + + helloWorld :: Dialogue + helloWorld = appendChan stdout "hello, world" abort done + +In this case, the explicit type declaration is not actually required +since the type of the expression is completely determined by the type +of "appendChan". The failure continuation "abort" is equivalent to the +function "(\ioerror resps -> [])" described above and terminates the +program if an error occurs without any further action. In a similar +way, "done" is the trivial dialogue which terminates immediately +without any action. Both of these values are defined in the standard +prelude: + + done :: Dialogue + done resps = [] + + abort :: FailCont + abort ioerror = done + +Using the same approach, the "showFile" and "main" programs from the +previous section are written as: + + showFile :: String -> Dialogue + showFile name + = readFile name (\ioerror -> appendChan stdout + ("Can't open " ++ name) abort done) + (\contents-> appendChan stdout contents abort done) + + main :: Dialogue + main = appendChan stdout "Please type a filename: " abort + (readChan stdin abort + (\userInput -> let (name : _) = lines userInput in + readFile name + (\ioerror -> appendChan stdout ("Can't open " ++ name) + abort done) + (\contents -> appendChan stdout contents abort done))) + + +.ST 12.3 Interactive programs +------------------------- +One of the principal motivations for including facilities for I/O in +Gofer programs was to provide a way of using interactive programs as +described in [1]. An interactive program is represented by a function +of type String -> String mapping an input string of characters entered +at the keyboard into an output string to be displayed on the screen. + +There are two functions defined in the standard prelude which can be +used to `execute' functions of this kind as interactive programs: + + o "interact f" executes f::String->String as an interactive program + with echo on. This means that characters are read from the + keyboard a line at a time. The usual editing characters such as + backspace can be used to correct mistakes which are noticed before + the return key is pressed at the end of each line. The input + stream can be terminated by typing an end of file character at the + beginning of a line: + + ? interact (map toUpper) + This text was entered using the interact function + THIS TEXT WAS ENTERED USING THE INTERACT FUNCTION + ^Z + (874 reductions, 1037 cells) + ? + + o "run f" behaves like "interact f" except that echo is turned off. + In this case, the only way of terminating the input stream without + reaching the end of the string produced by "f" is to use the + interrupt key: + + ? run (map toUpper) + ALTHOUGH THIS IS ENTERED IN LOWER CASE, IT STILL + APPEARS IN UPPER CASE ! + {Interrupted!} + + (1227 reductions, 1463 cells) + ? + +[ASIDE: of these two functions, only "interact" is also included in the +standard prelude for Haskell, although "run" may also be added to a +Haskell system using the definition below.] + +The definitions of "interact" and "run" provide further examples of +Gofer programs using simple I/O facilities: + + interact :: (String -> String) -> Dialogue + interact f = readChan stdin abort + (\s -> appendChan stdout (f s) abort done) + + run :: (String -> String) -> Dialogue + run f = echo False abort (interact f) + +[EXERCISE for the interested reader: construct alternative definitions +for these functions using the stream based approach from section 12.1.] + +.pa +.co-------------------------------------------------------------------| +.>ch13 +.ST 13. LAYOUT + +.ST 13.1 Comments +------------- +Comments provide an informal but useful way of annotating a program +with a description of its purpose, structure and development. +Following the definition of Haskell, two styles of comment are +supported by Gofer: + + o A one line comment begins with the two characters "--" and is + terminated at the end of the same line. Note that an operator + symbol cannot begin with "--" as this will be treated as the + beginning of a comment. It is however possible to use the two + characters "--" at any other position within an operator symbol. + Thus a line such as: + + (xs ++ ys) -- xs + + includes a comment and will actually be treated as if the line had + been written: + (xs ++ ys) + + Whereas the line: + + xs >--> ys >--> zs + + does not contain any comments (although it will cause an error + unless ">-->" has been defined using an appropriate infixl or + infixr declaration). + + o A nested comment begins with the characters "{-", ends with the + characters "-}" and may span any number of lines. [N.B. the + initial "{-" string cannot overlap with the terminating "-}" + string so that the shortest possible nested comment is "{--}", and + not "{-}"]. An unterminated nested comment will be treated as an + error. + + As the name suggests, comments of this kind may be nested so that + "{- {- ... -} ... {- ... -} -}" is treated as a single comment. + This makes nested comments particularly convenient for enclosing + parts of a program which may already contain other nested + comments. + +Both kinds of comment may be used in expressions entered directly into +the Gofer system, or more usually, in files of definitions loaded into +Gofer. The two styles of comment may be mixed within the same +expression or program, remembering that the string "--" has no special +significance within a nested comment and that the strings "{-" and "-}" +have no special significance in a single line comment. Thus: + + [ 2, -- {- [ 2, {- + 3, -- -} -- -} 3, + 4 ] 4 ] + +are both equivalent to the list expression [2,3,4]. + + +.ST 13.2 The layout rule +-------------------- +In a tradition dating back at least a quarter of a century to Landin's +ISWIM family of languages, most Gofer programs use indentation to +indicate the structure of a program. For example, in a definition such +as: + + f x y = g (x + w) + where g u = u + v + where v = u * u + w = 2 + y + +it is clear from the layout that the definition of w is intended to be +local to f rather than to g. Another example where layout plays an +important role is in distinguishing the two definitions: + + example x y z = a + b example x y z = a + b + where a = f x y where a = f x + b = g z y b = g z + +There are three situations in Gofer where indentation is typically used +to determine the structure of a program: + + o At the top-level of a file of definitions. + + o In a group of local declarations following either of the keywords + "let" or "where". + + o In a group of alternatives in a case expression, following the + keyword "of". + +In each case, Gofer actually expects to find a list of items enclosed +between braces `{' and `}' with individual items separated from one +another by semicolons `;'. However, if the leading brace is not found +then Gofer uses the layout rule described below to arrange for `{', `}' +and `;' tokens to be inserted into the input stream automatically +according to the indentation of each line. + +In this way, the first example above will in fact be treated as if the +user had entered: + + f x y = g (x + w) + where {g u = u + v + where {v = u * u + }; w = 2 + y + } + +or, equivalently, just: + + f x y = g (x + w) where {g u = u + v where {v = u * u}; w = 2 + y} + +where the additional punctuation using the `{', `}' and `;' characters +makes the intended grouping clear, regardless of indentation. + +.cc 2 +The layout rule used in Gofer is the same as that of Haskell, and can +be described as follows: + + o An opening brace `{' is inserted in front of the first token at + the beginning of a file or following one of the keywords "where", + "let" or "of", unless that token is itself an opening brace. + + o A `;' token is inserted in front of the first token in any + subsequent line with exactly the same indentation as the token in + front of which the opening brace was inserted. + + o The layout rule ends and a `}' token is inserted in front of the + first token in a subsequent line whose indentation is strictly + less than that of the token in front of which the opening brace + was inserted. + + o A closing brace `}' will also be inserted at any point where an + otherwise unexpected token is encountered. This part of the rule + makes it possible to use expressions such as: + + let a = fact 12 in a+a + + without needing to use the layout characters explicitly as in: + + let {a = fact 12} in a+a. + + o Lines containing only whitespace (blanks and tabs) and comments do + not affect the use of the layout rule. + + o For the purposes of determining the indentation of each line in a + file, tab stops are assumed to be placed every 8 characters, with + the leftmost tab stop in column 9. Each tab character inserts one + or more spaces as necessary to move to the next tab stop. + + o The indentation of the end of file token is zero. + +The following (rather contrived) program, is based on an example in the +Haskell report [5], and provides an extended example of the use of the +layout rule. A file containing the following definitions: + + data Stack a = Empty + | MkStack a (Stack a) + + push :: a -> Stack a -> Stack a + push x s = MkStack x s + + size :: Stack a -> Int + size s = length (stkToList s) where + stkToList Empty = [] + stkToList (MkStack x s) = x:xs where xs = stkToList s + + pop :: Stack a -> (a, Stack a) + pop (MkStack x s) = (x, case s of r -> i r where i x = x) + + top :: Stack a -> a + top (MkStack x s) = x + +will be treated by Gofer as if it has been written: + + {data Stack a = Empty + | MkStack a (Stack a) + + ;push :: a -> Stack a -> Stack a + ;push x s = MkStack x s + + ;size :: Stack a -> Int + ;size s = length (stkToList s) where + {stkToList Empty = [] + ;stkToList (MkStack x s) = x:xs where {xs = stkToList s + + }};pop :: Stack a -> (a, Stack a) + ;pop (MkStack x s) = (x, case s of {r -> i r where {i x = x}}) + + ;top :: Stack a -> a + ;top (MkStack x s) = x + } + +Note that some of the more sophisticated forms of expression cannot be +written on a single line (and hence entered directly into the Gofer +system) without explicit use of the layout characters `{', `}' and `;': + + ? len [1..10] where len [] = 0; len (x:xs) = 1 + len xs + 10 + (81 reductions, 108 cells) + + ? f True where f x = case x of True->n where {n=not x}; False->True + False + (4 reductions, 11 cells) + + ? + +One situation in which the layout rule can cause problems is with +top-level definitions. For example, the two lines: + + f x = 1 + x + g y = 1 - y + +will be treated as a single line "f x = 1 + x g y = 1 - y", which will +cause a syntax error. This kind of problem becomes rather more +difficult to spot if the two definitions are not on subsequent lines, +particularly if they are separated by several lines of comments. For +this reason, it is usually a good idea to ensure that all of the +top-level definitions in a file start in the same column (the first +column is usually the most convenient). COBOL and Fortran programmers +are not likely to find this problem too distressing :-) +.pa +.on +.co-------------------------------------------------------------------| +.>ch14 +.ST 14. OVERLOADING IN GOFER + +One of the biggest differences between Gofer and most other programming +languages (with the exception of Haskell) is the approach to +overloading; enabling the definition and use of functions in which the +meaning of a function symbol may depend on the types of its arguments. + +Like Haskell, overloading in Gofer is based around a system of type +classes which allow overloaded functions to be grouped together into +related groups of functions. Whilst the precise details of the +approach to type classes used by Gofer are quite different from those +of Haskell, both rely on the same basic ideas and use a similar syntax +for defining and using type classes. It would therefore seem possible +that experience gained with the overloading system in one language can +readily by applied to the other. + +The differences embodied in the Gofer system of classes stem from my +own, theoretically based investigations into `qualified types' some of +which is detailed in references [8-12]. In my personal opinion, the +Gofer system has some significant advantages over the Haskell approach +(see [12] for details) and one of the principal motivations behind the +implementation to Gofer was to provide a way of testing such claims. +One fact which I believe has already been established using Gofer is +that the use and implementation of overloaded functions need not have +the significant effect on performance that was anticipated with early +implementations of Haskell. + +This section outlines the system of type classes used in Gofer, +indicating briefly how they can be used and how they are implemented. + + +.ST 14.1 Type classes and predicates +-------------------------------- +A type class can be thought of as a family of types (or more generally +as a family of tuples of types) whose elements are called instances of +the class. If C is the name of an n-parameter type class then an +expression of the form C t1 t2 ... tn where t1, t2, ..., tn are type +expressions is called a predicate and represents the assertion that the +specified tuple of types is an instance of the class C. + +Given a polymorphic function (e.g. map::(a->b)->[a]->[b]), we are free +to use the function at any type which can be obtained by substituting +arbitrary types for each of the type variables in its type. In Gofer, +a type expression may be qualified by one or more predicates which +restrict the range of types at which a value can be used: + +e.g. a function of type C a => a -> a -> a can be treated as a function + of type t -> t -> t for any instance t of the class C. + +The predicate C a in the type expression in the previous example is +called the context of the type. Contexts may contain more than one +predicate in which case the predicates involved must be separated by +commas and the context enclosed in parentheses as in (C a, D b). The +empty context is written () and any type expression t is equivalent to +the qualified type () => t. For uniformity, a context with only one +element may also be enclosed by parentheses. + +For technical reasons, type synonyms are not currently permitted in +predicates. This is consistent with the use of predicates in Haskell, +but may be relaxed, at least in certain cases, in later versions of +Gofer. + + +.ST 14.2 The type class Eq +---------------------- +The type class Eq is a simple and useful example, whose instances are +precisely those types whose elements can be tested for equality. The +declaration of this class given in the standard prelude is as follows: + + class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +There are three parts in any class declaration. For this particular +example we have: + + o The first line (called the `header') of the declaration introduces + a name Eq for the class and indicates that it has a single + parameter, represented by the type variable a. + + o The second line of the declaration (the `signature part') + indicates that there are functions denoted by the operator symbols + (==) and (/=) of type a -> a -> Bool for each instance a of class + Eq. Using the notation introduced in the previous section, both + of these operators have type: + + Eq a => a -> a -> Bool + + These functions are called the `members' (or `member functions') + of the class. [This terminology, taken from Haskell, is rather + unfortunate; thinking of a type class as a set of types, the + elements of the class are called `instances', whilst the `members' + of the class correspond more closely to the instance variables + that are used in the terminology of object-oriented programming.] + + The intention is that the (==) function will be used to implement + an equality test for each instance of the class, with the (/=) + operator providing the corresponding inequality function. The + ability to include related groups of functions within a single + type class in this way is a useful tool in program design. + + o The third line of the class declaration (the `default + definitions') provides a default definition of the (/=) operator + in terms of the (==) operator. Thus it is only necessary to give + a definition for the (==) operator in order to define all of the + member functions for the class Eq. It is possible to override + default member definitions by giving an alternative definition as + appropriate for specific instances of the class. + + +.ST 14.2.1 Implicit overloading +--------------------------- +Member functions are clearly marked as overloaded functions by their +definition as part of a class declaration, but this is not the only way +in which overloaded functions occur in Gofer; the restriction to +particular instances of a type class is also carried over into the type +of any function defined either directly or indirectly in terms of the +member functions of that class. For example, the types inferred for +the following two functions: + + x `elem` xs = any (x==) xs + xs `subset` ys = all (`elem` ys) xs + +are: + + elem :: Eq a => a -> [a] -> Bool + subset :: Eq a => [a] -> [a] -> Bool + +[ASIDE: On the other hand, if none of the functions used in a +particular expression or definition are overloaded then there will not +be any overloading in the corresponding value. Gofer does not support +the concept of implicit overloading used in some languages where a +value of a particular type might automatically be coerced to a value of +some supertype. An example of this would be the automatic translation +of a badly typed expression "1.0 == 1" to a well-typed expression of +the form "1.0 == float 1" for some (potentially overloaded) coercion +function "float" mapping numeric values to elements of type Float.] + +Note also that the types appearing in the context of a qualified type +reflect the types at which overloaded functions are used. Thus: + + f x ys = [x] == ys + +has type Eq [a] => a -> [a] -> Bool, and not Eq a => a -> [a] -> Bool, +which is the type that would be assigned to "f" in a Haskell system. + + +.ST 14.2.2 Instances of class Eq +---------------------------- +Instances of a type class are defined using declarations similar to +those used to define the corresponding type class. The following +examples, taken from the standard prelude, give the definitions for a +number of simple instances of the class Eq: + + instance Eq Int where (==) = primEqInt + + instance Eq Bool where + True == True = True + False == False = True + _ == _ = False + + instance Eq Char where c == d = ord c == ord d + + instance (Eq a, Eq b) => Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + + instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +The interpretation of these declarations is as follows: + + o The first declaration makes Int an instance of class Eq. The + function "primEqInt" is a primitive Gofer function which tests the + equality of two integer values and has type Int -> Int -> Bool. + + o The second declaration makes Bool an instance of class Eq with a + simple definition involving pattern matching. + + o The third declaration makes Char an instance of class Eq. This + definition indicates that a pair of characters are equal if they + have the same ASCII value, which is obtained using the "ord" + function. Note that the two occurrences of the symbol (==) in the + equation: + + c == d = ord c == ord d + + have different meanings; the first denotes equality between + characters (elements of type Char), whilst the second denotes + equality between integers (elements of type Int). + + o The fourth declaration provides an equality operation on pairs. + Given two elements (x,y) and (u,v) of type (a,b) for some a, b, it + must be possible to check that both x==u and y==v before we can be + sure that the two pairs are indeed equal. In other words, both a + and b must also be instances of Eq in order to make (a,b) an + instance of Eq. This requirement is described by the first line + in the instance declaration using the expression: + + (Eq a, Eq b) => Eq (a,b) + + o The fifth declaration makes [a] an instance of Eq, whenever a is + itself an instance of Eq in a similar way to the previous + example. The context Eq a is used in the last equation in the + declaration: + + (x:xs) == (y:ys) = x==y && xs==ys + + which contains three occurrences of the (==) operator; the first + and third are used to compare lists of type [a], whilst the second + is used to compare elements of type a, using the instance Eq a. + +Combining these five declarations, we obtain definitions for (==) on an +infinite family of types including Int, Char, Bool, (Int,Bool), +(Char,Int), [Char], (Bool,[Int]), [(Bool,Int)], etc...: + + ? 2 == 3 -- using Eq Int + False + (2 reductions, 10 cells) + ? (["Hello"],3) == (["Hello"],3) -- using Eq ([[Char]],Int) + True + (31 reductions, 65 cells) + ? + +On the other hand, any attempt to use (==) to compare elements of some +type not covered by a suitable instance declaration will result in an +error. For example, the standard prelude does not define the equality +operation on triples of values: + + ? (1,2,3) == (1,2,3) + ERROR: Cannot derive instance in expression + *** Expression : (==) d125 (1,2,3) (1,2,3) + *** Required instance : Eq (Int,Int,Int) + ? + +This can be solved by including an instance declaration of the +following form into a file of definitions loaded into Gofer: + + instance (Eq a, Eq b, Eq c) => Eq (a,b,c) where + (x,y,z) == (u,v,w) = x==u && y==v && z==w + +Giving: + + ? (1,2,3) == (1,2,3) + True + (6 reductions, 20 cells) + ? + +In general, an instance declaration has the form: + + instance context => predicate where + definitions of member functions + +The context part of the declaration gives a list of predicates which +must be satisfied for the predicate on the right hand side of the `=>' +sign to be valid. Constant predicates (i.e. predicates not involving +any type variables) required by an instance declaration (such as the +predicate Eq Int required by the third declaration) need not be +included in the context. If the resulting context is empty (as in the +first three declarations above) then it may be omitted, together with +the corresponding `=>' symbol. + + +.ST 14.2.3 Testing equality of represented values +--------------------------------------------- +Instances of Eq can also be defined for other types, including +user-defined datatypes, and unlike the instances described above, the +definition of (==) need not be used to determine whether the values +being compared have the same structure; it is often more useful to +check that they represent the same value. As an example, suppose that +we introduce a type constructor Set for representing sets of values, +using a list to store the values held in the set: + + data Set a = Set [a] + +As usual, we say that two sets are equal if they have the same members, +ignoring any repetitions or differences in the ordering of the elements +in the lists representing the sets. This is achieved using the +following instance declaration: + + instance Eq a => Eq (Set a) where + Set xs == Set ys = xs `subset` ys && ys `subset` xs + where xs `subset` ys = all (`elem` ys) xs + +A couple of examples illustrate the use of this definition: + + ? Set [1,2,3] == Set [3,4,1] + False + (49 reductions, 89 cells) + ? Set [1,2,3] == Set [1,2,2,2,1,3] + True + (157 reductions, 240 cells) + ? + + +.ST 14.2.4 Instance declarations without members +-------------------------------------------- +It is possible to give an instance declaration without specifying any +definitions for the member functions of the class. For example: + + instance Eq () + +In this case, the definition of (==) for the instance Eq () is left +completely undefined, and hence so is the definition of (/=), which is +defined in terms of (==): + + ? () == () + {undefined_member (==)} + (3 reductions, 34 cells) + ? () /= () + {undefined_member (==)} + (4 reductions, 36 cells) + ? + + +.ST 14.2.5 Equality on function types +--------------------------------- +If an expression requires an instance of a class which cannot be +obtained using the rules in the given instance declarations, then an +error message will be produced when the expression is type-checked. +For example, in general there is no sensible way to determine when a +pair of functions are equal, and the standard prelude does not include +a definition for an instance of the form Eq (a -> b) for any types a +and b: + + ? (1==) == (\x->1==x) + ERROR: Cannot derive instance in expression + *** Expression : (==) d148 ((==) {dict} 1) (\x->(==) {dict} 1 x) + *** Required instance : Eq (Int -> Bool) + + ? + +If for some reason, you would prefer this kind of error to produce an +error message when an expression is evaluated, rather than when it is +type-checked, you can use an instance declaration to specify the +required behaviour. For example: + + instance Eq (a -> b) where + (==) = error "Equality not defined between functions" + +Evaluating the previous expression once this instance declaration has +been included now produces the following result: + + ? (1==) == (\x->1==x) + {error "Equality not defined between functions"} + (42 reductions, 173 cells) + ? + +A limited form of equality can be defined for functions of type (a->b) +if a has only finitely many elements, such as the boolean type Bool: + + instance Eq a => Eq (Bool -> a) where + f == g = f False == g False && f True == g True + +[ASIDE: This instance declaration would not be accepted in a Haskell +program which insists that the predicate on the right of the `=>' +symbol contains precisely one type constructor symbol.] + +Using this instance declaration once for each argument, we can now test +two functions taking boolean arguments for equality (assuming of course +that their result type is also an instance of Eq). + + ? (&&) == (||) + False + (9 reductions, 21 cells) + ? not == (\x -> if x then False else True) + True + (8 reductions, 16 cells) + ? (&&) == (\x y-> if x then y else False) + True + (16 reductions, 30 cells) + ? + + +.ST 14.2.6 Non-overlapping instances +-------------------------------- +Other instance declarations for types of the form a -> b can be used at +the same time, so long as no pair of declarations overlap. For +example, adding the following instance declaration + + instance Eq a => Eq (() -> a) where f == g = f () == g () + +enables us to evaluate expressions such as: + + ? (\()->"Hello") == const "Hello" + True + (30 reductions, 55 cells) + ? + +If however, we try to use instance declarations for types of the form +(a -> b) and (Bool -> a) at the same time, then Gofer produces an error +message similar to the following: + + ERROR "file" (line 37): Overlapping instances for class "Eq" + *** This instance : Eq (a -> b) + *** Overlaps with : Eq (Bool -> a) + *** Common instance : Eq (Bool -> a) + + ? + +indicating that, given the task of testing two values of type (Bool->a) +for equality, there are (at least) two definitions of (==) that could +be used, with potentially different results being obtained in each +case. + +Here is a further example of the use of non-overlapping instances of a +class to define a function "cat" (inspired by the unix (tm) command of +the same name) which uses the I/O facilities of Gofer to print the +contents of one or more files on the terminal: + + class Cat a where cat :: a -> Dialogue + instance Cat [Char] where cat n = showFile n done + instance Cat [[Char]] where cat = foldr showFile done + + showFile name cont = readFile name abort + (\s->appendChan stdout s abort cont) + +Given these declarations, an expression of the form: + + cat "file" + +can be used to display the contents of the named file, whilst a list of +files can be printed one after the other using an expression of the +form: + + cat ["file1", "file2", ..., "filen"]. + + +.ST 14.3 Dictionaries +----------------- +In order to understand some of the messages produced by Gofer, as well +as some of the more subtle problems associated with overloaded +functions, it is useful to have a rough idea of the way in which +overloaded functions are implemented. + +The basic idea is that a function with a qualified type context => type +where context is a non-empty list of predicates is implemented by a +function which takes an extra argument for each predicate in the +context. When the function is used, each of these parameters is filled +by a `dictionary' which gives the values of each of the member +functions in the appropriate class. None of these extra parameters is +entered by the programmer. Instead, they are inserted automatically +during type-checking. + +For the class Eq, each dictionary has at least two elements containing +definitions for each of the functions (==) and (/=). A dictionary for +an instance of Eq can be depicted by a diagram of the form: + + +--------+--------+--------- + | | | + | (==) | (/=) | ..... + | | | + +--------+--------+--------- + +In order to produce useful error messages and indicate the way in which +dictionary expressions are being used, Gofer uses a number of special +notations for printing expressions involving dictionaries: + + (#1 d) selects the first element of the dictionary d + + (#2 d) selects the second element of the dictionary d + + (#n d) selects the nth element of the dictionary d + (note that (#0 d) is equivalent to the dictionary d). + + {dict} denotes a specific dictionary (the contents are not + displayed). + + dnnn a dictionary variable representing an unknown dictionary is + printed as a lower case letter `d' followed by an integer; + e.g. d231. + +Note that, whilst these notations are used in output produced by Gofer +and in the following explanations, they cannot be entered directly into +Gofer expressions or programs -- even if you use a variable such as +"d1" in an expression, Gofer will not confuse this with a dictionary +variable with the same name (although Gofer might confuse you by using +the same name in two different contexts!). + +Using these notations, the member functions (==) and (/=) of the class +Eq behave as if they were defined by the expressions: + + (==) d1 = (#1 d1) + (/=) d1 = (#2 d1) + +To understand how these definitions work, we need to take a look at a +specific dictionary. Following the original instance declaration used +for Eq Int, the corresponding dictionary is: + + d :: Eq Int + +------------+------------+ + | | | + | primEqInt | defNeq d | + | | | + +------------+------------+ + +Note that the dictionary variable d is used as a name for the +dictionary in this diagram, indicating how values within a dictionary +can include references to the same dictionary. + +[ASIDE: It turns out that predicates play a very similar role for +dictionaries as types play for normal values. This motivates our use +of the notation d :: Eq Int to indicate that d is a dictionary for the +instance Eq Int. One difference between these, particularly important +for theoretical work, is that dictionary values are uniquely determined +by predicates; if d1::p and d2::p for some predicate p, then d1 = d2.] + +The value held in the first element of the dictionary is the primitive +equality function on integers, "primEqInt". The following diagram +shows how the dictionary is used to evaluate the expression "2 == 3". +Note that this expression will first be translated to "(==) d 2 3" by +the type checker. The evaluation then proceeds as follows: + + (==) d 2 3 ==> (#1 d) 2 3 + ==> primEqInt 2 3 + ==> False + +The second element of the dictionary is a little more interesting +because it uses the default definition for (/=) given in the original +class definition which, after translation, is represented by the +function "defNeq" defined by: + + defNeq d1 x y = not ((==) d1 x y) + +Notice the way in which the extra dictionary parameter is used to +obtain the appropriate overloading. For example, evaluation of the +expression "2 /= 3", which becomes "(/=) d 2 3" after translation, +proceeds as follows: + + (/=) d 2 3 ==> (#2 d) 2 3 + ==> defNeq d 2 3 + ==> not ((==) d 2 3) + ==> not ((#1 d) 2 3) + ==> not (primEqInt 2 3) + ==> not False + ==> True + +[Clearly there is some scope for optimisation here; whilst the actual +reduction sequences used by Gofer are equivalent to those illustrated +above, the precise details are a little different.] + +If an instance is obtained from an instance declaration with a +non-empty context, then the basic two element dictionary used in the +examples above is extended with an extra dictionary value for each +predicate in the context. As an example, the diagram below shows the +dictionaries that will be created from the instance definitions in +section 14.2.2 for the instance Eq (Int, [Int]). The functions +"eqPair" and "eqList" which are used in these dictionaries are obtained +from the definitions of (==) given in the instance declarations for Eq +(a,b) and Eq [a] respectively: + + eqPair d (x,y) (u,v) = (==) (#3 d) x u && (==) (#4 d) y v + + eqList d [] [] = True + eqList d [] (y:ys) = False + eqList d (x:xs) [] = False + eqList d (x:xs) (y:ys) = (==) (#3 d) x y && (==) d xs ys + +The dictionary structure for Eq (Int, [Int]) is as follows. Note that +the Gofer system ensures that there is at most one dictionary for a +particular instance of a class, and that the dictionary d1 :: Eq Int in +this system is automatically shared between d2 and d3: + + d3 :: Eq (Int, [Int]) + +------------+------------+------------+------------+ + | | | | | + | eqPair d3 | defNeq d3 | d1::Eq Int |d2::Eq [Int]| + | | | | | + +------------+------------+-----+------+-----+------+ + | | + +--------------+ | + | | + | d2 :: Eq [Int] V + | +------------+------------+------------+ + | | | | | + | | eqList d2 | defNeq d2 | d1::Eq Int | + | | | | | + | +------------+------------+-----+------+ + | | + d1 :: Eq Int V | + +------------+------------+ | + | | | | + | primEqInt | defNeq d1 |<--------------------------+ + | | | + +------------+------------+ + +Once again, it may be useful to see how these definitions are used to +evaluate the expression "(2,[1]) == (2,[1,3])" which, after +translation, becomes "(==) d3 (2,[1]) (2,[1,3])": + + (==) d3 (2,[1]) (2,[1,3]) + ==> (#1 d3) (2,[1]) (2,[1,3]) + ==> eqPair d3 (2,[1]) (2,[1,3]) + ==> (==) (#3 d3) 2 2 && (==) (#4 d3) [1] [1,3] + ==> (==) d1 2 2 && (==) (#4 d3) [1] [1,3] + ==> (#1 d1) 2 2 && (==) (#4 d3) [1] [1,3] + ==> primEqInt 2 2 && (==) (#4 d3) [1] [1,3] + ==> True && (==) (#4 d3) [1] [1,3] + ==> (==) (#4 d3) [1] [1,3] + ==> (==) d2 [1] [1,3] + ==> (#1 d2) [1] [1,3] + ==> eqList d2 [1] [1,3] + ==> (==) (#3 d2) 1 1 && (==) d2 [] [3] + ==> (==) d1 1 1 && (==) d2 [] [3] + ==> (#1 d1) 1 1 && (==) d2 [] [3] + ==> primEqInt 1 1 && (==) d2 [] [3] + ==> True && (==) d2 [] [3] + ==> (==) d2 [] [3] + ==> False + + +.ST 14.3.1 Superclasses +------------------- +In general, a type class declaration has the form: + + class context => Class a1 ... an where + type declarations for member functions + default definitions of member functions + +where Class is the name of the new type class which takes n arguments, +represented by distinct type variables a1, ..., an. As in the case of +instance declarations, the context that appears on the left hand side +of the `=>' symbol specifies a list of predicates that must be +satisfied in order to construct any instance of "Class". + +The predicates in the context part of a class declaration are called +the superclasses of Class. This terminology is taken from Haskell +where all classes have a single parameter and each of the predicates in +the context part of a class declaration has the form C a1; in this +situation, any instance of Class must also be an instance of each class +C named in the context. In other words, each such C contains a +superset of the types in Class. + +As an example of a class declaration with a non-empty context, consider +the following declaration from the standard prelude which introduces a +class Ord whose instances are types with both strict (<), (>) and +non-strict (<=), (>=) versions of an ordering defined on their +elements: + + class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +Notice that this definition provides default definitions for all of the +member functions except (<=), so that in general only this single +function needs to be defined to construct an instance of class Ord. + +There are two reasons for defining Eq as a superclass of Ord: + + o The default definition for (<) relies on the use of (/=) taken + from class Eq. In order to guarantee that this is always valid we + must ensure that every instance of Ord must also be an instance of + Eq. + + o Given the definition of a non-strict ordering (<=) on the elements + of a type, it is always possible to construct a definition for the + (==) operator (and hence for (/=)) using the equation: + + x==y = x<=y && y<=x + + There will therefore be no loss in generality by requiring Eq to + be a superclass of Ord, and conversely, no difficulty in defining + an instance of Eq to accompany any instance of Ord for which an + instance of Eq has not already be provided. + + As an example, the following definitions provide an alternative + way to implement the equality operation on elements of the Set + datatype described in section 14.2.3, in terms of the subset + ordering defined in class Ord: + + instance Ord (Set a) => Eq (Set a) where + x == y = x <= y && y <= x + + instance Eq a => Ord (Set a) where + Set xs <= Set ys = all (`elem` ys) xs + + This definition is in fact no less efficient or effective than the + original version. + +Dictionaries for superclasses are dealt with in much the same way as +the instance specific dictionaries described above. For example, the +general layout of a dictionary for an instance of Ord is illustrated in +the following diagram: + + +--------+--------+--------+--------+--------+--------+--------+----- + | | | | | | | | + | (<) | (<=) | (>) | (>=) | max | min | Eq a | ..... + | | | | | | | | + +--------+--------+--------+--------+--------+--------+--------+----- + +Note the use of the seventh element of this dictionary which points to +the dictionary for the appropriate instance of Eq. This is used in the +translation of the default definition for (<) which is equivalent to: + + defLessThan d x y = (<=) d x y && (/=) (#7 d) x y + + +.ST 14.3.2 Combining classes +------------------------ +In general, a dictionary is made up of three separate parts: + + +-------------------+-------------------+-------------------+ + | Implementation | Superclass | Instance specific | + | of class members | Dictionaries | Dictionaries | + | | | | + +-------------------+-------------------+-------------------+ + +Each of these may be empty. We have already seen examples in which +there are no superclass dictionaries (e.g. instances of Eq) and in +which there are no instance specific dictionaries (e.g. Eq Int). +Classes with no member functions (corresponding to dictionaries with no +member functions) are sometimes useful as a convenient abbreviation for +a list of predicates. For example: + + class C a where cee :: a -> a + class D a where dee :: a -> a + + class (C a, D a) => CandD a + +makes CandD a an abbreviation for the context (C a, D a). Thinking of +single parameter type classes as sets of types, the type class CandD +corresponds to the intersection of classes C and D. + +Just as the type inferred for a particular function definition or +expression does not involve type synonyms unless explicit type +signatures are used, the Gofer type system will not use a single +predicate of the form CandD a instead of the two predicates C a and D a +unless explicit signatures are used: + + ? :t dee . cee + \d129 d130 -> dee d130 . cee d129 :: (C a, D a) => a -> a + ? :t dee . cee :: CandD a => a -> a + \d129 -> dee (#2 d129) . cee (#1 d129) :: CandD a => a -> a + ? + +In Haskell, all instances of a class such as CandD must have +explicit declarations, in addition to the corresponding declarations +for instances for C and D. This problem can be avoided by using the +more general form of instance declaration permitted in Gofer; a single +instance declaration: + + instance CandD a + +is all that is required to ensure that any instance of CandD can be +obtained, so long as corresponding instances for C and D can be found. + + +.ST 14.3.3 Simplified contexts +-------------------------- +Consider the function defined by the following equation: + + eg1 x = [x] == [x] || x == x + +This definition does not restrict the type of x in any way except that, +if x :: a, then there must be instances Eq [a] and Eq a which are used +for the two occurrences of the (==) operator in the equation. We might +therefore expect the type of eg1 to be: + + (Eq [a], Eq a) => a -> Bool + +with translation: + + eg1 d1 d2 x = (==) d1 [x] [x] || (==) d2 x x + +However, as can be seen from the case where a=Int illustrated in +section 14.3, given d1::Eq [a] we can always find a dictionary for Eq a +by taking the third element of d1 i.e. (#3 d1)::Eq a. Since it is more +efficient to select an element from a dictionary than to complicate +both type and translation with extra parameters, the type assigned to +"eg1" by default is: + + Eq [a] => a -> Bool + +with translation: + + eg1 d1 x = (==) d1 [x] [x] || (==) (#3 d1) x x + +In general, given a set of predicates corresponding to the instances +required by an expression, Gofer will always attempt to find the +smallest possible subset of these predicates such that all of the +required dictionaries can still be obtained, whilst minimising the +number of dictionary parameters that are used. + +The original type and translation for eg1 given above can be produced +by including an explicit type signature in the file containing the +definition of eg1: + + eg1 :: (Eq [a], Eq a) => a -> Bool + eg1 x = [x] == [x] || x == x + +But even with this definition, Gofer will still always try to minimise +the number of dictionaries used in any particular expression: + + ? :t eg1 + \d153 -> eg1 d153 (#3 d153) :: Eq [a] => a -> Bool + ? + +As another example, consider the expression "(\x y-> x==x || y==y)". +The type and translation assigned to this term can be found directly +using Gofer: + + ? :t (\x y-> x==x || y==y) + \d121 d122 x y -> (==) d122 x x || + (==) d121 y y + :: (Eq b, Eq a) => a -> b -> Bool + ? + +Note that the translation has two dictionary parameters d121 and d122 +corresponding to the two predicates Eq a and Eq b respectively. Since +both of these dictionaries can be obtained from a dictionary for the +predicate Eq (a,b), we can use an explicit type signature to produce a +translation which needs only one dictionary parameter: + + ? :t (\x y-> x==x || y==y) :: Eq (a,b) => a -> b -> Bool + \d121 x y -> (==) (#3 d121) x x || + (==) (#4 d121) y y + :: Eq (a,b) => a -> b -> Bool + ? + + +.cc 8 +.ST 14.4 Other issues +----------------- + +.ST 14.4.1 Unresolved overloading +----------------------------- +Consider the use of the (==) operator in the following three +situations: + + o In the expression "2 == 3", it is clear that the appropriate value + for the equality operator in this case is primIntEq as defined by + the instance declaration for Eq Int. The expression can therefore + be translated to "primEqInt 2 3". + + o In the function definition "f x = x==x", we cannot completely + determine the appropriate value for (==) because it depends on the + type assigned to the variable "x", which may itself vary with + different uses of the function "f". It is however possible to add + an extra parameter to the definition, giving "f d x = (==) d x x" + and taking the type of "f" to be Eq a => a -> Bool. + + In this way, the problem of finding the appropriate definition for + the (==) operator is deferred until the function is actually used. + + o In the expression "[]==[]", the appropriate value for (==) must be + obtained from the dictionary for some instance of the form Eq [a], + but there is not sufficient information in the expression to + determine what the value of the type variable a should be. + + Looking back to the instance declaration for Eq [a], we find that + the definition of (==) depends on the value of the dictionary for + the instance Eq a. In this particular case, it is clear that the + expression will always evaluate to True, regardless of the value + of this dictionary. Unfortunately, the only way that this can be + detected is by evaluating the expression to see if the calculation + can be completed without reference to the dictionary value (see + the comments in the aside at the end of this section). + + Attempting to evaluate this expression in Gofer will therefore + result in an error message indicating that the expression does not + contain sufficient information to resolve the use of overloading + in the expression: + + ? [] == [] + ERROR: Unresolved overloading + *** type : Eq [a] => Bool + *** translation : \d129 -> (==) d129 [] [] + ? + + Note that the expression has been converted into a lambda + expression using the dictionary variable d129 to represent the + dictionary for the unknown instance Eq [a]. + + One simple way to resolve the overloading in an expression of this + kind is to use an explicit type signature. For example, if we + specify that the second empty list is an empty list of type [Int]: + + ? [] == ([]::[Int]) + True + (2 reductions, 9 cells) + ? + +The same problem occurs in Haskell, where it is described using the +idea of an `ambiguous type' -- i.e. a type expression of the form +context => type where one or more of the type variables appearing in +the given context do not appear in the remaining part of the type +expression. + +Further examples of unresolved overloading occur with other classes. +As an example consider the class Reader defined by: + + class Reader a where + parse :: String -> a + unparse :: a -> String + +whose member functions provide methods for obtaining the string +representation of an element of an instance type, and for converting +such representations back into the original values. (The standard +Haskell Text class contains similar functions.) Now consider the +expression "parse . unparse" which maps values from some instance of +Reader to values of another instance via an intermediate string +representation. + + ? parse . unparse + ERROR: Unresolved overloading + *** type : (Reader a, Reader b) => a -> b + *** translation : \d129 d130 -> parse d130 . unparse d129 + ? + +One of the first things that might surprise the reader here is that the +value produced by "parse . unparse" does not have to be of the same +type as the argument; for example, we would not usually expect to have +any sensible interpretation for a floating point number obtained from +the string representation of a boolean value! + +This can be fixed by using an explicit type declaration, although the +expression still produces unresolved overloading: + + ? (parse . unparse) :: Reader a => a -> a + ERROR: Unresolved overloading + *** type : Reader a => a -> a + *** translation : \d130 -> parse d130 . unparse d130 + ? + +Notice however that the type of this expression is not ambiguous so +that the unresolved overloading in this example can be eliminated when +the function is actually used: + + ? ((parse . unparse) :: Reader a => a -> a) 'a' + 'a' + (4 reductions, 11 cells) + ? + +A more serious problem occurs with the expression "unparse . parse" +which maps string values to string values via some intermediate type. +Clearly this will lead to a problem with unresolved overloading: + + ? unparse . parse + ERROR: Unresolved overloading + *** type : Reader a => String -> String + *** translation : \d130 -> unparse d130 . parse (#0 d130) + ? + +Notice that the type obtained in this case is ambiguous; the type +variable a which appears in the predicate Reader a does not appear in +the type String -> String. There are a number of ways of resolving +this kind of ambiguity: + + o Using an explicitly typed expression: Assuming for example that + Char is an instance of Reader, we can write: + + ? unparse . (parse :: String -> Char) + v113 {dict} . v112 {dict} + (5 reductions, 42 cells) + ? + + without any ambiguity. If such type signatures are used in a + number of places, it might be better to define an auxiliary + function and use that instead: + + charParse :: String -> Char + charParse = parse + + ? unparse . charParse + v113 {dict} . charParse + (4 reductions, 37 cells) + ? + + In such situations, it is perhaps worth asking if overloaded + functions are in fact the most appropriate solution for the + problem at hand! + + o Using an extra dummy parameter in a function definition. In a + definition such as: + + f = unparse . parse + + we can introduce an additional dummy parameter `x' which is not + used except to determine the type of the result produced by parse + in f: + + f x = unparse . (parse `asTypeOf` (\""->x)) + + where the standard prelude operator `asTypeOf` defined by: + + asTypeOf :: a -> a -> a + x `asTypeOf` _ = x + + is used to ensure that the type of parse in the definition of f is + the same as that of the function (\""->x) -- in other words, the + type must be String -> a where a is the type of the variable x. + + The resulting type for f is: + + f :: Reader a => a -> String -> String + + Notice how the addition of the dummy parameter has been used to + eliminate the ambiguity present in the original type. + + This kind of `coding trick' is rather messy and is not recommended + for anything but the simplest examples. + +[ASIDE: The idea of evaluating an expression with an ambiguous type to +see if it does actually need the unspecified dictionaries could have +been implemented quite easily in Gofer using an otherwise unused +datatype Unresolved and generating instance declarations such as: + + instance Eq Unresolved where + (==) = error "unresolved overloading for (==)" + (/=) = error "unresolved overloading for (/=)" + +for each class. Given a particular expression, we can then use the +type Unused in place of any ambiguous type variables in its type. The +evaluation of the expression could then be attempted, either completing +successfully if the dictionaries are not required, but otherwise +resulting in a run-time error. + +This approach is not used in Gofer; instead, the programmer is notified +of any unresolved polymorphism when the program is type checked, +avoiding the possibility that a program might contain an undetected +ambiguity.] + + +.ST 14.4.2 `Recursive' dictionaries +------------------------------- +Unlike Haskell, there are no restrictions on the form of the predicates +that may appear in the context part of a Gofer class or instance +declaration. This has a number of potentially useful applications +because it enables the Gofer programs to use mutually `recursive' +systems of dictionaries. + +One example of this is the ability to implement a large family of +related functions using a group of classes instead of having to use a +single class. The following example illustrates the technique with an +alternative definition for the class Eq in which the (==) and (/=) +operators are placed in different classes: + + class Neq a => Eq a where (==) :: a -> a -> Bool + + class Eq a => Neq a where (/=) :: a -> a -> Bool + x/=y = not (x == y) + + +[ASIDE: These declarations clash with those in the standard prelude and +hence cannot actually be used in Gofer unless a modified version of the +standard prelude is used instead.] + +If we then give instance declarations: + + instance Eq Int where (==) = primEqInt + instance Neq Int + +and try to evaluate the expression "2==3" then the following system of +dictionaries will be generated: + + d1 :: Eq Int d2 :: Neq Int + +-----------+-----------+ +-----------+-----------+ + | | | | | | + +-->| primEqInt |d2::Neq Int+----->| defNeq d2 |d1::Eq Int +---+ + | | | | | | | | + | +-----------+-----------+ +-----------+-----------+ | + | | + +------------------------------<-------------------------------+ + +where the function "defNeq" is derived from the default definition in +the class Neq and is equivalent to: + + defNeq d x y = not ((==) (#2 d) x y) + +Incidentally, if the instance declaration for Neq Int above had been +replaced by: + + instance Neq a + +then the effect of these declarations would be similar to the standard +definition of the class Eq, except that it would not be possible to +override the default definition for (/=). In other words, this +approach would give the same effect as defining (/=) as a top-level +function rather than a member function in the class Eq: + + class Eq a where (==) :: a -> a -> Bool + + (/=) :: Eq a => a -> a -> Bool + x /= y = not (x == y) + +There are other situations in which recursive dictionaries of the kind +described above can be used. A further example is given in the +following section. Unfortunately, the lack of restrictions on the form +of class and instance declarations can also lead to problems in some +(mostly pathological) cases. As an example, consider the class: + + class Bad [a] => Bad a where bad :: a -> a + +Without defining any instances of Bad, it is not possible to construct +any dictionaries for instances of Bad: + + ? bad 2 + ERROR: Cannot derive instance in expression + *** Expression : bad d126 2 + *** Required instance : Bad Int + ? + +If however we add the instance declarations: + + instance Bad Int where bad = id + instance Bad [a] where bad = id + +then any attempt to construct a dictionary for Bad Int will also +require a dictionary for the superclass Bad [Int] and then for the +superclass of that instance Bad [[Int]] etc... Since Gofer has only a +finite amount of space for storing dictionaries, this process will +eventually terminate when that space has been used up: + + ? bad 2 + ERROR: Dictionary storage space exhausted + ? + +[ASIDE: depending on the configuration of your particular version of +Gofer and on the nature of the class and instance declarations that are +involved, an alternative error message "ERROR: Too many type variables +in type checker" may be produced instead of the message shown above.] + +From a practical point of view, this problem is unlikely to cause too +many real difficulties: + + o Class declarations involving predicates such as those in the + declaration of Bad are unlikely to be used in realistic programs. + + o All dictionaries are constructed before evaluation begins. This + process is guaranteed to terminate because each new dictionary + that is created uses up part of the space used to hold Gofer + dictionaries. The construction process will either terminate + successfully once complete, or be aborted as soon as all of the + dictionary space has been used. + +It remains to see what impact (if any) this has on realistic programs, +and if later versions of Gofer should be modified to impose some +syntactic restrictions (as in Haskell) or perhaps some form of static +checking of the contexts appearing in class and instance declarations. + + +.ST 14.4.3 Classes with multiple parameters +--------------------------------------- +Gofer is the first language to support the use of type classes with +multiple parameters. This again is an experimental feature of the +language, intended to make it possible to explore the claims from a +number of researchers about the use of such classes. + +Initial experiments suggest that multiple parameter type classes are +likely to lead to large numbers of problems with unresolved +overloading. Ultimately, this may mean that such classes are only of +practical use in explicitly typed languages, or alternatively that a +more powerful and general defaulting mechanism (similar to that used in +Haskell with numeric classes) is required to support user controlled +overloading resolution. + +The following declaration introduces a class Iso whose elements are +pairs of isomorphic types: + + class Iso b a => Iso a b where iso :: a -> b + +The single member function "iso" represents the isomorphism mapping +elements of type a to corresponding elements of type b. Note the +`superclass' context in this declaration which formalises the idea that +if a is isomorphic to b then b is also isomorphic to a. The class Iso +therefore provides further examples of the recursive dictionaries +described in the previous section. + +The fact that any type is isomorphic to itself can be described by the +following instance declaration: + + instance Iso a a where iso x = x + +For example, the dictionary structure created in order to evaluate the +expression "iso 2 = 3" is: + + d :: Iso Int Int + +--------------+--------------+ + | | | + +-->| id |d::Iso Int Int+--+ + | | | | | + | +--------------+--------------+ | + | | + +------------------<-----------------+ + + ? iso 2 == 3 + False + (4 reductions, 11 cells) + ? + +Our first taste of the problems to come occurs when we try to evaluate +the expression "iso 2 == iso 3": + + ? iso 2 == iso 3 + ERROR: Unresolved overloading + *** type : (Eq a, Iso Int a) => Bool + *** translation : \d130 d132 -> (==) d130 (iso d132 2) (iso d132 3) + ? + +In this case, the "iso" function is used to map the integers 2 and 3 to +elements of some type a, isomorphic to Int, and the values produced are +then compared using (==) at the instance Eq a; there is no way of +discovering what the value of a should be without using an explicit +type signature. + +Further instances can be defined. The following two declarations are +needed to describe the (approximate) isomorphism between lists of pairs +and pairs of lists: + + instance Iso [(a,b)] ([a],[b]) where + iso xs = (map fst xs, map snd xs) + + instance Iso ([a],[b]) [(a,b)] where + iso (xs,ys) = zip xs ys + +Unfortunately, even apparently straightforward examples give problems +with unresolved overloading, forcing the use of explicit type +declarations: + + ? iso [(1,2),(3,4)] + ERROR: Unresolved overloading + *** type : Iso [(Int,Int)] a => a + *** translation : \d126 -> iso d126 [(1,2),(3,4)] + + ? (iso [(1,2),(3,4)]) :: ([Int],[Int]) + ([1, 3],[2, 4]) + (22 reductions, 64 cells) + ? + +A second example of a multiple parameter type class is defined as +follows: + + class Ord a => Collects a b where + emptyCollection :: b + addToCollection :: a -> b -> b + listCollection :: b -> [a] + +The basic intuition is that the predicate Collects a b indicates that +elements of type b can be used to represent collections of elements of +type a. A number of people have suggested using type classes in this +way to provide features similar to the (similarly named, but otherwise +different) classes that occur in object-oriented languages. + +Obvious implementations involve the use of ordered lists or binary +search trees defined by instances of the form: + + data STree a = Empty | Node a (STree a) (STree a) + + instance Collects a [a] where .... + instance Collects a (STree a) where .... + +Once again, there are significant problems even with simple examples +using these functions. As an example, the standard way of defining a +function of type: + + Collects a b => [a] -> b + +mapping a list of values to a collection of those values using the +higher order function "foldr": + + listToCollection = foldr addToCollection emptyCollection + +actually produces a function with ambiguous type: + + ? :t foldr addToCollection emptyCollection + \d139 d140 -> foldr (addToCollection d140) (emptyCollection d139) + :: (Collects c b, Collects a b) => [a] -> b + ? + +which cannot be resolved, even with an explicit type declaration. + + +.ST 14.4.4 Overloading and numeric values +------------------------------------- +One of the most common uses of overloading is to allow the use of the +standard arithmetic operators such as (+), (*) etc. on the elements of +a range of numeric types including integers and floating point values +in addition to user defined numeric types such as arbitrary precision +integers, complex and rational numbers, vectors and matrices, +polynomials etc. In Haskell, these features are supported by a number +of built-in types and a complex hierarchy of type classes describing +the operations defined on the elements of each numeric type. + +As an experimental language, intended primarily for the investigation +of general purpose overloading, Gofer has only two built-in numeric +types; Int and Float (the second of which is not supported in all +implementations). Similarly, although the Gofer system could be used +to implement the full hierarchy of Haskell numeric classes, the +standard prelude uses a single numeric type class Num defined by: + + class Eq a => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +The first four member functions (+), (-), (*), (/) are the standard +arithmetic functions on instances of Num, whilst "negate" denotes unary +negation. The final member function, fromInteger is used to coerce any +integer value to the corresponding value in another instance of Num. +An expression such as "fromInteger 3" is called an overloaded numeric +constant and has type Num a => a indicating that it can be used as a +value of any instance of Num. See below for examples. + +Both Float and Int are defined as instances of Num using primitive +functions for integer and floating point arithmetic: + + instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + + instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +These definitions make it possible to evaluate numeric expressions +involving both types: + + ? 2 + 3 + 5 + (3 reductions, 6 cells) + ? 3.2 + 4.321 + 7.521 + (3 reductions, 13 cells) + ? + +Note however that any attempt to evaluate an expression mixing +different arithmetic types is likely to cause a type error: + + ? 4.2 * 4 + ERROR: Type error in application + *** expression : 4.2 * 4 + *** term : 4.2 + *** type : Float + *** does not match : Int + ? + +Further problems occur when we try to define functions intended to be +used with arbitrary instances of Num rather than specific numeric +types. As an example of this, the standard prelude function "sum", +roughly equivalent to: + + sum [] = 0 + sum (x:xs) = x + sum xs + +has type [Int] -> Int, rather than the more general Num a => [a] -> a +which could be used to find the sum of a list of numeric values in any +instance of Num. The problem in this particular case is caused by the +integer constant 0 in the first line of the definition. Replacing this +with the expression fromInteger 0 leads to the following definition for +a generic sum function of the required type: + + genericSum :: Num a => [a] -> a + genericSum [] = fromInteger 0 + genericSum (x:xs) = x + genericSum xs + +For example: + + ? genericSum [1,2,3] + 6 + (10 reductions, 18 cells) + ? genericSum [1.0,2.0,3.0] + 6.0 + (11 reductions, 27 cells) + ? + +The fromInteger function can also be used to solve the previous +problem: + + ? 4.2 * fromInteger 4 + 16.8 + (3 reductions, 13 cells) + ? + +In Haskell, any integer constant k appearing in an expression is +treated as if the programmer had actually written "fromInteger k" so +that both of the preceding problems are automatically resolved. +Unfortunately, this also creates some new problems; applying the +function fromInteger to each integer constant in the previous examples +causes problems with unresolved overloading: + + ? fromInteger 2 + fromInteger 3 + ERROR: Unresolved overloading + *** type : Num a => a + *** translation : \d143 -> (+) d143 (fromInteger d143 2) + (fromInteger d143 3) + ? + +Once again, Haskell provides a solution to this problem in the form of +a `default mechanism' for numeric types which, once the following +problem has been detected, will typically `default' the unknown type +represented by the type variable a above to be Int, so that the result +is actually equivalent to the following: + + ? (fromInteger 2 + fromInteger 3) :: Int + 5 + (4 reductions, 8 cells) + ? + +There are a number of problems with the Haskell default mechanism; both +theoretical and practical. In addition, if a default mechanism of some +form is used then it should also be capable of dealing with arbitrary +user-defined type classes, rather than a small group of `standard' +classes, in order to provide solutions to the unresolved overloading +problems described in previous sections. Therefore, for the time +being, Gofer does not support any form of default mechanism and +overloaded numeric constants can only be obtained by explicit use of +the fromInteger function. + + +.ST 14.4.5 Constants in dictionaries +-------------------------------- +The Gofer system constructs new dictionaries as necessary, and deletes +them when they are no longer required. At any one time, there is at +most one dictionary for each instance of a class. Coupled with lazy +evaluation, this has a number of advantages for classes in which member +functions are defined by variable declarations as in section 9.10. As +an example, consider the class Finite defined by: + + class Finite a where members :: [a] + +The only member in this class is a list enumerating the elements of the +type. For example: + + instance Finite Bool where members = [False, True] + + instance (Finite a, Finite b) => Finite (a,b) where + members = [ (x,y) | x<-members, y<-members ] + +In order to overcome any problems with unresolved overloading, explicit +type signatures are often needed to resolve overloading: + + ? members :: [Bool] + [False, True] + (6 reductions, 26 cells) + ? length (members :: [((Bool,Bool),(Bool,Bool))]) + 16 + (103 reductions, 195 cells) + ? + +In some cases, the required overloading is implicit from the context +and no additional type information is required, as in the following +example: + + ? [ x && y | (x,y) <- members ] + [False, False, False, True] + (29 reductions, 90 cells) + ? + +We can also use the technique of passing a `dummy' parameter to resolve +overloading problems in a function definition: + + size :: Finite a => a -> Int + size x = length (members `asTypeOf` [x]) + +which calculates the number of elements of a finite type, given an +arbitrary element of that type: + + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? + +Now consider the expression "size (True,False) + size (True,False)". +At first glance, we expect this to repeat the calculation in the +previous example two times, requiring approximately twice as many +reductions and cells as before. However, before this expression is +evaluated, Gofer constructs a dictionary for Finite (Bool,Bool). The +evaluation of the first summand forces Gofer to evaluate the value for +"members" in this dictionary. Since precisely the same dictionary is +used to calculate the value of the second summand, the evaluation of +"members" is not repeated and the complete calculation actually uses +rather fewer reductions and cells: + + ? size (True,False) + size (True,False) + 8 + (51 reductions, 90 cells) + ? + +On the other hand, repeating the original calculation gives exactly the +same number of reductions and cells as before, because the dictionaries +constructed at the beginning of each calculation are not retained for +use in subsequent calculations. + +We can force Gofer to construct specific dictionaries whilst reading +from a file of definitions, so that they are not deleted at the end of +each calculation, using an explicitly typed variable definition such +as: + + boolBoolMembers = members :: [(Bool,Bool)] + +This forces Gofer to construct the dictionary Finite (Bool,Bool) when +the file of definitions is loaded and prevents it from being deleted at +the end of each calculation. Having loaded a file containing this +definition, the first two attempts to evaluate "size (True,False)" +give: + + ? size (True,False) + 4 + (31 reductions, 60 cells) + ? size (True,False) + 4 + (20 reductions, 32 cells) + ? + + +.ST 14.4.6 The monomorphism restriction +----------------------------------- +This section describes a technique used to limit the amount of +overloading used in the definition of certain values to avoid a number +of technical problems. This particular topic has attracted quite a lot +of attention within the Haskell community where it is affectionately +known as the `dreaded monomorphism restriction'. Although the initial +formulation of the rule was rather cumbersome and limiting, the current +version used in both Gofer and Haskell is unlikely to cause any +problems in practice. In addition, many of the examples used to +motivate the need for the monomorphism restriction in Haskell occur as +a result of the use of implicitly overloaded numeric constants, +described in section 14.4.4, and hence do not occur in Gofer. + +The monomorphism restriction takes its name from the way in which it +limits the amount of polymorphism that can be used in particular kinds +of declaration. Although we touch on this point in the following +discussion, the description given here uses an equivalent, but less +abstract approach, based on observations about the implementation of +overloaded functions. + +Basic ideas: +------------ +As we have seen, the implementation of overloading used by Gofer +depends on being able to add extra arguments to a function definition +to supply the required dictionary parameters. For example, given a +function definition such as: + + isElement x [] = False + isElement x (y:ys) = x==y || isElement x ys + +we first add a dictionary parameter for the use of the overloaded (==) +operator on the right hand side, obtaining: + + isElement x [] = False + isElement x (y:ys) = (==) d x y || isElement x ys + +Finally, we have to add the variable d as a new parameter for the +function isElement, on both the left and right hand sides of the +definition: + + isElement d x [] = False + isElement d x (y:ys) = (==) d x y || isElement d x ys + +The monomorphism restriction imposes conditions which prevent this last +step from being used for certain kinds of value binding. + +.cc 5 +Declaration groups: +------------------- +Before giving the full details, it is worth pointing out that, in +general, the monomorphism restriction affects groups of value +declarations rather than just individual definitions. To illustrate +this point, consider the function definitions: + + f x y = x==y || g x y + g x y = not (f x y) + +Adding an appropriate dictionary parameter for the (==) operator gives: + + f x y = (==) d x y || g x y + g x y = not (f x y) + +The next stage is to make this dictionary variable into an extra +parameter to the function f wherever it appears, giving: + + f d x y = (==) d x y || g x y + g x y = not (f d x y) + +But now the right hand side of the second definition mentions the +dictionary variable d which must therefore be added as an extra +parameter to g: + + f d x y = (==) d x y || g d x y + g d x y = not (f d x y) + +In other words, if dictionary parameters are added to any particular +function definition, then each use of that function in another +definition will also be require extra dictionary parameters. As a +result, the monomorphism restriction has to be applied to the smallest +groups of declarations such that any pair of mutually recursive +bindings are in the same group. + +As the example above shows, if one (or more) of the bindings in a given +declaration group is affected by the monomorphism restriction so that +the appropriate dictionary parameters cannot be added as parameters for +that definition, then the same condition must also be imposed on all of +the other bindings in the group. [Adding the extra parameter to f in +the example forces us to add an extra parameter for g; if extra +parameters were not permitted for g then they could not be added to f.] + +.cc 5 +Restricted bindings: +-------------------- +There are three main reasons for avoiding adding dictionary parameters +to a particular value binding: + + o Dictionary parameters unnecessary. If the dictionary values are + completely determined by context then it is not necessary to pass + the appropriate values as dictionary parameters. For example, the + function definition: + + f x = x == 0 || x == 2 + + can be translated as: + + f x = (==) {dict} x 0 || (==) {dict} x 2 + + where, in both cases, the symbol {dict} denotes the dictionary for + Eq Int. As a further optimisation, once the dictionary is fully + determined, this can be simplified to: + + f x = primEqInt x 0 || primEqInt x 2 + + o Dictionary parameters cannot be added in a pattern binding. One + potential solution to this problem would be to replace the pattern + binding by an equivalent set of function bindings. In practice, + we do not use this technique because it typically causes ambiguity + problems, as illustrated by the pattern binding: + + (plus,times) = ((+), (*)) + + Translating this into a group of function bindings gives: + + newVariable = ((+), (*)) + plus = fst newVariable -- fst (x,_) = x + times = snd newVariable -- snd (_,y) = y + + The type of newVariable is (Num a, Num b) => (a->a->a, b->b->b) so + that the correct translation of these bindings using two + dictionary variables gives: + + newVariable da db = ((+) da, (*) db) + plus da db = fst (newVariable da db) + times da db = snd (newVariable da db) + + and hence the correct types for plus and times are: + + plus :: (Num a, Num b) => a -> a -> a + times :: (Num a, Num b) => b -> b -> b + + both of which are ambiguous. + + o Adding dictionary parameters may translate a variable definition + into a function definition, loosing the benefits of shared + evaluation. As an example, consider the following definition + using the function "size" and the class Finite described in the + previous section: + + twiceSize x = n + n where n = size x + + Since the variable n is defined using a local definition, we would + not expect to have to evaluate size x more than once to determine + the value of twiceSize. However, adding extra dictionary + parameters without restriction gives: + + twiceSize d x = n d + n d where n d = size d x + + Now that n has been replaced by a function, the evaluation will be + repeated, once for each occurrence of the expression "n d". In + order to avoid this kind of problem, the monomorphism restriction + does not usually allow extra parameters to be added to a variable + definition. Thus the original definition above will be translated + to give: + + twiceSize d x = n + n where n = size d x + + Note that the same rule is applied to variable definitions at the + top-level of a file of definitions, resulting in an error if any + dictionary parameters are required for the right hand side of the + definition. As an example of this: + + twiceMembers = members ++ members + + which produces an error message of the form: + + ERROR "ex" (line 157): Unresolved top-level overloading + *** Binding : twiceMembers + *** Inferred type : [_7] + *** Outstanding context : Finite _7 + ? + + [COMMENT: A type expression of the form _n (such as _7 in this + particular example) represents a fixed (i.e. monomorphic) type + variable.] + + In the case of a variable declaration, the monomorphism + restriction can be overcome by giving an explicit type signature + including an appropriate context, to indicate that the variable + defined is intended to be used as an overloaded value. In this + case, we need only include the declaration: + + twiceMembers :: Finite a => [a] + + in the file containing the definition for twiceMembers to suppress + the previous error message and allow the function to be used as a + fully overloaded variable. + + Note that the monomorphism restriction interferes with the use of + polymorphism. For example, the definition: + + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers = members ++ members + + will not be accepted because the monomorphism restriction forces + the local definition of "twiceMembers" to be restricted to a + single overloading (the dictionary parameter supplied to each use + of members must be constant throughout the local definition): + + ERROR "ex" (line 12): Type error in type signature expression + *** term : twiceMembers + *** type : [(Bool,Bool)] + *** does not match : [Bool] + ? + + Once again, this problem can be fixed using an explicit type + declaration: + + aNumber = length (twiceMembers::[Bool]) + + length (twiceMembers::[(Bool,Bool)]) + where twiceMembers :: Finite a => [a] + twiceMembers = members ++ members + + +Formal definition: +------------------ +The examples above describe the motivation for the monomorphism +restriction, captured by the following definition: + +Dictionary variables will not be used as extra parameters in the +definition of a value in a given declaration group G if: + + either: G includes a pattern binding + + or: G includes a variable declaration, but does not include an + explicit type signature for any of the variables in the + group. + +If neither of these conditions hold, then equivalent sets of dictionary +parameters will be added to each declaration in the group. + +.pa +.>appx_a +.ST APPENDIX A: SUMMARY OF GRAMMAR + +This section gives a summary of the grammar for the language used by +Gofer. The non-terminals and describe the syntax of +expressions that can be entered into the Gofer interpreter and that of +files of definitions that can be loaded into Gofer respectively. + +The following notational conventions are used in the Grammar which is +specified using a variant of BNF: + + o are used to distinguish names of nonterminals from + keywords. + + o vertical | bars are used to separate alternatives. + + o {braces} enclose items which may be repeated zero or more times. + + o [brackets] are used for optional items. + + o (parentheses) are used for grouping. + + o "quotes" surround characters which might otherwise be confused with + the notations introduced above. + +The following terminal symbols are used but not defined by the grammar: + + VARID identifier beginning with lower case letter as described in + section 6. + CONID like VARID, but beginning with upper case letter. + VAROP operator symbol not beginning with a colon, as described in + section 6. + CONOP constructor function operator, like VAROP, but beginning + with a colon character. + INTEGER integer constant, as described in section 7.3. + FLOAT floating point constant, as described in section 7.4. + CHAR character constant, as described in section 7.5. + STRING string constant, as described in section 7.7. + + +Top-level grammar +----------------- + + ::= "{" "}" module + + ::= [] top-level expression + + ::= ; multiple declarations + | data = datatype declaration + | type = synonym declaration + | infixl [] {, } fixity declarations + | infixr [] {, } + | infix [] {, } + | primitive :: primitive bindings + | class declaration + | instance declaration + | value declarations + + ::= CONID {VARID} type declaration lhs + + ::= "|" multiple constructors + | CONOP infix constructor + | CONID {} constructor, n>=0 + + ::= , multiple bindings + | primitive binding + +Type expressions +---------------- + + ::= [ => ] [qualified] type + + ::= "(" [ {, }] ")" general form + | singleton context + ::= CONID {} predicate + + ::= [ -> ] function type + ::= CONID {} datatype or synonym + | + ::= VARID type variable + | "(" ")" unit type + | "(" ")" parenthesised type + | "(" , {,} ")" tuple type + | "[" "]" list type + +Class and instance declarations +------------------------------- + + ::= class [ =>] [] + ::= where "{" "}" class body + ::= ; multiple declarations + | {, } :: member functions + | [] default bindings + + ::= instance [ =>] [] + ::= where "{" "}" instance body + ::= ; multiple declarations + | [] member definition + +Value declarations +------------------ + + ::= ; multiple declarations + | {, } :: type declaration + | [] function binding + | [] pattern binding + + ::= = simple right hand side + | {} guarded right hand sides + + ::= "|" = guarded right hand side + + ::= where "{" "}" local definitions + + ::= function of arity 0 + | infix operator + | "(" ")" section-like notation + | "(" ")" + | function with argument + | "(" ")" parenthesised lhs + +Expressions +----------- + + ::= \ {} -> lambda expression + | let "{" "}" in local definition + | if then else conditional expression + | case of "{" "}" case expression + | :: typed expression + | + ::= operator application + | + ::= - negation + | + ::= function application + | + ::= variable + | constructor + | INTEGER integer literal + | FLOAT floating point literal + | CHAR character literal + | STRING string literal + | "(" ")" unit element + | "(" ")" parenthesised expr. + | ( ) sections + | ( ) + | "[" "]" list expression + | "(" , {, } ")" tuple + + ::= [ {, } ] enumerated list + | "|" list comprehension + | .. arithmetic sequence + | , .. + | .. + | , .. + ::= , multiple qualifiers + | <- generator + | = local definition + | boolean guard + + ::= ; multiple alternatives + | [] alternative + ::= -> single alternative + | {} guarded alternatives + ::= "|" -> guarded alternative + +Patterns +-------- + + ::= operator application + | + (n+k) pattern + | + ::= application + | + ::= variable + | @ as pattern + | ~ irrefutable pattern + | _ wildcard + | constructor + | INTEGER integer literal + | CHAR character literal + | STRING string literal + | "(" ")" unit element + | "(" ")" parenthesised expr. + | ( ) sections + | ( ) + | "[" [ {, } ] "]" list + | "(" , {, } ")" tuple + +Variables and operators +----------------------- + + ::= | "(" - ")" variable + ::= | | - operator + + ::= VARID | "(" VAROP ")" variable identifier + ::= VAROP | ` VARID ` variable operator + + ::= CONID | "(" CONOP ")" constructor identifier + ::= CONOP | ` CONID ` constructor operator + +.pa +.>appx_b +.ST APPENDIX B: CONTENTS OF STANDARD PRELUDE + +.in ../standard.prelude +.pa +.>appx_c +.ST APPENDIX C: RELATIONSHIP WITH HASKELL 1.1 + +The language supported by Gofer is both syntactically and semantically +similar to that of the functional programming language Haskell as +defined in the report for Haskell version 1.1 [5]. This section +details the differences between the two languages, outlined briefly in +section 2. + +.cc 5 +Haskell features not included in Gofer: +--------------------------------------- + o Modules + + o Arrays + + o Derived instances for standard classes -- the ability to construct + instances of particular classes automatically. + + o Default mechanism for eliminating unresolved overloading involving + numeric and standard classes. Since Gofer is an experimental + system, it can be used with a range of completely different + prelude files; there is no concept of `standard classes'. + + o Overloaded numeric constants. In the absence of a defaulting + mechanism as mentioned in the previous item, problems with + unresolved overloading make implicitly typed programming involving + numeric constants impractical in an interpreter based system. + + o Full range of numeric types and classes. Gofer has only two + primitive numeric types Int and Float (the second of which is not + supported in the PC version). Although is would be possible to + modify the standard prelude so that Gofer uses the same class + hierarchy as Haskell, this is unnecessarily sophisticated for the + intended uses of Gofer. + + o Datatype definitions in Haskell may involve class constraints such + as: + + data Ord a => Set a = Set [a] + + It is not clear how such constraints should be interpreted + (particularly in the light of the extended form of constraints + used by Gofer) in such a way to make them useful whilst avoiding + unwanted ambiguity problems. + + +.cc 5 +Gofer features not supported in Haskell: +---------------------------------------- + o Type classes may have multiple parameters. + + o Predicates in type expressions may involve arbitrary type + expressions, not just type variables as used in Haskell. + + o Instances of type classes can be defined at non-overlapping, but + otherwise arbitrary types, as described in section 14.2.5. + + o List comprehensions may include local definitions, specified by + qualifiers of the form = as described in section 10.2. + + o No restrictions are placed on the form of predicates that appear + in the context for a class or instance declaration. This has a + number of consequences, including the possibility of using + (mutually) recursive groups of dictionaries, but means that + decidability of the predicate entailment relation may be lost. + This is not a great problem in practice, since all dictionary + construction is performed before evaluation and supposedly + non-terminating dictionary constructions will actually generate an + error due to the limited amount of space available for holding + dictionaries (see section 14.4.2). + + +.cc 5 +Other differences: +------------------ + o Whilst superficially similar the approach to type classes in Gofer + is quite different from that used in Haskell. In particular, the + approach used in Gofer ensures that all necessary dictionaries are + constructed before the evaluation of an expression begins, rather + than being built (possibly several times) during the evaluation as + is the case with Haskell. See section 14 and reference [11] for + further details. + + o Input/Output facilities - Gofer supports only a subset of the + requests available in Haskell. In principle, it should not be too + difficult to add most of the remaining forms of request (with the + exception of those associated with binary files) to Gofer. The + principal motivation for including the I/O facilities in Gofer was + to make it possible to experiment with simple interactive + programs. + + o In Gofer, unary minus has greater precedence than any operator + symbol, but lower than that of function application. In Haskell, + the precedence of unary minus is the same as that of the infix + (subtraction) operator of the same name. + + o In Haskell, the character `-' can only be used as the first + character of an operator symbol. In Gofer, this character may + appear in any position in an operator (except for symbols + beginning with "--", which indicates the start of a comment). The + only problems that I am aware of with this is that a lambda + expression such as "\-2->2" will be parsed as such by a Haskell + system, but cause a syntax error in Gofer. This form of lambda + expression is sufficiently unusual that I do not believe this will + cause any problems in practice; in any case, the parsing problem + can be solved by inserting a space: "\ -2->2". + + o Pattern bindings are not currently permitted in either instance or + class declarations. This restriction has been made simply for + ease of implementation, is not an inherent problem with the type + class system and is likely to be relaxed in later versions of + Gofer if appropriate. I have yet to see any examples in which the + lack of pattern bindings in class and instance declarations causes + any kind of deficiency. + + o Qualified type signatures are not permitted for the member + functions in Gofer class declarations. Once again, this + restriction was made for ease of implementation rather than any + pressing technical issues. It is likely that this restriction + will be relaxed in future versions of Gofer, although I am not + convinced that proper use can be made of such member functions + without some form of nested instance declarations (yuk!). + + o The definition of the class Text given in the standard prelude + does not include the Haskell functions for reading/parsing values + from strings; the only reason for omitting these functions was to + try to avoid unnecessary complexity in the standard prelude. The + standard prelude can be modified to include the appropriate + additional definitions if these are required. + + +.cc 5 +Known problems in Gofer: +------------------------ + o The null escape sequence "\&" is not generated in the printable + representations of strings produced by both the primitive function + primPrint (used to implement the show' function) and the version + of show defined in the standard prelude. This means that certain + strings values are not printed correctly e.g. show' "\245\&123" + produces the string "\245123". This is unlikely to cause too many + problems in practice. + + o Unification of a type variable a with a type expression of the + form T a where T is a synonym name whose expansion does not + involve a will fail. It is not entirely clear whether this + behaviour is correct or not. + + o Formfeeds '\f' and vertical tabs '\v' are not treated as valid + whitespace characters in the way suggested by the Haskell report. + + o Inability to recover from program stack overlow errors in some + situations. This problem only affects the PC implementation of + Gofer. + + o Implementation of ReadFile may lose referential transparency; the + response to a particular ReadFile request may be affected by a + later WriteFile or AppendFile request for the same file. Whilst + this problem can be solved for UNIX based implementations, I have + not yet found a portable solution suitable for all of the systems + on which Gofer can be used. + + +.cc 5 +Areas for possible future improvement: +-------------------------------------- + o Relaxing the restriction on type synonyms in predicates. + + o General purpose automatic default mechanism for eliminating + certain forms of unresolved overloading. + + o Improved checking and use of superclass and instance constraints + during static analysis and type checking. + + o Simple facility to force dictionary construction at load-time. + + o Provision for shell escapes :! etc within the Gofer interpreter. + + o Debugging facilities, including breakpoints and tracing from + within interpreter. + + o Separate interpreter and compiler programs for creating standalone + applications using Gofer. +.pa +.>appx_d +.ST APPENDIX D: USING GOFER WITH BIRD+WADLER + +Bird and Wadler's textbook [1] gives an excellent introduction to +functional programming, providing an insight into both basic techniques +and matters of programming style as well as describing the underlying +mathematics and its use for program development and derivation. Most +of the programs in that book can be used with Gofer although there are +a number of differences between the two notations. Fortunately, it is +not difficult to translate from one notation to the other. The +following points are particularly useful for this: + + o Type constructors in Gofer begin with capital letters (e.g. Bool, + Char etc..) where lower case is used in [1] (e.g. bool, char, + etc..). Note that Gofer has no general numeric type "num" as used + in [1]; Use either Int, Float, or overloading in Gofer as + appropriate. + + o Datatype definitions in [1] are written in the form lhs::=constrs. + The equivalent definition in Gofer is: data lhs = constrs. + + Similarly, a type synonym definition in [1] of the form lhs == rhs + can be written in Gofer as: type lhs = rhs. + + o The differences between the syntax used for guarded equations in + Gofer compared with the notation used in [1] have already been + discussed in section 9.2. For example: + + Using the notation of [1]: Using Gofer: + + filter p (x:xs) filter p (x:xs) + = x : filter p xs, if p x | p x = x : filter p xs + = filter p xs, otherwise | otherwise = filter p xs + + o In Gofer, list comprehension qualifiers are separated by commas + rather than semicolons as used in [1]. + + o A number of the function names and types in the standard prelude + are different: + + [1] Gofer [1] Gofer + --- ----- --- ---- + (#) length takewhile takeWhile + (~) not dropwhile dropWhile + (/\) (&&) zipwith zipWith + (\/) (||) swap flip + (!) (!!) in elem + (--) (\\) scan scanl + hd head some any + tl tail listmin minimum + decode chr listmax maximum + code ord + + See appendix B for a complete list of standard functions in Gofer. + + The version of foldl using "strict" which appears in [1] is + available in Gofer as the function "foldl'". + + The role of "zip" and "zipwith" in [1] is filled by the "zip" and + "zipWith" families of functions in Gofer. An expression of the + form "zip (xs,ys)" in [1] is equivalent to "zip xs ys" in Gofer + etc... + + o Gofer does not enforce the condition assumed in [1] that the left + hand sides of each of the equations defining a function must be + disjoint. + + o The equality operator in Gofer is written as "==" and the single + equality character "=" is a reserved symbol used to separate left + and right hand sides of equations. Many C programmers will be + familiar with this kind of notation (together with the kinds of + problems it can create!). + + o Some of the identifiers used in [1] are reserved words in Gofer. + Examples that are particularly likely to occur include "in" and + "then". +.pa +.>appx_e +.ST APPENDIX E: PRIMITIVES + +[WARNING: The features described in this appendix are typically only +needed when alternative versions of the standard prelude are created. +These features should only be used by expert users; misuse may lead to +failure and runtime errors in the Gofer interpreter. It is not usually +a good idea to use primitive functions directly in your programs.] + +A number of primitive functions are builtin to the Gofer interpreter, +and may be bound to function symbols using a declaration of the form: + + primitive name1 code1, name2 code2, ...., namen coden :: type + +where each name is an identifier (or an operator symbol enclosed by +parentheses) and each code is a string literal taken from the table +below. The type specified to the right of the :: symbol must be a +valid type for the functions being defined -- WARNING: GOFER DOES NOT +ATTEMPT TO CHECK FOR SUITABILITY OF THE DECLARED TYPE. The following +definition, taken from the standard prelude, illustrates the use of +this feature to bind a function named primPrint to the primitive +function with code name string "primPrint" and type Int -> a -> String +-> String: + + primitive primPrint "primPrint" :: Int -> a -> String -> String + +The primitive functions currently available are: + +category code name string type +-------- ---------------- ---- + +integer primPlusInt Int -> Int -> Int +arithmetic primMinusInt Int -> Int -> Int + primMulInt Int -> Int -> Int + primDivInt Int -> Int -> Int + primModInt Int -> Int -> Int + primRemInt Int -> Int -> Int + primNegInt Int -> Int -> Int + + +floating primPlusFloat Float -> Float -> Float +point primMinusFloat Float -> Float -> Float +arithmetic primMulFloat Float -> Float -> Float + primDivFloat Float -> Float -> Float + primNegFloat Float -> Float -> Float + + +coercion primIntToChar Int -> Char -- chr in the standard prelude +functions primCharToInt Char -> Int -- ord in the standard prelude + primIntToFloat Int -> Float -- implements fromInteger + +equality primEqInt Int -> Int -> Bool +and <= primLeInt Int -> Int -> Bool +primitives primEqFloat Float -> Float -> Bool + primLeFloat Float -> Float -> Bool + + +.cc 5 +generic primGenericEq a -> a -> Bool +ordering primGenericNe a -> a -> Bool +primitives primGenericGt a -> a -> Bool + primGenericLe a -> a -> Bool + primGenericGe a -> a -> Bool + primGenericLt a -> a -> Bool + + These functions implement the standard generic (i.e. non + overloaded) ordering primitives. They are not currently + used in the standard prelude. A simplified prelude may be + created by binding the standard operator symbols (==), + (/=), (>), (<=), (>=) and (<) to these functions + respectively. + +output primPrint Int -> a -> String -> String + + This function is used to implement the show' function in + the standard prelude and is not usually used directly. + + primPrint d e s produces a textual representation of the + value of the expression e as a string, followed by the + string s. The integer parameter d is used as an indicator + of the current precedence level. The primPrint function + is the standard method of printing the value of an + expression whose type is not equivalent to the type String + used by the top-level of the Gofer interpreter. + +sequencing primStrict (a -> b) -> a -> b + + The primStrict function (bound to the identifier "strict" + in the standard prelude) forces the evaluation of its + second argument before the function supplied as the first + argument is applied to it. See section 9.4 for an + illustration. + +.pa +.>appx_f +.ST APPENDIX F: INTERPRETER COMMAND SUMMARY + +Command Description +------- ----------- + Analyse expression for errors, typecheck and evaluate. If + the expression has type Dialogue, execute as a program + using the I/O facilities as described in section 12. If + the expression has type String, evaluate and print result + as a lazy list of characters. In any other case, the + standard prelude function show' is applied to the + expression and used to print the value of the result in + the form of a string, as in the previous case. + +:t Analyse expression for errors, typecheck and print the +:type translation and inferred type of the term. +:T + +:q Exit Gofer interpreter. +:quit +:Q + +:? Display summary of interpreter commands. +:h +:H + +:l f1 .. fn Removes any previously loaded files of definitions and + attempts to load the contents of the files f1 upto fn one + after the other. + +:L Remove any previously loaded files of definitions. Only + those functions and values defined in the standard prelude + will still be be available. + +:load Equivalent forms of the :l command. +:L + +:a f1 .. fn Load the contents of the files f1 upto fn in addition to + any previously loaded files. If any of the files of + definitions which have already been loaded have been + modified since they were last read then they are + automatically reloaded before any of the files f1 upto fn + are read. + + If successful, a command of the form ":l f1 ..fn" is + equivalent to the sequence of commands: + :l + :a f1 + . + . + :a fn + +:also Equivalent forms of the :a command. +:A + +:r Repeat the last load command, attempting to reload any + files which have subsequently been modified. Since later + files may depend on the definitions in earlier ones, once + one file has been reloaded, all subsequent files will also + need to be reloaded. + +:reload Equivalent forms of the :r command. +:R + +:e file Suspend current Gofer session and start an editor program + to modify or view the named file. The Gofer session will + be resumed when the editor program terminates, and any + script files that have been changed will be reloaded + automatically. + + Note that a separate editor program is required and that + Gofer must be properly installed to use this feature. The + default editor is usually vi (Calvin version 2.0 is a good + substitute for a PC), although this may have been changed + when your system was installed. In any case, you can + always substitute an editor of your choice by setting the + environment variable EDITOR to the name of your favourite + editor program. + + There are a number of factors which will affect your + choice of editor. On a slow machine, with only a limited + amount of memory, you will probably need to choose a + relatively small editor which can be loaded reasonably + quickly and does not require too much memory. On a more + powerful system, you may find it more convenient to use + Gofer from a window based environment, running your editor + in one window with Gofer in another. + +:e Using the :e command without specifying a particular file + to be edited starts up an editor program as described + above either for the file of definitions most recently + loaded into Gofer or, if an error occurred whilst loading + a file of definitions, for the file of definitions in + which the error was last detected. + + With many editor programs, it is even possible to start + the editor at the line where the error occurred. As + before, it is possible to change the default behaviour of + Gofer in this case by setting the environment variable + EDITLINE to a command string which can be used to start + the editor program with a given file at a specific line + number. The positions in the string at which the file + name and line number values should be inserted should be + indicated by the strings "%s" and "%d" respectively, and + may appear in either order. The default command string, + which is used if EDITLINE is not set is "vi +%d %s". + +:edit Equivalent forms of the :e command. +:E +.pa +.>appx_g +.ST APPENDIX G: BIBLIOGRAPHY + +[1] Introduction to functional programming, Richard Bird and Philip + Wadler, Prentice Hall International, 1989. + +[2] The Implementation of functional programming languages, Simon L. + Peyton Jones, Prentice Hall International, 1987. + +[3] Lambda Lifting: Transforming Programs to Recursive Equations, + Thomas Johnsson, in Lecture Notes in Computer Science 201, + Springer Verlag, 1985. [but try to get a copy of the version of + this paper included in Johnsson's thesis which benefits from an + extended typeface and is a little easier to read!] + +[4] How to make ad-hoc polymorphism less ad-hoc, Philip Wadler and + Stephen Blott, University of Glasgow, in the proceedings of the + 16th ACM annual symposium on Principles of Programming Languages, + Austin, Texas, January 1989. + +[5] Report on the programming language Haskell, a non-strict purely + functional language (Version 1.1), Paul Hudak, Philip Wadler et + al. Technical report Yale University/Glasgow University. August, + 1991. + +[6] Introduction to Orwell 6.00, Philip Wadler and Quentin Miller, + University of Oxford, 1990. + +[7] Lazy ML user's manual, Lennart Augustsson and Thomas Johnsson, + 1990. + +[8] Computing with lattices: An application of type classes, Mark P. + Jones, Technical report PRG-TR-11-90, Programming Research Group, + Oxford University Computing Laboratory, June 1990. + +[9] Towards a theory of qualified types, Mark P. Jones, Technical + report PRG-TR-6-91, Programming Research Group, Oxford University + Computing Laboratory, April 1991. + +[10] Type inference for qualified types, Mark P. Jones, Technical + report PRG-TR-10-91, Programming Research Group, Oxford University + Computing Laboratory, June 1991. + +[11] A new approach to type classes, Mark P. Jones, distributed to + Haskell mailing list 1991. + +[12] Practical issues in the implementation of qualified types, Mark P. + Jones, Forthcoming 1991. diff --git a/gofer.el b/gofer.el new file mode 100644 index 0000000..52b4e5c --- /dev/null +++ b/gofer.el @@ -0,0 +1,134 @@ +;;; Gofer mode for GNU Emacs +;;; +;;; Last update: 6/12/91 +;;; +;;; Author: Stuart Clayman, +;;; Dept. Computer Science, +;;; University College London +;;; +;;; Email: sclayman@uk.ac.ucl.cs +;;; +;;; Use: +;;; In .emacs put +;;; +;;; (autoload 'gofer-mode "gofer" "Go into gofer mode" t) +;;; (autoload 'run-gofer "gofer" "Run gofer as inferior process" t) +;;; (autoload 'gofer-project "gofer" "Go into a gofer project" t) +;;; +;;; (set-variable 'auto-mode-alist +;;; (append '( +;;; ("\\.gs$" . gofer-mode) ;; gofer source +;;; ("\\.gp$" . gofer-project) ;; gofer project files +;;; ) auto-mode-alist)) +;;; +;;; All gofer source files should end in .gs +;;; All gofer project files should end in .gp +;;; +;;; In gofer source files +;;; ESC \C-x +;;; \C-c \C-c +;;; \C-c l loads the current file +;;; +;;; \C-u ESC \C-x +;;; \C-u \C-c \C-c +;;; \C-u \C-c l loads the current file and does a cd first +;;; +;;; \C-c a adds the current file +;;; \C-u \C-c a adds the current file and does a cd first +;;; \C-c r reloads the current file +;;; +;;; +;;; In gofer project files +;;; ESC \C-x +;;; \C-c \C-c +;;; \C-c p loads the project file +;;; \C-u ESC \C-x +;;; \C-u \C-c \C-c +;;; \C-u \C-c p loads the project file and does a cd first +;;; +;;; The duplication of ESC \C-x, \C-c \C-c, and \C-c l is for +;;; historical reasons. + +(require 'shell) + +(defvar gofer-mode-hook nil "Gofer mode hook") + +(defun run-gofer() + "Run an inferior Gofer process." + (interactive) + (switch-to-buffer (make-shell "gofer" "gofer")) + (make-variable-buffer-local 'shell-cd-pattern) + (make-variable-buffer-local 'shell-prompt-pattern) + (setq shell-cd-pattern ":cd") + (setq shell-prompt-pattern "^[? ]*? \\|^")) + +(defun save-buffer-and-go-outline(which arg) + "Save current Gofer file buffer. +Goto inferior Gofer buffer and load file. +WHICH operation is required. +With ARG for additional operation" + (save-buffer) + (if (or (null (get-buffer "*gofer*")) (null (process-status "gofer"))) ; if gofer not running + (save-excursion (run-gofer))) ; run gofer + + (if (equal which "r") ; reload a file + (progn + (send-string "gofer" (concat ":reload" "\n"))) + (if (equal which "l") ; load a file + (progn + (if arg + (send-string "gofer" (concat ":cd " default-directory "\n"))) + (send-string "gofer" (concat ":l " (buffer-name) "\n"))) + (if (equal which "a") ; add a file + (progn + (if arg + (send-string "gofer" (concat ":cd " default-directory "\n"))) + (send-string "gofer" (concat ":a " (buffer-name) "\n"))) + (if (equal which "p") ; a project file + (progn + (if arg + (send-string "gofer" (concat ":cd " default-directory "\n"))) + (send-string "gofer" (concat ":p " (buffer-name) "\n"))) + (message "Bad programming in gofer.el"))))) + + (switch-to-buffer-other-window "*gofer*")) + +(defun save-gofer-buffer-and-load(arg) + "Save a gofer source file and load it" + (interactive "P") + (save-buffer-and-go-outline "l" arg)) + +(defun save-gofer-buffer-and-add(arg) + "Save a gofer source file and add it to the file list" + (interactive "P") + (save-buffer-and-go-outline "a" arg)) + +(defun save-gofer-buffer-and-reload(arg) + "Save a gofer source file and reload it" + (interactive "P") + (save-buffer-and-go-outline "r" arg)) + +(defun save-gofer-project-buffer-and-go(arg) + "Save a gofer project file and run" + (interactive "P") + (save-buffer-and-go-outline "p" arg)) + +(defun gofer-mode() + "Gofer mode." + (interactive) + (setq mode-name "Gofer") + (make-variable-buffer-local 'indent-line-function) + (setq indent-line-function 'indent-relative) + (run-hooks 'gofer-mode-hook) + (local-set-key "\e\C-x" 'save-gofer-buffer-and-load) + (local-set-key "\C-c\C-c" 'save-gofer-buffer-and-load) + (local-set-key "\C-cl" 'save-gofer-buffer-and-load) + (local-set-key "\C-cr" 'save-gofer-buffer-and-reload) + (local-set-key "\C-ca" 'save-gofer-buffer-and-add) + (local-set-key "\eg" 'goto-line)) + +(defun gofer-project() + "For Gofer project files" + (local-set-key "\e\C-x" 'save-gofer-project-buffer-and-go) + (local-set-key "\C-c\C-c" 'save-gofer-project-buffer-and-go) + (local-set-key "\C-cp" 'save-gofer-project-buffer-and-go)) diff --git a/ioarray.gs b/ioarray.gs new file mode 100644 index 0000000..e3c275b --- /dev/null +++ b/ioarray.gs @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- This file contains a Gofer implementation of the monadic array +-- primitives for Lazy state threads, as described in the PLDI '94 +-- paper by John Launchbury and Simon Peyton Jones, using new Gofer +-- primitives added in Gofer 2.30. +-- +-- This file must be loaded only after both array.gs and iomonad.gs, +-- and requires the standard, or cc prelude. +-- +-- You will not be able to use this file unless the version of Gofer that +-- is installed on your machine has been compiled with the IO_MONAD flag +-- and the HASKELL_ARRAYS flag set to 1. +-- +-- Mark P Jones, 1994 +------------------------------------------------------------------------------ + +module LazyStateArr( newArr, readArr, writeArr, freezeArr ) where + +primitive primSTNewArr "primSTNewArr" + :: (a -> Int) -> (a,a) -> b -> ST s (MutArr s a b) +primitive primSTReadArr "primSTReadArr" + :: ((a,a) -> a -> Int) -> MutArr s a b -> a -> ST s b +primitive primSTWriteArr "primSTWriteArr" + :: ((a,a) -> a -> Int) -> MutArr s a b -> a -> b -> ST s () +primitive primSTFreeze "primSTFreeze" + :: MutArr s a b -> ST s (Array a b) + +newArr :: Ix a => (a,a) -> b -> ST s (MutArr s a b) +newArr bounds = primSTNewArr (index bounds) bounds + +readArr :: Ix a => MutArr s a b -> a -> ST s b +readArr = primSTReadArr index + +writeArr :: Ix a => MutArr s a b -> a -> b -> ST s () +writeArr = primSTWriteArr index + +freezeArr :: Ix a => MutArr s a b -> ST s (Array a b) +freezeArr = primSTFreeze + +------------------------------------------------------------------------------ diff --git a/iomonad.gs b/iomonad.gs new file mode 100644 index 0000000..32d0e73 --- /dev/null +++ b/iomonad.gs @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- This file contains a Gofer implementation of Lazy state threads, as +-- described in the PLDI '94 paper by John Launchbury and Simon Peyton +-- Jones, using new Gofer primitives added in Gofer 2.30. +-- +-- This file is included for the benefit of those interested in +-- experimenting with the use of lazy functional state threads. +-- You may expect to see changes to the definitions in this file, +-- to track future proposals for monadic I/O in Haskell. +-- +-- This file requires the standard, or cc prelude. +-- You will not be able to use this file unless the version of Gofer that +-- is installed on your machine has been compiled with the IO_MONAD flag +-- set to 1. +-- +-- Mark P Jones, 1994 +------------------------------------------------------------------------------ + +module LazyStateThd( thenST, thenST_, returnST, newVar, readVar, WriteVar, + mutVarEq, getch, putchar, thenIO, seqST, putString, + getchar, interleaveST + ) where + +infixr `thenST_`, `thenST` + +primitive returnST "primSTReturn" :: a -> ST s a +primitive thenST "primSTBind" :: ST s a -> (a -> ST s b) -> ST s b +primitive newVar "primSTNew" :: a -> ST s (MutVar s a) +primitive readVar "primSTDeref" :: MutVar s a -> ST s a +primitive writeVar "primSTAssign" :: MutVar s a -> a -> ST s () +primitive mutvarEq "primSTMutVarEq" :: MutVar s a -> MutVar s a -> Bool +primitive getch "primIOGetch" :: IO Char +primitive putchar "primIOPutchar" :: Char -> IO () +primitive thenIO "primIOBind" :: IO a -> (a -> IO b) -> IO b +primitive interleaveST "primSTInter" :: ST s a -> ST s a + +instance Eq (MutVar s a) where (==) = mutvarEq + +thenST_ :: ST s () -> ST s b -> ST s b +p `thenST_` q = p `thenST` \() -> q + +seqST :: [ST s ()] -> ST s () +seqST = foldr thenST_ (returnST ()) + +putString :: String -> IO () +putString = seqST . map putchar + +getchar = getch `thenST` \c -> + putchar c `thenST_` + returnST c + +------------------------------------------------------------------------------ diff --git a/min.prelude b/min.prelude new file mode 100644 index 0000000..e2f286c --- /dev/null +++ b/min.prelude @@ -0,0 +1,31 @@ +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.30 +-- Copyright Mark P Jones 1991-1994. +-- +-- Minimal Gofer prelude for experimentation with different approaches +-- to standard operations. +-- +-- Any Gofer prelude file should typically include at least the following +-- definitions: + +infixr 5 : +infixr 3 && +infixr 2 || + +(&&), (||) :: Bool -> Bool -> Bool +False && _ = False -- (&&) and (||) names predefined in Gofer +True && x = x +False || x = x +True || _ = True + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +primitive error "primError" :: String -> a + diff --git a/nofloat.prelude b/nofloat.prelude new file mode 100644 index 0000000..efdfeb0 --- /dev/null +++ b/nofloat.prelude @@ -0,0 +1,866 @@ +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.30 +-- Copyright Mark P Jones 1991-1994. +-- +-- Standard prelude for use of overloaded values using type classes. +-- Based on the Haskell standard prelude version 1.2. +-- +-- This prelude file is the same as standard.prelude except that it +-- does not include the Float data type and associated operations. + +help = "press :? for a list of commands" + +-- Operator precedence table: ----------------------------------------------- + +infixl 9 !! +infixr 9 . +infixr 8 ^ +infixl 7 * +infix 7 /, `div`, `quot`, `rem`, `mod` +infixl 6 +, - +infix 5 \\ +infixr 5 ++, : +infix 4 ==, /=, <, <=, >=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +infixr 0 $ + +-- Standard combinators: ---------------------------------------------------- + +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b -- pronounced as `apply' elsewhere +f $ x = f x + +-- Boolean functions: ------------------------------------------------------- + +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True + +-- Character functions: ----------------------------------------------------- + +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' + +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c + +minChar, maxChar :: Char +minChar = chr 0 +maxChar = chr 255 + +-- Standard type classes: --------------------------------------------------- + +class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +class Ord a => Ix a where + range :: (a,a) -> [a] + index :: (a,a) -> a -> Int + inRange :: (a,a) -> a -> Bool + +class Ord a => Enum a where + enumFrom :: a -> [a] -- [n..] + enumFromThen :: a -> a -> [a] -- [n,m..] + enumFromTo :: a -> a -> [a] -- [n..m] + enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] + + enumFromTo n m = takeWhile (m>=) (enumFrom n) + enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m) + (enumFromThen n n') + +class (Eq a, Text a) => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +-- Type class instances: ---------------------------------------------------- + +primitive primEqInt "primEqInt", + primLeInt "primLeInt" :: Int -> Int -> Bool +primitive primPlusInt "primPlusInt", + primMinusInt "primMinusInt", + primDivInt "primDivInt", + primMulInt "primMulInt" :: Int -> Int -> Int +primitive primNegInt "primNegInt" :: Int -> Int + +instance Eq () where () == () = True +instance Ord () where () <= () = True + +instance Eq Int where (==) = primEqInt + +instance Ord Int where (<=) = primLeInt + +instance Ix Int where + range (m,n) = [m..n] + index b@(m,n) i + | inRange b i = i - m + | otherwise = error "index out of range" + inRange (m,n) i = m <= i && i <= n + +instance Enum Int where + enumFrom n = iterate (1+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + +{- PC version off +primitive primEqFloat "primEqFloat", + primLeFloat "primLeFloat" :: Float -> Float -> Bool +primitive primPlusFloat "primPlusFloat", + primMinusFloat "primMinusFloat", + primDivFloat "primDivFloat", + primMulFloat "primMulFloat" :: Float -> Float -> Float +primitive primNegFloat "primNegFloat" :: Float -> Float +primitive primIntToFloat "primIntToFloat" :: Int -> Float + +instance Eq Float where (==) = primEqFloat + +instance Ord Float where (<=) = primLeFloat + +instance Enum Float where + enumFrom n = iterate (1.0+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +primitive sin "primSinFloat", asin "primAsinFloat", + cos "primCosFloat", acos "primAcosFloat", + tan "primTanFloat", atan "primAtanFloat", + log "primLogFloat", log10 "primLog10Float", + exp "primExpFloat", sqrt "primSqrtFloat" :: Float -> Float +primitive atan2 "primAtan2Float" :: Float -> Float -> Float +primitive truncate "primFloatToInt" :: Float -> Int + +pi :: Float +pi = 3.1415926535 + +PC version on -} + +primitive primEqChar "primEqChar", + primLeChar "primLeChar" :: Char -> Char -> Bool + +instance Eq Char where (==) = primEqChar -- c == d = ord c == ord d + +instance Ord Char where (<=) = primLeChar -- c <= d = ord c <= ord d + +instance Ix Char where + range (c,c') = [c..c'] + index b@(m,n) i + | inRange b i = ord i - ord m + | otherwise = error "index out of range" + inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci + +instance Enum Char where + enumFrom c = map chr [ord c .. ord maxChar] + enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar] + where lastChar = if c' < c then minChar else maxChar + +instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +instance Ord a => Ord [a] where + [] <= _ = True + (_:_) <= [] = False + (x:xs) <= (y:ys) = x Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + +instance (Ord a, Ord b) => Ord (a,b) where + (x,y) <= (u,v) = x Int -> Int + +subtract :: Num a => a -> a -> a +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Num a => a -> Int -> a +x ^ 0 = fromInteger 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`quot`2) + | otherwise = f x (n-1) (x*y) + +abs :: (Num a, Ord a) => a -> a +abs x | x>=fromInteger 0 = x + | otherwise = -x + +signum :: (Num a, Ord a) => a -> Int +signum x + | x==fromInteger 0 = 0 + | x> fromInteger 0 = 1 + | otherwise = -1 + +sum, product :: Num a => [a] -> a +sum = foldl' (+) (fromInteger 0) +product = foldl' (*) (fromInteger 1) + +sums, products :: Num a => [a] -> [a] +sums = scanl (+) (fromInteger 0) +products = scanl (*) (fromInteger 1) + +-- Standard list processing functions: -------------------------------------- + +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [] +init (x:xs) = x : init xs + +(++) :: [a] -> [a] -> [a] -- append lists. Associative with +[] ++ ys = ys -- left and right identity []. +(x:xs) ++ ys = x:(xs++ys) + +genericLength :: Num a => [b] -> a +genericLength = foldl' (\n _ -> n + fromInteger 1) (fromInteger 0) + +length :: [a] -> Int -- calculate length of list +length = foldl' (\n _ -> n+1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: Eq a => [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: Eq a => a -> [a] -> Bool +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: Ord a => [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +concat :: [[a]] -> [a] -- concatenate list of lists +concat = foldr (++) [] + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a]. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + + +-- map f xs applies the function f to each element of the list xs returning +-- the corresponding list of results. filter p xs returns the sublist of xs +-- containing those elements which satisfy the predicate p. + +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter _ [] = [] +filter p (x:xs) + | p x = x : xs' + | otherwise = xs' + where xs' = filter p xs + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs + +-- List breaking functions: +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws + +-- Merging and sorting lists: + +merge :: Ord a => [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: Ord a => [a] -> [a] +sort = foldr insert [] + +insert :: Ord a => a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: Ord a => [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] + +-- zip and zipWith families of functions: + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) + +-- Formatted output: -------------------------------------------------------- + +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show' :: a -> String +show' x = primPrint 0 x [] + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs + +-- Miscellaneous: ----------------------------------------------------------- + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +primitive error "primError" :: String -> a + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x + +-- A trimmed down version of the Haskell Text class: ------------------------ + +type ShowS = String -> String + +class Text a where + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + + showsPrec = primPrint + showList [] = showString "[]" + showList (x:xs) = showChar '[' . shows x . showl xs + where showl [] = showChar ']' + showl (x:xs) = showChar ',' . shows x . showl xs + +shows :: Text a => a -> ShowS +shows = showsPrec 0 + +show :: Text a => a -> String +show x = shows x "" + +showChar :: Char -> ShowS +showChar = (:) + +showString :: String -> ShowS +showString = (++) + +instance Text () where + showsPrec d () = showString "()" + +instance Text Bool where + showsPrec d True = showString "True" + showsPrec d False = showString "False" + +primitive primShowsInt "primShowsInt" :: Int -> Int -> String -> String +instance Text Int where showsPrec = primShowsInt + +{- PC version off +primitive primShowsFloat "primShowsFloat" :: Int -> Float -> String -> String +instance Text Float where showsPrec = primShowsFloat +PC version on -} + +instance Text Char where + showsPrec p c = showString [q, c, q] where q = '\'' + showList cs = showChar '"' . showl cs + where showl "" = showChar '"' + showl ('"':cs) = showString "\\\"" . showl cs + showl (c:cs) = showChar c . showl cs + -- Haskell has showLitChar c . showl cs + +instance Text a => Text [a] where + showsPrec p = showList + +instance (Text a, Text b) => Text (a,b) where + showsPrec p (x,y) = showChar '(' . shows x . showChar ',' . + shows y . showChar ')' + +-- I/O functions and definitions: ------------------------------------------- + +stdin = "stdin" +stdout = "stdout" +stderr = "stderr" +stdecho = "stdecho" + +{- The Dialogue, Request, Response and IOError datatypes are now builtin: +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + | GetArgs + | GetProgName + | GetEnv String + +data Response = Success + | Str String + | Failure IOError + | StrList [String] + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +type Dialogue = [Response] -> [Request] +-} + +type SuccCont = Dialogue +type StrCont = String -> Dialogue +type StrListCont = [String] -> Dialogue +type FailCont = IOError -> Dialogue + +done :: Dialogue +readFile :: String -> FailCont -> StrCont -> Dialogue +writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue +appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue +readChan :: String -> FailCont -> StrCont -> Dialogue +appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue +echo :: Bool -> FailCont -> SuccCont -> Dialogue +getArgs :: FailCont -> StrListCont -> Dialogue +getProgName :: FailCont -> StrCont -> Dialogue +getEnv :: String -> FailCont -> StrCont -> Dialogue + +done resps = [] +readFile name fail succ resps = + (ReadFile name) : strDispatch fail succ resps +writeFile name contents fail succ resps = + (WriteFile name contents) : succDispatch fail succ resps +appendFile name contents fail succ resps = + (AppendFile name contents) : succDispatch fail succ resps +readChan name fail succ resps = + (ReadChan name) : strDispatch fail succ resps +appendChan name contents fail succ resps = + (AppendChan name contents) : succDispatch fail succ resps +echo bool fail succ resps = + (Echo bool) : succDispatch fail succ resps +getArgs fail succ resps = + GetArgs : strListDispatch fail succ resps +getProgName fail succ resps = + GetProgName : strDispatch fail succ resps +getEnv name fail succ resps = + (GetEnv name) : strDispatch fail succ resps + +strDispatch fail succ (resp:resps) = + case resp of Str val -> succ val resps + Failure msg -> fail msg resps + +succDispatch fail succ (resp:resps) = + case resp of Success -> succ resps + Failure msg -> fail msg resps + +strListDispatch fail succ (resp:resps) = + case resp of StrList val -> succ val resps + Failure msg -> fail msg resps + +abort :: FailCont +abort err = done + +exit :: FailCont +exit err = appendChan stderr msg abort done + where msg = case err of ReadError s -> s + WriteError s -> s + SearchError s -> s + FormatError s -> s + OtherError s -> s + +print :: Text a => a -> Dialogue +print x = appendChan stdout (show x) exit done + +prints :: Text a => a -> String -> Dialogue +prints x s = appendChan stdout (shows x s) exit done + +interact :: (String -> String) -> Dialogue +interact f = readChan stdin exit + (\x -> appendChan stdout (f x) exit done) + +run :: (String -> String) -> Dialogue +run f = echo False exit (interact f) + +primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a + +openfile :: String -> String +openfile f = primFopen f (error ("can't open file "++f)) id + +-- End of Gofer standard prelude: -------------------------------------------- diff --git a/scripts/Readme b/scripts/Readme new file mode 100644 index 0000000..62a558e --- /dev/null +++ b/scripts/Readme @@ -0,0 +1,24 @@ +This directory contains scripts that can be used in a Unix based environment +to take care of initialisation and environment settings for the Gofer +interpreter and compiler: + + gofer starts up the command line version of Gofer with a particular + prelude and initial command line argument settings. In addition, + this scripts attempts to set suitable values for the EDITLINE + variable, based on the value of EDITOR (if it has one). + + Written as a sh script, Mark Jones, March 1993 + Some modification by Jonathan Bowen, August 1993 + + goferc Runs the Gofer compiler and compiles the resulting C code. + Handles project files or individually listed files (filename + suffix such as .gs must be used). + + Written as a csh script, Ian Holyer, March 1993 + +It is expected that each Gofer user on a given system will make copies of +these files in their own local file space and modify as necessary to give +their preferred settings for command line arguments etc. + +The old subdirectory contains older script files which have been subsumed +by the two scripts above, but might be useful in some special situations. diff --git a/scripts/gofer b/scripts/gofer new file mode 100755 index 0000000..e1a063b --- /dev/null +++ b/scripts/gofer @@ -0,0 +1,37 @@ +#!/bin/sh +# +# A simple shell script to invoke the Gofer interpreter and set the +# path to the prelude file. Ultimately, you might want to copy this +# file into your own bin directory so that you can record your +# favourite command line settings or use a different prelude file ... +# +# Mark Jones, last modified March 1993 +# Edited by Jonathan Bowen, Oxford University, August 1993 + +# Location of gofer files - site specific +ROOT=/usr/local/gofer + +# first, the location of your prelude file: +GOFER=${GOFER-$ROOT/lib/standard.prelude} +export GOFER + +# next, command line argument settings. One example might be: +# "-pGofer: -rit -s +k" but I just stick with the defaults +# here: +GOFERARGS=${GOFERARGS-""} + +# The next few lines try to guess a suitable setting for the EDITLINE +# variable. If your favourite editor is not dealt with here, or if +# the version of sh that I'm using is incompatible with every other +# shell out there, you may need to modify (or remove) this section: +# +EDIT=${VISUAL-${EDITOR-/usr/ucb/vi}} +case `basename $EDIT` in + emacs | vi | elvis ) EDITLINE="$EDIT +%d %s"; export EDITLINE ;; + none ) ;; + * ) EDITLINE=$EDIT; export EDITLINE ;; +esac + +# Finally, start the interpreter running: +# exec /usr/local/lib/Gofer/gofer $GOFERARGS $* +exec $ROOT/bin/Gofer $GOFERARGS $* diff --git a/scripts/goferc b/scripts/goferc new file mode 100755 index 0000000..5acf8ad --- /dev/null +++ b/scripts/goferc @@ -0,0 +1,39 @@ +#!/bin/sh +# +# This shell script invokes the Gofer compiler `gofc' to produce a C file, +# followed by the `gcc' C compiler to produce an executable. Arguments are as +# for `gofer' and `gofc'. Like `gofc', it uses the last argument to form the +# program name, but ensures that this has an extension to avoid overwriting. +# +# Ian Holyer, October 1993 (now uses sh, not csh) + +args=$* +while test $# -gt 1; do shift; done +case $1 in + *.gs) prog=`dirname $1`/`basename $1 .gs` ;; + *.gof) prog=`dirname $1`/`basename $1 .gof` ;; + *.lgs) prog=`dirname $1`/`basename $1 .lgs` ;; + *.gp) prog=`dirname $1`/`basename $1 .gp` ;; + *.prj) prog=`dirname $1`/`basename $1 .prj` ;; + *.prelude) prog=`dirname $1`/`basename $1 .prelude` ;; + *.hs) prog=`dirname $1`/`basename $1 .hs` ;; + *.has) prog=`dirname $1`/`basename $1 .has` ;; + *.lhs) prog=`dirname $1`/`basename $1 .lhs` ;; + *.lit) prog=`dirname $1`/`basename $1 .lit` ;; + *.verb) prog=`dirname $1`/`basename $1 .verb` ;; + *) + echo The source program $1 does not have one of the standard + echo extensions for Gofer or Haskell program or project files: + echo '(.gs .gof .lgs .gp .prj .prelude .hs .has .lhs .lit or .verb)' + exit + ;; +esac + +GOFER=/home/staff/ian/gofer/lib/standard.prelude +export GOFER +/usr/local/lib/Gofer/gofc $args +echo '[Compiling with gcc]' +gcc -o $prog -O $prog.c /usr/local/lib/Gofer/runtime.o -lm +strip $prog +rm $prog.c + diff --git a/scripts/old/gofc b/scripts/old/gofc new file mode 100755 index 0000000..23a49d3 --- /dev/null +++ b/scripts/old/gofc @@ -0,0 +1,10 @@ +#!/bin/sh +# +# A simple shell script to invoke the Gofer compiler and set the path +# to the prelude file. Ultimately, you might want to copy this file into +# your own bin directory so that you can record your favourite command line +# settings or use a different prelude file ... +# +GOFER=/usr/local/lib/Gofer/standard.prelude +export GOFER +exec /usr/local/lib/Gofer/gofc $* diff --git a/scripts/old/gofcc b/scripts/old/gofcc new file mode 100755 index 0000000..5325b77 --- /dev/null +++ b/scripts/old/gofcc @@ -0,0 +1,25 @@ +#!/bin/sh +# +# gofcc: +# +# A simple shell script to compile C files produced by the Gofer compiler +# +# +# WARNING: This script takes an output C file produced by the Gofer compiler +# and compiles and links it with the runtime library to make a standalone +# executable for your system. The first parameter to this shell is used as +# the name of the output executable file and the C code input is required to +# have the same name but with a .c extension. Do not use this script to +# compile programs which do not have an extension or use a project file +# without an extension since the executable generated by this script will +# replace the source file with the same name. +# +# e.g. GOOD % gofc myfile.gs ; gofcc myfile +# % gofc + proj.gp ; gofcc proj +# +# VERY BAD % gofc myfile ; gofcc myfile (source `myfile' destroyed) +# % gofc + proj ; gofcc proj (project file `proj' destroyed) +# + +cc -o $1 -O $1.c /usr/local/lib/Gofer/runtime.o -lm +strip $1 diff --git a/scripts/old/gofer b/scripts/old/gofer new file mode 100755 index 0000000..142b983 --- /dev/null +++ b/scripts/old/gofer @@ -0,0 +1,10 @@ +#!/bin/sh +# +# A simple shell script to invoke the Gofer interpreter and set the path +# to the prelude file. Ultimately, you might want to copy this file into +# your own bin directory so that you can record your favourite command line +# settings or use a different prelude file ... +# +GOFER=/usr/local/lib/Gofer/standard.prelude +export GOFER +exec /usr/local/lib/Gofer/gofer $* diff --git a/simple.prelude b/simple.prelude new file mode 100644 index 0000000..db3f3a3 --- /dev/null +++ b/simple.prelude @@ -0,0 +1,609 @@ +-- __________ __________ __________ __________ ________ +-- / _______/ / ____ / / _______/ / _______/ / ____ \ +-- / / _____ / / / / / /______ / /______ / /___/ / +-- / / /_ / / / / / / _______/ / _______/ / __ __/ +-- / /___/ / / /___/ / / / / /______ / / \ \ +-- /_________/ /_________/ /__/ /_________/ /__/ \__\ +-- +-- Functional programming environment, Version 2.30 +-- Copyright Mark P Jones 1991-1994. +-- +-- Simplified prelude, without any type classes and overloaded values +-- Based on the Haskell standard prelude version 1.2. +-- +-- This prelude file shows one approach to using Gofer without the +-- use of overloaded implementations of show, <=, == etc. +-- +-- Needless to say, some (most) of the Gofer demonstration programs +-- cannot be used inconnection with this prelude ... but a wide +-- family of programs can be used without needing to worry about +-- type classes at all. +-- + +help = "press :? for a list of commands" +quit = help ++ ", :q to quit" + +-- Operator precedence table: ----------------------------------------------- + +infixl 9 !! +infixr 9 . +infixr 8 ^ +infixl 7 * +infix 7 /, `div`, `quot`, `rem`, `mod` +infixl 6 +, - +infix 5 \\ +infixr 5 ++, : +infix 4 ==, /=, <, <=, >=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +infixr 0 $ + +-- Standard combinators: ---------------------------------------------------- + +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b -- pronounced as `apply' elsewhere +f $ x = f x + +-- Boolean functions: ------------------------------------------------------- + +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True + +-- Essentials and builtin primitives: -------------------------------------- + +primitive (==) "primGenericEq", + (/=) "primGenericNe", + (<=) "primGenericLe", + (<) "primGenericLt", + (>=) "primGenericGe", + (>) "primGenericGt" :: a -> a -> Bool + +max x y | x >= y = x + | otherwise = y +min x y | x <= y = x + | otherwise = y + +enumFrom n = iterate (1+) n -- [n..] +enumFromThen n m = iterate ((m-n)+) n -- [n,m..] +enumFromTo n m = takeWhile (m>=) (enumFrom n) -- [n..m] +enumFromThenTo n o m = takeWhile ((if o>=n then (>=) else (<=)) m) -- [n,o..m] + (enumFromThen n o) + +primitive (+) "primPlusInt", + (-) "primMinusInt", + (/) "primDivInt", + div "primDivInt", + quot "primQuotInt", + rem "primRemInt", + mod "primModInt", + (*) "primMulInt" :: Int -> Int -> Int +primitive negate "primNegInt" :: Int -> Int + +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show :: a -> String +show x = primPrint 0 x [] + +-- Character functions: ----------------------------------------------------- + +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' + +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c + +minChar, maxChar :: Char +minChar = chr 0 +maxChar = chr 255 + +-- Standard numerical functions: -------------------------------------------- + +subtract :: Int -> Int -> Int +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Int -> Int -> Int +x ^ 0 = 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`quot`2) + | otherwise = f x (n-1) (x*y) + +abs :: Int -> Int +abs x | x >= 0 = x + | x < 0 = - x + +signum :: Int -> Int +signum x | x == 0 = 0 + | x > 0 = 1 + | x < 0 = -1 + +sum, product :: [Int] -> Int +sum = foldl' (+) 0 +product = foldl' (*) 1 + +sums, products :: [Int] -> [Int] +sums = scanl (+) 0 +products = scanl (*) 1 + +-- Standard list processing functions: -------------------------------------- + +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [] +init (x:xs) = x : init xs + +(++) :: [a] -> [a] -> [a] -- append lists. Associative with +[] ++ ys = ys -- left and right identity []. +(x:xs) ++ ys = x:(xs++ys) + +length :: [a] -> Int -- calculate length of list +length = foldl' (\n _ -> n+1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: a -> [a] -> Bool +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +concat :: [[a]] -> [a] -- concatenate list of lists +concat = foldr (++) [] + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a] in the full standard prelude. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + + +-- map f xs applies the function f to each element of the list xs returning +-- the corresponding list of results. filter p xs returns the sublist of xs +-- containing those elements which satisfy the predicate p. + +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter _ [] = [] +filter p (x:xs) + | p x = x : xs' + | otherwise = xs' + where xs' = filter p xs + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs + +-- List breaking functions: +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws + +-- Merging and sorting lists: + +merge :: [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: [a] -> [a] +sort = foldr insert [] + +insert :: a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] + +-- zip and zipWith families of functions: + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) + +-- Formatted output: -------------------------------------------------------- + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs + +-- Miscellaneous: ----------------------------------------------------------- + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +primitive error "primError" :: String -> a + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x + +-- I/O functions and definitions: ------------------------------------------- +-- This is the minimum required for bootstrapping and execution of +-- interactive programs. + +{- The Dialogue, Request, Response and IOError datatypes are now builtin: +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + | GetArgs + | GetProgName + | GetEnv String + +data Response = Success + | Str String + | Failure IOError + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +-- Continuation-based I/O: + +type Dialogue = [Response] -> [Request] +-} + +run :: (String -> String) -> Dialogue +run f ~(Success : ~(Str kbd : _)) + = [Echo False, ReadChan "stdin", AppendChan "stdout" (f kbd)] + +primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a + +openfile :: String -> String +openfile f = primFopen f (error ("can't open file "++f)) id + +-- End of Gofer simplified prelude: ------------------------------------------ diff --git a/src/AcornMake b/src/AcornMake new file mode 100644 index 0000000..bc8fe3c --- /dev/null +++ b/src/AcornMake @@ -0,0 +1,141 @@ +# Project: Gofer228 + + +# Toolflags: +CCflags = -c -depend !Depend -IC: -throwback -DLAMBDAVAR +Linkflags = -aif -o $@ +ObjAsmflags = -depend !Depend -ThrowBack -Stamp -quit -CloseExec +CMHGflags = +LibFileflags = -c -o $@ +Squeezeflags = -o $@ +AAsmflags = -depend !Depend -quit -CloseExec -To $@ -From + + +# Final targets: +@.GofC: @.o.compiler @.o.input @.o.static @.o.storage @.o.type @.o.cbuiltin \ + @.o.cmachine @.o.gofc c:o.Stubs c:o.RISC_OSLib + link $(linkflags) @.o.compiler @.o.input @.o.static @.o.storage \ + @.o.type @.o.cbuiltin @.o.cmachine @.o.gofc c:o.Stubs c:o.RISC_OSLib +@.Gofer: c:o.Stubs c:o.RISC_OSLib @.o.compiler @.o.input @.o.static \ + @.o.storage @.o.type @.o.builtin @.o.gofer @.o.machine @.o.output + link $(linkflags) c:o.Stubs c:o.RISC_OSLib @.o.compiler @.o.input \ + @.o.static @.o.storage @.o.type @.o.builtin @.o.gofer @.o.machine @.o.output + + +# User-editable dependencies: + +# Static dependencies: +@.o.compiler: @.c.compiler + cc $(ccflags) -o @.o.compiler @.c.compiler +@.o.input: @.c.input + cc $(ccflags) -o @.o.input @.c.input +@.o.static: @.c.static + cc $(ccflags) -o @.o.static @.c.static +@.o.storage: @.c.storage + cc $(ccflags) -o @.o.storage @.c.storage +@.o.type: @.c.type + cc $(ccflags) -o @.o.type @.c.type +@.o.builtin: @.c.builtin + cc $(ccflags) -o @.o.builtin @.c.builtin +@.o.gofer: @.c.gofer + cc $(ccflags) -o @.o.gofer @.c.gofer +@.o.machine: @.c.machine + cc $(ccflags) -o @.o.machine @.c.machine +@.o.output: @.c.output + cc $(ccflags) -o @.o.output @.c.output +@.o.cbuiltin: @.c.cbuiltin + cc $(ccflags) -o @.o.cbuiltin @.c.cbuiltin +@.o.cmachine: @.c.cmachine + cc $(ccflags) -o @.o.cmachine @.c.cmachine +@.o.gofc: @.c.gofc + cc $(ccflags) -o @.o.gofc @.c.gofc + + +# Dynamic dependencies: +o.runtime: c.runtime +o.runtime: h.gofc +o.runtime: h.prelude +o.runtime: c.twospace +o.runtime: c.machdep +o.runtime: C:h.swis +o.runtime: C:h.os +o.compiler: c.compiler +o.compiler: h.prelude +o.compiler: h.storage +o.compiler: h.connect +o.input: c.input +o.input: h.prelude +o.input: h.storage +o.input: h.connect +o.input: h.command +o.input: h.errors +o.input: c.parser +o.static: c.static +o.static: h.prelude +o.static: h.storage +o.static: h.connect +o.static: h.errors +o.static: c.scc +o.static: c.scc +o.static: c.scc +o.storage: c.storage +o.storage: h.prelude +o.storage: h.storage +o.storage: h.connect +o.storage: h.errors +o.type: c.type +o.type: h.prelude +o.type: h.storage +o.type: h.connect +o.type: h.errors +o.type: c.subst +o.type: c.kind +o.type: c.preds +o.cbuiltin: c.cbuiltin +o.cbuiltin: h.prelude +o.cbuiltin: h.storage +o.cbuiltin: h.connect +o.cbuiltin: h.errors +o.cbuiltin: c.prims +o.cmachine: c.cmachine +o.cmachine: h.prelude +o.cmachine: h.storage +o.cmachine: h.connect +o.cmachine: h.errors +o.gofc: c.gofc +o.gofc: h.prelude +o.gofc: h.storage +o.gofc: h.command +o.gofc: h.connect +o.gofc: h.errors +o.gofc: c.machdep +o.gofc: C:h.swis +o.gofc: C:h.os +o.gofc: c.commonui +o.gofc: c.output +o.builtin: c.builtin +o.builtin: h.prelude +o.builtin: h.storage +o.builtin: h.connect +o.builtin: h.errors +o.builtin: c.prims +o.gofer: c.gofer +o.gofer: h.prelude +o.gofer: h.storage +o.gofer: h.command +o.gofer: h.connect +o.gofer: h.errors +o.gofer: c.machdep +o.gofer: C:h.swis +o.gofer: C:h.os +o.gofer: c.commonui +o.machine: c.machine +o.machine: h.prelude +o.machine: h.storage +o.machine: h.connect +o.machine: h.errors +o.output: c.output +o.output: h.prelude +o.output: h.storage +o.output: h.connect +o.output: h.errors diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..be7126c --- /dev/null +++ b/src/Makefile @@ -0,0 +1,85 @@ +.SUFFIXES : .gp .gs .y .c .h .o +OBJECTS = storage.o input.o static.o type.o compiler.o +IOBJECTS = gofer.o builtin.o machine.o output.o $(OBJECTS) +COBJECTS = gofc.o cbuiltin.o cmachine.o $(OBJECTS) + +# Edit the following settings as required. +# There are two choices of command line editor that can be used with Gofer: +# +# GNU readline: usual GNU sources (e.g. bash distribution) +# add -DUSE_READLINE=1 to CFLAGS and libreadline.a -ltermcap to LDFLAGS +# (or maybe -lreadline -ltermcap) +# +# editline: (comp.sources.misc, vol 31, issue 71) +# add -DUSE_READLINE=1 to CFLAGS and libedit.a to LDFLAGS +# (or maybe -ledit) +# +# The best bet is to `touch prelude.h' after changing these settings to +# ensure that the whole collection of files is recompiled with the correct +# settings. + +# IMPORTANT: make sure that you use the same compiler to build gofc +# executables (often by setting an appropriate value in the gofcc script) +# as you use to build the file runtime.o (as specified by the CC macro +# below). + +CC = cc +#CFLAGS = -DUSE_READLINE=1 +CFLAGS = +LDFLAGS = -lm +OPTFLAGS = -O +OPT1 = +#OPT1 = -O1 + +all : gofer gofc runtime.o + +gofer : $(IOBJECTS) + $(CC) $(CFLAGS) $(OPTFLAGS) $(IOBJECTS) -o gofer $(LDFLAGS) + strip gofer + +gofc : $(COBJECTS) + $(CC) $(CFLAGS) $(OPTFLAGS) $(COBJECTS) -o gofc $(LDFLAGS) + strip gofc + +.c.o : + $(CC) -c $(CFLAGS) $(OPTFLAGS) $< + +clean : + rm *.o $(TESTS) + +install : + mv gofer .. + +.gs : + ./gofc $*.gs + $(CC) $(OPTFLAGS) $*.c runtime.o -o $* $(LDFLAGS) + rm $*.c + strip $* + +.gp : + ./gofc + $*.gp + $(CC) $(OPTFLAGS) $*.c runtime.o -o $* $(LDFLAGS) + rm $*.c + strip $* + +parser.c : parser.y + yacc parser.y + mv y.tab.c parser.c + +gofer.o : prelude.h storage.h connect.h errors.h \ + command.h machdep.c commonui.c +gofc.o : prelude.h storage.h connect.h errors.h \ + command.h machdep.c commonui.c output.c +runtime.o : prelude.h gofc.h machdep.c markscan.c twospace.c +storage.o : prelude.h storage.h connect.h errors.h +input.o : prelude.h storage.h connect.h errors.h parser.c command.h +static.o : prelude.h storage.h connect.h errors.h scc.c +type.o : prelude.h storage.h connect.h errors.h preds.c kind.c subst.c +output.o : prelude.h storage.h connect.h errors.h +compiler.o : prelude.h storage.h connect.h errors.h + $(CC) -c $(OPT1) $(CFLAGS) compiler.c +machine.o : prelude.h storage.h connect.h errors.h +cmachine.o : prelude.h storage.h connect.h errors.h + $(CC) -c $(OPT1) $(CFLAGS) cmachine.c +builtin.o : prelude.h storage.h connect.h errors.h prims.c +cbuiltin.o : prelude.h storage.h connect.h errors.h prims.c diff --git a/src/Makefile.ztc b/src/Makefile.ztc new file mode 100644 index 0000000..95d1d41 --- /dev/null +++ b/src/Makefile.ztc @@ -0,0 +1,86 @@ +HFILES = prelude.h storage.h connect.h errors.h command.h +CFILES = gofer.c storage.c input.c static.c type.c \ + output.c compiler.c machine.c builtin.c \ + gofc.c cmachine.c cbuiltin.c runtime.c +INCFILES = parser.c preds.c prims.c kind.c subst.c \ + machdep.c commonui.c +GC_SRC = markscan.c twospace.c +YFILES = parser.y +SOURCES = $(HFILES) $(CFILES) $(INCFILES) $(YFILES) prelude +OBJECTS = storage.obj input.obj static.obj type.obj compiler.obj +IOBJECTS = gofer.obj builtin.obj machine.obj output.obj $(OBJECTS) +COBJECTS = gofc.obj cbuiltin.obj cmachine.obj $(OBJECTS) +TESTS = apr0.exe apr1.exe apr2.exe apr3.exe apr4.exe apr5.exe apr6.exe apr7.exe apr8.exe apr9.exe apr10.exe + +# Edit the following settings as required. +# There are two choices of command line editor that can be used with Gofer: +# +# GNU readline: usual GNU sources (e.g. bash distribution) +# add -DUSE_READLINE=1 to CFLAGS and libreadline.a -ltermcap to LDFLAGS +# (or maybe -lreadline -ltermcap) +# +# editline: (comp.sources.misc, vol 31, issue 71) +# add -DUSE_READLINE=1 to CFLAGS and libedit.a to LDFLAGS +# (or maybe -ledit) +# +# The best bet is to `touch prelude.h' after changing these settings to +# ensure that the whole collection of files is recompiled with the correct +# settings. + +CC = ztc +CFLAGS = -mx -w2 +LDFLAGS = +OPTFLAGS = + +all : gofer.exe gofc.exe runtime.obj + +tests : $(TESTS) + +gofer.exe : $(IOBJECTS) + $(CC) $(CFLAGS) $(OPTFLAGS) $(IOBJECTS) -ogofer.exe $(LDFLAGS) + + +gofc.exe : $(COBJECTS) + $(CC) $(CFLAGS) $(OPTFLAGS) $(COBJECTS) -ogofc.exe $(LDFLAGS) + + +.c.obj : + $(CC) -c $(CFLAGS) $(OPTFLAGS) $< + +clean : + rm *.obj $(TESTS) + +install : + mv gofer.exe .. + mv gofc.exe .. + +.gs.exe : + gofc $*.gs + $(CC) $(CFLAGS) $(OPTFLAGS) $*.c c:\gofer\lib\runtime.obj -o$*.exe $(LDFLAGS) + rm $*.c + +.gp : + gofc + $*.gp + $(CC) $(CFLAGS) $(OPTFLAGS) $*.c c:\gofer\lib\runtime.obj -o$*.exe $(LDFLAGS) + rm $*.c + +parser.c : parser.y + yacc parser.y + mv y.tab.c parser.c + +gofer.obj : prelude.h storage.h connect.h errors.h \ + command.h machdep.c commonui.c +gofc.obj : prelude.h storage.h connect.h errors.h \ + command.h machdep.c commonui.c output.c +runtime.obj : prelude.h gofc.h machdep.c $(GC_SRC) +storage.obj : prelude.h storage.h connect.h errors.h +input.obj : prelude.h storage.h connect.h errors.h parser.c command.h +static.obj : prelude.h storage.h connect.h errors.h +type.obj : prelude.h storage.h connect.h errors.h preds.c kind.c subst.c +output.obj : prelude.h storage.h connect.h errors.h +compiler.obj : prelude.h storage.h connect.h errors.h + $(CC) -c -O1 $(CFLAGS) compiler.c +machine.obj : prelude.h storage.h connect.h errors.h +cmachine.obj : prelude.h storage.h connect.h errors.h +builtin.obj : prelude.h storage.h connect.h errors.h prims.c +cbuiltin.obj : prelude.h storage.h connect.h errors.h prims.c diff --git a/src/Readme b/src/Readme new file mode 100644 index 0000000..bef0785 --- /dev/null +++ b/src/Readme @@ -0,0 +1,553 @@ +------------------------------------------------------------------------------- +This directory contains the source for Gofer 2.30a, including both the +interpreter and compiler. + +The following give brief instructions for installing the system from +these sources. More detailed instructions for specific machines are +given below. + +You will need a directory which is available to all Gofer users on +your system to store prelude files etc. You can choose this to be +whatever you like. I'll just call it $GOFLIB here. On Unix systems, +I usually use /usr/local/lib/Gofer or a subdirectory of my home +directory, Gofer/lib. On DOS systems, I suggest C:\GOFER\LIB. + +1) Unpack the sources in a temporary directory. Copy all of the .prelude + files (these will be .PRE files under DOS) to $GOFLIB. + +2) Edit the file prelude.h to select a particular machine type. All but + one of the machine names should be #define'd as 0. Set the #define + for the machine on which you wish to compile Gofer to 1. + + If appropriate, edit the Makefile as necessary to suit your system. + In particular, make sure that the CC macro is set to the name of + the compiler you will be using (this is usually either `cc' for the + standard C compiler on a system or `gcc' for the GNU C compiler). + + If you plan to install the Gofer compiler, edit the file cmachine.c + so that the symbol GOFC_INCLUDE is set to a string containing the + pathname $GOFLIB/gofc.h -- you will see that my two suggested settings + are already set as defaults. Remember that double quote characters (") + and backslashes (\) must be escaped by a leading backslash. For example: + + "\"/usr/local/lib/Gofer/gofc.h\"" might be used on Unix machine, + "\"\C:\\GOFER\\GOFC\\GOFC.H\"" might be approp. for a DOS machine. + + Specific details for particular machine/configurations are given below. + +3) Build the system (on a Unix system, this usually means just typing + `make' and going to get a cup of something to drink ...) + + If you modify parser.y, you will need a version of yacc to create + a suitable new version of parser.c. I've had reports that the + Gofer grammar doesn't work correctly if you use either GNU bison + or Berkeley Yacc (both have a common ancestor so it's not too + surprising). I've also had comments since I first mentioned + this to tell me that bison generated grammars *do* work! If + you have any doubts, make sure that you use the parser.c file + supplied with the source rather than letting a local version of + yacc create a new one for you. The easiest way to do this is + probably to edit the makefile to leave out the construction of + parser.c. + +4) If you are going to use the Gofer compiler: + Assuming a successful build, copy the files prelude.h and gofc.h to + $GOFLIB and edit the file gofc.h, replacing #include "prelude.h" + with something like #include "$GOFLIB/prelude.h" -- don't actually + enter the string "$GOFLIB/prelude.h" here, you're meant to replace + $GOFLIB by whatever directory name you chose at the beginning of + this process. You will also need to copy the file runtime.o (or + runtime.obj, depending on your system) into $GOFLIB. + +5) You're all set. In practice, you'll want to move the gofer and gofc + binaries to somewhere sensible (probably into $GOFLIB on a unix system, + modifying the scripts in the scripts subdirectory to point to the + appropriate executables and prelude files). And you may want to + clean off any remaining object code files too ... + + IMPORTANT: If you plan to use the shell scripts provided to operate + the Gofer compiler and you have a choice of C compilers on your + system (e.g. GNU gcc and a vendor-supplied cc) make sure that the C + compiler mentioned in the script gofcc is the same C compiler used + (in the Makefile) to compile runtime.c. In a similar way, make sure + that the version of gofc.h used to compile runtime.c has the same + settings as the version of gofc.h that you put in $GOFLIB. (This is + only likely to be relevant if you install an alternative garbage + collector or change the setting on ARGCHECK.) + +I've probably left something out here. Please let me know if you have +any trouble or spot anything that you think I should have mentioned! + + +--------------------- +The do {...} notation + +To make use of the new do {...} notation described in the release +notes for Gofer 2.30, you should set the flag DO_COMPS to 1 in +prelude.h and modify the parser.y file to uncomment the productions +for do expressions. In other words, change: + + /* DO_COMPS to /* DO_COMPS */ + ... ... + */ /* */ + +in parser.y, line 452. Make sure that a new version of parser.c +is generated by yacc. If you do not have access to an implementation +of yacc, you can use the file doparser.c instead of parser.c (delete +the original parser.c, or make a copy in a safe place, and rename +doparser.c as parser.c). + + +--------------------- +GNU READLINE (or equivalent) + +Gofer can be compiled to make use of the GNU readline library. I tried +this using the readline library provided by GNU bash 1.12, although I've +found that, for my simple purposes, the editline library posted in +alt.sources works as well, and is a fraction of the size. + +See the Makefile for more details. + + +--------------------- +TURBO C version 1.5 on a PC with MSDOS: + +Set #define TURBOC 1 and the rest to 0 in prelude.h. Use the supplied +project files gofer.prj and gofc.prj to generate the interpreter and +compiler respectively. Before starting the compilation, make sure that +you set the following command line options (all of this is intended to +be carried out from within the IDE): + + Medium model, stack check ON, Merge duplicate strings, Jump + optimization ON, Possibly incorrect assignment warning off. + +Select project gofer.prj and make. Select project gofc.prj and make. + +In order to make the runtime library and use the compiler, I suggest +creating a batch file GTCC.BAT containing: + + tcc -O -ms -IC:\TURBOC\INCLUDE -LC:\TURBOC\LIB %1 %2 %3 %4 %5 %6 %7 + +then use this to build the runtime system: gtcc -c runtime.c +and compile programs using: gofc prog.gs + gtcc prog.c runtime.obj + +Since the PC has a fairly limited amount of memory, you may find that you +need to compile a new version of the Gofer system without floating point +support (or you may need to select a markscan garbage collector in place +of the default twospace collector). + + +--------------------- +BORLAND C++ version 3.1 on a PC with MSDOS: + +Set #define BCC 1 and the rest to 0 in prelude.h. You will need to +remove the project files gofer.prj and gofc.prj supplied with the +Gofer source and rebuild your own project files from within the IDE. +The project file for the interpreter should contain the files: + + gofer.c, input.c, static.c, type.c, compiler.c, machine.c, + storage.c, output.c and builtin.c. + +The project file for the compiler should contain the files: + + gofc.c, input.c, static.c, type.c, compiler.c, cmachine.c, + storage.c and cbuiltin.c. (output.c is not required). + +Before starting the compilation, make sure that you set the following +command line options (all of this is intended to be carried out from +within the IDE): + + Medium model, stack check ON, Merge duplicate strings, No debugging + information in object files, no standard stack frames, fastest code + (or smallest, if memory is tight), source debugging - none, possibly + incorrect assignment warning off. + +If you have a 386 machine or a floating point coprocessor, you will find +a small benefit in setting the relevant compiler options to make use of +these features too. + +In order to make the runtime library and use the compiler, I suggest +creating a batch file BTCC.BAT containing: + + Bcc -O -ms -IC:\BORLANDC\INCLUDE -LC:\BORLANDC\LIB %1 %2 %3 %4 %5 %6 %7 + +then use this to build the runtime system: btcc -c runtime.c +and compile programs using: gofc prog.gs + btcc prog.c runtime.obj + +Since the PC has a fairly limited amount of memory, you may find that you +need to compile a new version of the Gofer system without floating point +support (or you may need to select a markscan garbage collector in place +of the default twospace collector). + + +--------------------- +Zortech C++ v3.0 for IBM PC (>=386) + +Set #define ZTC 1 and the rest to 0 in prelude.h. Compile using the +makefile supplied as Makefile.ztc. Thanks to John Lazenby for the patches +to get this to work! + + +--------------------- +DJGPP 1.09 on MSDOS: + +WARNING: I don't think the following will work with recent versions of +DJGPP (1.09 is NOT the most recent) because they do not include the necessary +support for signals. + +DJGPP is a DOS port of the GNU C compiler produced by DJ Delorie. It +requires a 386 or better, but gives you much better opportunities to +make use of the resources that such machines provide. Much larger +heaps can be used, and the 32 bit code produced by DJGPP runs a lot +faster than the versions produced by TURBO C or BORLAND C, even on the +same machine! + +DJGPP depends on the use of a DOS extender, go32. A modified version +of go32 has been produced which supports signals, allowing the Gofer +interpreter to recover from a program interrupt (i.e. pressing ^C +during an evaluation). The original version of go32 was written by +DJ Delorie. Rami El Charif has modified go32 to handle signals, +essential for any serious work with Gofer. Thanks Rami! + +Instructions for building the modified go32 and compiling Gofer with +DJGPP 1.09 are included in the readme file in the 386gofer.zip archive +in the standard Gofer distribution. + + +--------------------- +NEXT versions: + +Set #define NEXTSTEP 1 and the rest to 0 in prelude.h. Edit the Makefile +to set the C compiler (defined by the macro CC) to cc. (If you would +prefer to use the current GNU C compiler i.e. gcc 2.x and have this +installed on your system, choose #define NEXTGCC 1 instead of NEXTSTEP +and set CC to gcc). Run the make command to build gofer, gofc and runtime.o. + + +--------------------- +SUNOS versions: + +Set #define SUNOS 1 and the rest to 0 in prelude.h. Edit the Makefile +as necessary. I tried this on a Sun 4 using gcc, but I think it should +also work on Sun 3, and with cc ... If your site has both Sun3 and +Sun4 machines, the following script may be of use: + + #!/bin/sh + + GOFER=/usr/local/lib/Gofer/prelude + export GOFER + + if (sparc) then + exec /usr/local/lib/Gofer/gofer4 $* + elif (m68k) then + exec /usr/local/lib/Gofer/gofer3 $* + else + echo I dont know how to start Gofer on your machine + fi + + +--------------------- +IBM OS/2 2.0 using EMX GCC: + +Set #define OS2 1 and the rest to 0 in prelude.h. Thanks to +Bryan Scattergood for sending the patches to get this working! + + +--------------------- +System V release 4 (and 3) using GCC2.2: + +Set #define SVR4 1 and the rest to 0 in prelude.h. Thanks to +Bryan Scattergood for sending the patches to get this working! +Thanks also to Goeran Uddeborg for the observation that the +same patches can also be used to compile Gofer with gcc on SVr3! + + +--------------------- +SCO Unix 3.2.4: + +Set #define SVR4 1 and the rest to 0 in prelude.h. Compile using gcc 2.2.2. +Thanks to Rodney Brown! + + +--------------------- +SiliconGraphics (Indigo, Elan, VGX and Iris 4D, running IRIX v4.0.5): + +Set #define SGI4 1 and the rest to 0 in prelude.h. You might also +like to set CFLAGS = -ansi -woff 100 # "return not reached" in the +Makefile. Thanks to Sebastian Egner for these changes. + +A previously suggested method for compiling Gofer on an SGI machine +which may still be useful: Set #define SVR4 1 and the rest to 0 in +prelude.h. Set the makefile to use cc. If you are running on a +machine with a MIPS R4000 CPU, you might also like to add -mips2 +to CFLAGS (this should not be used if you want backward compatibility +with machines based on the MIPS R3000 CPU). I think you can probably +build Gofer using gcc but I haven't had the opportunity to try that +myself. + + +--------------------- +HP systems: + +Set #define HPUX 1 and the rest to 0 in prelude.h. I've had patches +for HP machines from a number of people including Tom Lane, Dipankar +Gupta, Rodney Brown and Jeroen Fokker and I've tried to work these into +the source for 2.28. There were occasional discrepancies between the +sets of patches that I received so I sometimes had to take a `majority +vote'; perhaps they were for slightly different machines? Anyway, I +hope that Gofer will compile on HP machines using these settings -- or +at least be easy to patch to make it run correctly if not. Thanks for +the patches everyone! + +It has now been verified that the HPUX patch version will at least +compile correctly on HP series 400 workstations (68040 CPU) running +HP-UX 8.0 with gcc, thanks to Kurt Olender! + +Gofer 2.28 has also been built on an H.P. Series 700 machine running +HP-UX 8.07. Gofer does not work if it is compiled using gcc (2.3.3). +Use the HP C compiler (cc) in ANSI mode. A guide to setting the +macro definitions in the Makefile: + + CC = cc + CFLAGS = -Aa -D_HPUX_SOURCE + LDFLAGS = -lm + OPTFLAGS = +O3 + OPT1 = +O1 + +Thanks to Dave Sherratt for this information! + + +--------------------- +DECstation 5000 running Ultrix 4.2 (MIPS R3000 CPU) with GCC2.3.3: + +Set #define ULTRIX 1 and the rest to 0 in prelude.h. Thanks to Kurt Olender +for the patches! + +This release of Gofer includes a slight modification, brought to my notice +by Jerry Prothero, which should also make it possible to compile Gofer using +DEC's own cc compiler instead of gcc. Thanks Jerry! + + +--------------------- +IBM AIX on RS/6000 using GCC: + +Set #define AIX 1 and the rest to 0 in prelude.h. Thanks (again) to Kurt +Olender for the patches! + + +--------------------- +Minix 68K: + +Set #define MINIX68K 1 and the rest to 0 in prelude.h. Rainer Orth +sent me sent me some patches to make Gofer 2.23 compile and run under +Minix 68k using the GNU C compiler, I believe. I have tried to make +the same changes to the latest version, but I have not verified that +they work. Some small changes may be needed -- please let me know if +you try it. Thanks Rainer! + + +--------------------- +Linux with gcc: + +Set #define LINUX 1 and the rest to 0 in prelude.h. Ray Bellis sent me +some patches to make Gofer 2.23 compile and run under Linux using the +GNU C compiler. I have tried to make the same changes to the latest +version, but I have not verified that they work. Some small changes +may be needed -- please let me know if you try it. And thanks, Ray! + +Since 2.28 was first distributed I've had feedback from two people +that have compiled Gofer to run on Linux. Bambang Prastowo wrote +to let me know that Gofer compiled without modifications (other +than setting #define LINUX 1). Eak Khoon reported that it was +neccessary to comment out the #define const at the beginning of +prelude.h and change prototypes in prelude.h to: + extern *getenv Args((const char *)); + extern system Args((const char *)); + extern atof Args((const char *)); +This may be due to the use of slightly different compilers or versions +of Linux. In any case, it should be fairly straightforward to build +Gofer to run under Linux. + + +--------------------- +Acorn DesktopC and RISCOS2 or 3: + +Set #define RISCOS 1 and the rest to 0 in prelude.h. Use the file +AcornMake to build the Gofer system. Thanks to Bryan Scattergood for +the patches to make Gofer compile and run under RISCOS! + + +--------------------- +Amiga using gcc 2.5.8: + +Set #define AMIGA 1 and the rest to 0 in prelude.h. Set + CC = gcc, + CFLAGS = -s -DUSE_READLINE=1 + LDFLAGS = -s -lm + OPTFLAGS = -O2 + OPT1 = -O2 +in the Makefile and compile using gcc 2.5.8. In previous releases, +an extra program called amigaint.c was needed to overcome an apparent +shortcoming with signals processing in gcc 2.2.2 for the Amiga. +Thanks to Luc and Mark Duponcheel for their help in getting this +to work and to Frederek Althoff who wrote the amigaint.c program. +The problem with signal handling has now been investigated by Dirk +Nehring, and it seems that there is no longer any need for amigaint +when the new version of gcc is used (2.5.8). Dirk's instuctions +for running Gofer are: + 1. 'stack 250000' (or higher) + 2. 'setenv GOFER /Gofer/prelude/standard.prelude' + 3. Start Gofer with 'gofer +.k -h200000' +Thanks Dirk! + + +--------------------- +DEC Alpha with OSF/1: + +Set #define ALPHA 1 and the rest to 0 in prelude.h. Briefly, I tried +compiling Gofer on a 64 bit DEC Alpha with a preliminary version of +OSF/1. I didn't spend long, but it seems that it is probably safest to +compile without using any optimization. Furthermore, only the +interpreter can be used at the current time and integers are restricted +to 32 bit quantities. I may do something to change this one day, but +it is not a high priority. Essentially, what needs to be done is to +redefine the Int type as a synonym (i.e. typedef) for long and to +replace all appropriate uses of %d in prinf strings with %ld. + + +--------------------- +MIPS RC6280(BSDenvironment on OS2.2): +SONY machine(NWS-3870, BSD4.3- based OS NEWS OS4.2R, Mips-made risk chip): + +Set #define MIPS 1 and the rest to 0 in prelude.h. The patches for this +version of Gofer were sent to me by Hiroyuki Matsuda ... thanks! I only +hope that I have correctly incorporated them into the main distribution! + + +--------------------- +NETBSD: + +Set #define NETBSD 1 and the rest to 0 in prelude.h. Thanks to Daniel +Harris for getting this to work! + + +--------------------- +OTHER PLATFORMS: + +Gofer has been tested on other platforms and most of the code is +fairly standard. The code does however make certain assumptions +about the system on which Gofer will be used. These are summarised +below as an aid to those interested in porting Gofer to other +systems: + +1) For the benefit of Garbage collection from the C stack, all + function parameters and local variables are expected to have + sizes which are a multiple of sizeof(Int) (defined in prelude.h). + In other words, you should check that: + + sizeof(FloatImpType) % sizeof(Int) == 0 + sizeof(String) % sizeof(Int) == 0 + sizeof(Char) % sizeof(Int) == 0 + sizeof(Long) % sizeof(Int) == 0 + sizeof(Unsigned) % sizeof(Int) == 0 + + (These types are defined in prelude.h and storage.h) + +2) Study the comments and settings in prelude.h in order to find + out how other ports of Gofer have been produced. + +3) The words local and far are used to access non-standard extensions + in Turbo C to allow the Gofer system to overcome some of the + limitations of the PC's segmented architecture. These should + be #defined to empty strings on most other machines with a flat + address space. + +4) The current version of the garbage collector in the Gofer + interpreter uses the C call stack as an array of Cell values to + find temporary variables that point into the heap. This is a + well-known technique often described as `conservative garbage + collection' but the implementation in C is inherently non-portable. + Surprisingly enough though, for almost all of the machines + supported, you can make some simple assumptions and get things + to work quite nicely. The RISCOS code is one example where + things are very different. But for the most part, you can treat + the C stack as an array of Cell values. As the program runs + the size of the stack changes and you need to know the extent + of the array. The first element pushed onto the stack is pretty + much fixed, so it is the position of the stack pointer that + determines how big the stack is. + + On many machines, the stack grows downwards. I have yet to come + across a machine where the stack grows upwards, but I have heard + that this happens on some HP systems. + + Here is the way to deal with this in the current version of the + code. In machdep.c, you will find a function gcCStack() which + traverses the stack. To make things easier, there are three + macros: + + #define StackGrowsDown ... + #define StackGrowsUp ... + #define GuessDirection ... + + The first two describe the way to mark the stack on a machine + in which the stack grows either up or down respectively. The + third tries to guess which way to do things by comparing two + pointers. Strictly speaking, this comparison probably doesn't + fall under the definition of standard C so it may not be portable. + The current usage of these functions is as follows: + + #if HPUX + GuessDirection; + #else + StackGrowsDown; + #endif + + Change as necessary to suit your machine (and please let me + know so that I can update the source). + +Almost all of the machine dependencies in the code for Gofer are +contained in the header file "prelude.h", and the program file +"machdep.c". These files contain definitions for both the TURBOC +and UNIX versions described above and should be a useful guide. + +For general information about the implementation of Gofer, please +consult the following report: + + The implementation of the Gofer functional programming system + Mark P. Jones + Research Report YALEU/DCS/RR-1030 + Yale University, Department of Computer Science, + May 1994. + +Copies of this report are currently available by anonymous ftp from +nebula.cs.yale.edu in the directory pub/yale-fp/reports, together +with a number of other recent reports by members of the Yale Haskell +project. + +I regret that I do not have time to write more substantial notes +for porting Gofer at the present time. I will however be happy to +offer advice and answer other questions if you want to contact me +in person at the email address below. If you do successfully +complete a port for another machine, please let me know what changes +are necessary. I know that it isn't always possible, but if you +can, please try to restrict changes to the prelude.h and machdep.c +files. + +--------------------- + +NOTE: if Gofer starts behaving unexpectedly, try recompiling without +full compiler optimisation and see if the problem still occurs. +If so, please get in touch with me, giving me as much information +about the problem as possible, and I'll try and sort it out for +you. If you find a bug which you fix yourself, please send me +details so that I can pass the fix onto to other users of Gofer. + +If gofc starts behaving unexpectedly, try running the same code +through the interpreter. + +Until mid-July 1994: jones-mark@cs.yale.edu +From Sept/Oct 1994: mpj@cs.nott.ac.uk +------------------------------------------------------------------------------- diff --git a/src/builtin.c b/src/builtin.c new file mode 100644 index 0000000..db0c20d --- /dev/null +++ b/src/builtin.c @@ -0,0 +1,145 @@ +/* -------------------------------------------------------------------------- + * builtin.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Primitive functions, input output etc... + * ------------------------------------------------------------------------*/ + +#define NEED_MATH +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "errors.h" + +Name nameFatbar, nameFail; /* primitives reqd for translation */ +Name nameIf, nameSel; +Name nameMinus, nameDivide; + +Name nameUndefMem; /* undefined member primitive */ +Name nameError; /* error primitive function */ +Name nameBlackHole; /* for GC-detected black hole */ + +Name nameAnd, nameOr; /* built-in logical connectives */ +Name nameOtherwise; + +Name namePrint, nameNPrint; /* primitives for printing */ + +#if HASKELL_ARRAYS +static Name nameEltUndef; /* undefined element in array */ +static Name nameOutBounds; /* value of of bounds */ +#endif +#if IO_MONAD +Name nameSTRun; /* encapsulation operator for IO */ +static Name nameFst; /* fst primitive */ +static Name nameSnd; /* snd primitive */ +#endif +#ifdef LAMBDAVAR +static Name nameLvUnbound; /* unbound mutable variable */ +#endif +#ifdef LAMBDANU +static Name nameLnUnbound; /* unbound mutable variable */ +static Name nameLnNocont; /* unspecified continuation */ +static Name nameLnFlip; /* simple flip primitive */ +static Name nameLnDone; /* simple finishing continuation */ +#endif + +/* -------------------------------------------------------------------------- + * Built-in primitives: + * ------------------------------------------------------------------------*/ + +#define PRIMITIVES_CODE 1 /* want to include code for prims */ +#include "prims.c" + +/* -------------------------------------------------------------------------- + * Built-in control: + * ------------------------------------------------------------------------*/ + +Void builtIn(what) +Int what; { + Int i; + + switch (what) { +#if IO_DIALOGUE + case RESET : if (writingFile) { + fclose(writingFile); + writingFile = 0; + } + break; +#endif + + case MARK : for (i=0; i +#include + +/*#define GOFC_INCLUDE "\"gofc.h\""*/ + +#ifndef GOFC_INCLUDE +#if (TURBOC | BCC | DJGPP | WATCOM) +#define GOFC_INCLUDE "\"/gofer/gofc/gofc.h\"" +#else +#if RISCOS +#define GOFC_INCLUDE "\"Lib:h.gofc\"" +#else +#define GOFC_INCLUDE "\"/usr/local/lib/Gofer/gofc.h\"" +#endif +#endif +#endif + +/*#define DEBUG_CODE*/ + +Bool andorOptimise = TRUE; /* TRUE => optimise uses of &&, || */ + +/* -------------------------------------------------------------------------- + * Data structures for machine memory (program storage): + * ------------------------------------------------------------------------*/ + +typedef enum { + iLOAD, iCELL, iCHAR, iINT, iFLOAT, + iSTRING, iMKAP, iUPDATE, iUPDAP, iEVAL, + iRETURN, iINTEQ, iTEST, iGOTO, iSETSTK, + iALLOC, iSLIDE, iROOT, iDICT, iFLUSH, + iLABEL, iSTKIS, iEND, +#if NPLUSK + iINTGE, iINTDV, +#endif + iEXTERN +} Instr; + +typedef Int Label; + +typedef union { + Int intVal; +#if !BREAK_FLOATS + Float floatVal; +#endif + Cell cellVal; + Text textVal; + Instr instrVal; + Label labVal; +} MemCell; + +typedef MemCell far *Memory; +static Memory memory; +#define intAt(m) memory[m].intVal +#if !BREAK_FLOATS +#define floatAt(m) memory[m].floatVal +#endif +#define cellAt(m) memory[m].cellVal +#define textAt(m) memory[m].textVal +#define instrAt(m) memory[m].instrVal +#define labAt(m) memory[m].labVal + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local instrNone Args((Instr)); +static Void local instrInt Args((Instr,Int)); +static Void local instrFloat Args((Instr,FloatPro)); +static Void local instrCell Args((Instr,Cell)); +static Void local instrText Args((Instr,Text)); +static Void local instrLab Args((Instr,Label)); +static Void local instrIntLab Args((Instr,Int,Label)); +static Void local instrCellLab Args((Instr,Cell,Label)); + +static Void local asSTART Args((Void)); +static Label local newLabel Args((Void)); +static Void local asLABEL Args((Label)); +static Void local asEND Args((Void)); + +static Void local asMKAP Args((Int)); +static Void local asUPDATE Args((Int)); + +#ifdef DEBUG_CODE +static Void local dissassemble Args((Addr)); +static Void local printCell Args((Cell)); +static Addr local dissNone Args((Addr,String)); +static Addr local dissInt Args((Addr,String)); +static Addr local dissFloat Args((Addr,String)); +static Addr local dissCell Args((Addr,String)); +static Addr local dissText Args((Addr,String)); +static Addr local dissLab Args((Addr,String)); +static Addr local dissIntLab Args((Addr,String)); +static Addr local dissCellLab Args((Addr,String)); +#endif + +static Void local doCont Args((Pair)); +static Pair local flush Args((Pair)); +static Void local make Args((Cell,Int,Label,Pair)); +static Void local makeCond Args((Cell,Cell,Cell,Int,Label,Pair)); +static Void local makeCase Args((Cell,Int,Label,Pair)); +static Void local testCase Args((Pair,Int,Label,Label,Pair)); +static Void local makeGded Args((List,Int,Label,Pair)); +static Bool local testGuard Args((Pair,Int,Label,Label,Pair)); + +static Void local dependsOn Args((Cell)); +static Void local build Args((Cell,Int)); +static Void local buildGuards Args((List,Int)); +static Int local buildLoc Args((List,Int)); + +static Void local analyseAp Args((Cell)); +static Void local buildAp Args((Cell,Int,Label,Bool)); + +static List local identifyDeps Args((Name)); +static Void local checkPrimDep Args((Name,Name)); +static Void local outputCDecls Args((FILE *,List)); +static Void local outputCDicts Args((FILE *)); + +static Void local rspRecalc Args((Void)); + +static Void local outputCSc Args((FILE *,Name)); +static List local cCode Args((Int,Addr)); +static List local heapUse Args((List)); +static List local heapAnalyse Args((List)); +static Void local outputCinst Args((FILE *,Cell)); + +static Void local expr Args((FILE *,Cell)); +static Void local outputLabel Args((FILE *,Int)); +static Void local outputJump Args((FILE *,Int)); +static Void local outputCStr Args((FILE *, String)); +static Bool local validCIdent Args((String)); +static String local scNameOf Args((Name)); + +static Void local startTable Args((String,String,String)); +static Void local tableItem Args((FILE *,String)); +static Void local finishTable Args((FILE *)); + +static Int local externArity Args((Type)); +static Type local transExtType Args((Type)); +static String local showExtType Args((Type)); +static String local showExtRes Args((Type)); +static String local showExtRet Args((Type)); +static Void local externBody Args((FILE *,String,Type)); + +/* -------------------------------------------------------------------------- + * Assembler: (Low level, instruction code storage) + * ------------------------------------------------------------------------*/ + +static Addr startInstr; /* first instruction after START */ +static Addr lastInstr; /* last instr written (for peephole*/ + /* optimisations etc.) */ +static Int srsp; /* simulated runtime stack pointer */ +static Int offsPosn[NUM_OFFSETS]; /* mapping from logical to physical*/ + /* offset positions */ + +static Void local instrNone(opc) /* Opcode with no operands */ +Instr opc; { + lastInstr = getMem(1); + instrAt(lastInstr) = opc; +} + +static Void local instrInt(opc,n) /* Opcode with integer operand */ +Instr opc; +Int n; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + intAt(lastInstr+1) = n; +} + +static Void local instrFloat(opc,fl) /* Opcode with Float operand */ +Instr opc; +FloatPro fl; { +#if BREAK_FLOATS + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = part1Float(fl); + cellAt(lastInstr+2) = part2Float(fl); +#else + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + floatAt(lastInstr+1) = fl; +#endif +} + +static Void local instrCell(opc,c) /* Opcode with Cell operand */ +Instr opc; +Cell c; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = c; +} + +static Void local instrText(opc,t) /* Opcode with Text operand */ +Instr opc; +Text t; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + textAt(lastInstr+1) = t; +} + +static Void local instrLab(opc,l) /* Opcode with label operand */ +Instr opc; +Label l; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + labAt(lastInstr+1) = l; + if (l<0) + internal("bad Label"); +} + +static Void local instrIntLab(opc,n,l) /* Opcode with int, label operands */ +Instr opc; +Int n; +Label l; { + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + intAt(lastInstr+1) = n; + labAt(lastInstr+2) = l; + if (l<0) + internal("bad Label"); +} + +static Void local instrCellLab(opc,c,l) /* Opcode with cell, label operands*/ +Instr opc; +Cell c; +Label l; { + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = c; + labAt(lastInstr+2) = l; + if (l<0) + internal("bad Label"); +} + +/* -------------------------------------------------------------------------- + * Main low level assembler control: (includes label assignment and fixup) + * ------------------------------------------------------------------------*/ + +static Label nextLab; /* next label number to allocate */ +static Label fixups[NUM_FIXUPS]; /* fixups for label values */ +#define FAIL 0 /* special label for fail() */ + +#define fix(a) labAt(a) = fixups[labAt(a)] + +static Void local asSTART() { /* initialise assembler */ + fixups[0] = FAIL; /* use label 0 for fail() */ + nextLab = 1; + startInstr = getMem(0); + lastInstr = startInstr-1; + srsp = 0; + offsPosn[0] = 0; +} + +static Label local newLabel() { /* allocate new label */ + if (nextLab>=NUM_FIXUPS) { + ERROR(0) "Compiled code too complex" + EEND; + } + return nextLab++; +} + +static Void local asLABEL(l) /* indicate label reached */ +Label l; { + if (instrAt(lastInstr)==iGOTO && labAt(lastInstr+1)==l) { + instrAt(lastInstr) = iLABEL; /* GOTO l; LABEL l ==> LABEL l */ + fixups[l] = l; + } + else if (instrAt(lastInstr)==iLABEL)/* code already labelled at this pt*/ + fixups[l] = labAt(lastInstr+1); /* so use previous label */ + else { + instrLab(iLABEL,l); /* otherwise insert new label */ + fixups[l] = l; + } +} + +static Void local asEND() { /* Fix addresses in assembled code */ + Addr pc = startInstr; + + instrNone(iEND); /* insert END opcode */ + for (;;) + switch (instrAt(pc)) { + case iEND : return; /* end of code sequence */ + + case iEVAL : /* opcodes taking no arguments */ + case iFLUSH : + case iRETURN : pc++; + break; + + case iGOTO : fix(pc+1); /* opcodes taking one argument */ + case iLABEL : /* no need for a fix here !*/ + case iSETSTK : + case iSTKIS : + case iALLOC : + case iSLIDE : + case iROOT : + case iDICT : + case iLOAD : + case iCELL : + case iCHAR : + case iINT : +#if !BREAK_FLOATS + case iFLOAT : +#endif + case iSTRING : + case iMKAP : + case iUPDATE : + case iUPDAP : pc+=2; + break; +#if BREAK_FLOATS + case iFLOAT : pc+=3; + break; +#endif + + case iINTEQ : /* opcodes taking two arguments */ +#if NPLUSK + case iINTGE : + case iINTDV : +#endif + case iTEST : fix(pc+2); + pc+=3; + break; + + default : internal("asEND"); + } +} + +/* -------------------------------------------------------------------------- + * Assembler Opcodes: (includes simple peephole optimisations) + * ------------------------------------------------------------------------*/ + +#define asINTEGER(n) instrInt(iINT,n); srsp++ +#define asFLOAT(fl) instrFloat(iFLOAT,fl); srsp++ +#define asCHAR(n) instrInt(iCHAR,n); srsp++ +#define asLOAD(n) instrInt(iLOAD,n); srsp++ +#define asALLOC(n) instrInt(iALLOC,n); srsp+=n +#define asROOT(n) instrInt(iROOT,n); srsp++ +#define asSETSTK(n) instrInt(iSETSTK,n); srsp=n +#define asSTKIS(n) instrInt(iSTKIS,n); srsp=n +#define asEVAL() instrNone(iEVAL); srsp-- /* inaccurate srsp */ +#define asFLUSH() instrNone(iFLUSH) +#define asRETURN() instrNone(iRETURN) +#define asCELL(c) instrCell(iCELL,c); srsp++ +#define asTEST(c,l) instrCellLab(iTEST,c,l) /* inaccurate srsp */ +#define asINTEQ(n,l) instrIntLab(iINTEQ,n,l) +#if NPLUSK +#define asINTGE(n,l) instrIntLab(iINTGE,n,l) /* inaccurate srsp */ +#define asINTDV(n,l) instrIntLab(iINTDV,n,l) /* inaccurate srsp */ +#endif +#define asGOTO(l) instrLab(iGOTO,l) +#define asSLIDE(n) instrInt(iSLIDE,n); srsp-=n +#define asDICT(n) if (n>0) instrInt(iDICT,n) +#define asEXTERN(t) instrText(iEXTERN,t) +#define asSTRING(t) if (*textToStr(t)) \ + instrText(iSTRING,t); \ + else \ + instrCell(iCELL,nameNil); \ + srsp++ + +static Void local asMKAP(n) /* Make application nodes ... */ +Int n; { + if (instrAt(lastInstr)==iMKAP) /* Peephole optimisation: */ + intAt(lastInstr+1)+=n; /* MKAP n; MKAP m ===> MKAP (n+m) */ + else + instrInt(iMKAP,n); + srsp -= n; +} + +static Void local asUPDATE(n) /* Update node ... */ +Int n; { + if (instrAt(lastInstr)==iMKAP) { /* Peephole optimisations: */ + if (intAt(lastInstr+1)>1) { /* MKAP (n+1); UPDATE p */ + intAt(lastInstr+1)--; /* ===> MKAP n; UPDAP p */ + instrInt(iUPDAP,n); + } + else { + instrAt(lastInstr) = iUPDAP; + intAt(lastInstr+1) = n; /* MKAP 1; UPDATE p ===> UPDAP p */ + } + } + else + instrInt(iUPDATE,n); + srsp--; +} + +/* -------------------------------------------------------------------------- + * Dissassembler: + * ------------------------------------------------------------------------*/ + +#ifdef DEBUG_CODE +static Void local dissassemble(pc) /* print dissassembly of code */ +Addr pc; { + for (;;) + switch (instrAt(pc)) { + case iEND : return; + case iLOAD : pc = dissInt(pc,"LOAD"); break; + case iCELL : pc = dissCell(pc,"CELL"); break; + case iCHAR : pc = dissInt(pc,"CHAR"); break; + case iINT : pc = dissInt(pc,"INT"); break; + case iFLOAT : pc = dissFloat(pc,"FLOAT"); break; + case iSTRING : pc = dissText(pc,"STRING"); break; + case iMKAP : pc = dissInt(pc,"MKAP"); break; + case iUPDATE : pc = dissInt(pc,"UPDATE"); break; + case iUPDAP : pc = dissInt(pc,"UPDAP"); break; + case iEVAL : pc = dissNone(pc,"EVAL"); break; + case iFLUSH : pc = dissNone(pc,"FLUSH"); break; + case iRETURN : pc = dissNone(pc,"RETURN"); break; + case iSETSTK : pc = dissInt(pc,"SETSTK"); break; + case iSTKIS : pc = dissInt(pc,"STKIS"); break; + case iALLOC : pc = dissInt(pc,"ALLOC"); break; + case iSLIDE : pc = dissInt(pc,"SLIDE"); break; + case iROOT : pc = dissInt(pc,"ROOT"); break; + case iDICT : pc = dissInt(pc,"DICT"); break; + case iINTEQ : pc = dissIntLab(pc,"INTEQ"); break; +#if NPLUSK + case iINTGE : pc = dissIntLab(pc,"INTGE"); break; + case iINTDV : pc = dissIntLab(pc,"INTDV"); break; +#endif + case iTEST : pc = dissCellLab(pc,"TEST"); break; + case iGOTO : pc = dissLab(pc,"GOTO"); break; + case iLABEL : pc = dissLab(pc,"LABEL"); break; + default : internal("unknown instruction"); + } +} + +static Void local printCell(c) /* printable representation of Cell */ +Cell c; { + if (isName(c)) + printf("%s",textToStr(name(c).text)); + else + printf("$%d",c); +} + +static Addr local dissNone(pc,s) /* dissassemble instr no args */ +Addr pc; +String s; { + printf("%s\n",s); + return pc+1; +} + +static Addr local dissInt(pc,s) /* dissassemble instr with Int arg */ +Addr pc; +String s; { + printf("%s\t%d\n",s,intAt(pc+1)); + return pc+2; +} + +static Addr local dissFloat(pc,s) /* dissassemble instr with Float arg*/ +Addr pc; +String s; { +#if BREAK_FLOATS + printf("%s\t%s\n",s, + floatToString(floatFromParts(cellAt(pc+1),cellAt(pc+2)))); + return pc+3; +#else + printf("%s\t%s\n",s,floatToString(floatAt(pc+1))); + return pc+2; +#endif +} + +static Addr local dissCell(pc,s) /* dissassemble instr with Cell arg */ +Addr pc; +String s; { + printf("%s\t",s); + printCell(cellAt(pc+1)); + printf("\n"); + return pc+2; +} + +static Addr local dissText(pc,s) /* dissassemble instr with Text arg */ +Addr pc; +String s; { + printf("%s\t%s\n",s,textToStr(textAt(pc+1))); + return pc+2; +} + +static Addr local dissLab(pc,s) /* dissassemble instr with Label arg */ +Addr pc; +String s; { + printf("%s\t%d\n",s,labAt(pc+1)); + return pc+2; +} + +static Addr local dissIntLab(pc,s) /* dissassemble instr with Int+Label */ +Addr pc; +String s; { + printf("%s\t%d\t%d\n",s,intAt(pc+1),labAt(pc+2)); + return pc+3; +} + +static Addr local dissCellLab(pc,s) /* dissassemble instr with Cell+Label*/ +Addr pc; +String s; { + printf("%s\t",s); + printCell(cellAt(pc+1)); + printf("\t%d\n",labAt(pc+2)); + return pc+3; +} +#endif + +/* -------------------------------------------------------------------------- + * Compile expression to code which will build expression evaluating guards + * and testing cases to avoid building complete graph. + * + * This section of code has been rewritten from the original form in + * version 2.21 of the interpreter to use a more sophisticated form of + * continuation rather than the simple UPDRET/SHOULDNTFAIL/label etc + * used in that program. The aim of this rewrite is (of course) to try + * and produce better output code. The basic type for continuations is: + * + * type Continuation = (Int, ThenWhat) + * data ThenWhat = RUNONC -- next instr + * | FRUNONC -- FLUSH then next instr + * | BRANCH Label -- branch to label + * | FBRANCH Label -- FLUSH then branch + * | UPDRETC -- UPDATE 0; RETURN + * + * As an example of the kind of optimisations we can get by this: + * + * ...; MKAP 4; SLIDE m ; UPDATE 0 ; RETURN + * ====> ...; MKAP 3; UPDAP 0; RETURN + * + * ...; MKAP 2; FLUSH ; UPDATE 0; RETURN + * ====> ...; MKAP 1; UPDAP 0; RETURN + * + * ...; SLIDE m; SLIDE n; ... ====> ...; SLIDE (m+n); ... + * (this one was previously obtained by a peephole optimisation) + * ------------------------------------------------------------------------*/ + +static Pair shouldntFail; /* error continuation */ +static Pair functionReturn; /* initial function continuation */ +static Pair noAction; /* skip continuation */ + +static Void local doCont(c) /* insert code for continuation */ +Pair c; { + Int sl = intOf(fst(c)); + switch (whatIs(snd(c))) { + case FRUNONC : asFLUSH(); + case RUNONC : if (sl>0) { + asSLIDE(sl); + } + break; + + case FBRANCH : asFLUSH(); + case BRANCH : if (sl>0) { + asSLIDE(sl); + } + asGOTO(intOf(snd(snd(c)))); + break; + + case UPDRETC : asUPDATE(0); + asRETURN(); + break; + + case ERRCONT : + default : internal("doCont"); + } +} + +#define slide(n,d) pair(mkInt(intOf(fst(d))+n),snd(d)) +#define isRunon(d) (snd(d)==RUNONC || snd(d)==FRUNONC) +#define fbranch(l,d) pair(fst(d),ap(FBRANCH,l)) +#define frunon(d) pair(fst(d),FRUNONC) + +static Pair local flush(d) /* force flush on continuation */ +Pair d; { + switch (whatIs(snd(d))) { + case RUNONC : return frunon(d); + case BRANCH : return fbranch(snd(snd(d)),d); + default : return d; + } +} + +static Void local make(e,co,f,d) /* Construct code to build e, given*/ +Cell e; /* current offset co, and branch */ +Int co; /* to f on failure, d on completion*/ +Label f; +Pair d; { + switch (whatIs(e)) { + + case LETREC : { Int n = buildLoc(fst(snd(e)),co); + make(snd(snd(e)),co+n,f,slide(n,d)); + } + break; + + case FATBAR : if (isRunon(d)) { + Label l1 = newLabel(); + Label l2 = newLabel(); + Int savesp = srsp; + make(fst(snd(e)),co,l1,fbranch(mkInt(l2),d)); + asLABEL(l1); + asSETSTK(savesp); + make(snd(snd(e)),co,f,frunon(d)); + asLABEL(l2); + } + else { + Label l = newLabel(); + Cell d1 = flush(d); + Int savesp = srsp; + make(fst(snd(e)),co,l,d1); + asLABEL(l); + asSETSTK(savesp); + make(snd(snd(e)),co,f,d1); + } + break; + + case COND : makeCond(fst3(snd(e)), + snd3(snd(e)), + thd3(snd(e)),co,f,d); + break; + + case CASE : makeCase(snd(e),co,f,d); + break; + + case GUARDED : makeGded(snd(e),co,f,d); + break; + + case AP : if (andorOptimise) { + Cell h = getHead(e); + if (h==nameAnd && argCount==2) { + /* x && y ==> if x then y else False */ + makeCond(arg(fun(e)),arg(e),nameFalse,co,f,d); + break; + } + else if (h==nameOr && argCount==2) { + /* x || y ==> if x then True else y */ + makeCond(arg(fun(e)),nameTrue,arg(e),co,f,d); + break; + } + } + buildAp(e,co,f,TRUE); + doCont(d); + break; + + case NAME : dependsOn(e); + case UNIT : + case TUPLE : asCELL(e); + doCont(d); + break; + + /* for dict cells, ensure that CELL referred to in the code is the */ + /* dictionary cell at the head of the dictionary; not just a copy */ + /* In the interpreter, this was needed for the benefit of garbage */ + /* collection (and to avoid having multiple copies of a single */ + /* DICTCELL). In the compiler, we need it to justify the use of */ + /* cellIsMember() in dependsOn() below. */ + + case DICTCELL : asCELL(dict(dictOf(e))); + dependsOn(dict(dictOf(e))); + doCont(d); + break; + + case INTCELL : asINTEGER(intOf(e)); + doCont(d); + break; + + case FLOATCELL : asFLOAT(floatOf(e)); + doCont(d); + break; + + case STRCELL : asSTRING(textOf(e)); + doCont(d); + break; + + case CHARCELL : asCHAR(charOf(e)); + doCont(d); + break; + + case OFFSET : asLOAD(offsPosn[offsetOf(e)]); + doCont(d); + break; + + default : internal("make"); + } +} + +static Void local makeCond(i,t,e,co,f,d)/* Build code for conditional */ +Cell i,t,e; +Int co; +Label f; +Pair d; { + if (andorOptimise && i==nameOtherwise) + make(t,co,f,d); + else { + Label l1 = newLabel(); + Int savesp; + + make(i,co,f,noAction); + asEVAL(); + savesp = srsp; + asTEST(nameTrue,l1); + if (isRunon(d)) { + Label l2 = newLabel(); + + make(t,co,f,fbranch(mkInt(l2),d)); + asLABEL(l1); + if (srsp!=savesp) + asSETSTK(savesp); + make(e,co,f,frunon(d)); + asLABEL(l2); + } + else { + Cell d1 = flush(d); + make(t,co,f,d1); + asLABEL(l1); + if (srsp!=savesp) + asSETSTK(savesp); + make(e,co,f,d1); + } + } +} + +static Void local makeCase(c,co,f,d) /* construct code to implement case*/ +Cell c; /* makes the assumption that FLUSH */ +Int co; /* will never be required */ +Label f; +Pair d; { + List cs = snd(c); + Cell d1 = d; + Label l0; + + make(fst(c),co,shouldntFail,noAction); + asEVAL(); + + if (isRunon(d)) { + l0 = newLabel(); + d1 = pair(mkInt(0),ap(BRANCH,mkInt(l0))); + } + + for(; nonNull(tl(cs)); cs=tl(cs)) { + Label l = newLabel(); + Int savesp = srsp; + testCase(hd(cs),co,f,l,d1); + asLABEL(l); + asSTKIS(savesp); + } + + if (isRunon(d)) { + Int savesp = srsp; + testCase(hd(cs),co,f,f,noAction); + asLABEL(l0); + asSTKIS(savesp); + } + else + testCase(hd(cs),co,f,f,d1); +} + +static Void local testCase(c,co,f,cf,d) /* Produce code for guard */ +Pair c; +Int co; /* labels determine where to go if:*/ +Label f; /* match succeeds, but rest fails */ +Label cf; /* this match fails */ +Pair d; { + Int n = discrArity(fst(c)); + Int i; + switch (whatIs(fst(c))) { + case INTCELL : asINTEQ(intOf(fst(c)),cf); + break; +#if NPLUSK + case ADDPAT : asINTGE(intValOf(fst(c)),cf); + break; + case MULPAT : asINTDV(intValOf(fst(c)),cf); + break; +#endif + default : asTEST(fst(c),cf); + break; + } + for (i=1; i<=n; i++) + offsPosn[co+i] = ++srsp; + make(snd(c),co+n,f,d); +} + +static Void local makeGded(gs,co,f,d) /* construct code to implement gded*/ +List gs; /* equations. Makes the assumption*/ +Int co; /* that FLUSH will never be reqd. */ +Label f; +Pair d; { + Cell d1 = d; + Label l0; + + if (isRunon(d)) { + l0 = newLabel(); + d1 = pair(mkInt(0),ap(BRANCH,mkInt(l0))); + } + + for(; nonNull(tl(gs)); gs=tl(gs)) { + Label l = newLabel(); + Int savesp = srsp; + if (testGuard(hd(gs),co,f,l,d1)) + return; + asLABEL(l); + asSTKIS(savesp); + } + + if (isRunon(d)) { + Int savesp = srsp; + testGuard(hd(gs),co,f,f,noAction); + asLABEL(l0); + asSTKIS(savesp); + } + else + testGuard(hd(gs),co,f,f,d1); +} + +static Bool local testGuard(g,co,f,cf,d) /* Produce code for guard */ +Pair g; /* return TRUE if otherwise found */ +Int co; +Label f; +Label cf; +Pair d; { + if (andorOptimise && fst(g)==nameOtherwise) { + make(snd(g),co,f,d); + return TRUE; + } + else { + make(fst(g),co,shouldntFail,noAction); + asEVAL(); + asTEST(nameTrue,cf); + make(snd(g),co,f,d); + return FALSE; + } +} + +/* -------------------------------------------------------------------------- + * Compile expression to code which will build expression without any + * evaluation. + * ------------------------------------------------------------------------*/ + +static List scDeps; /* records immediate dependent */ + /* names and dictionaries */ + +static Void local dependsOn(n) /* update scDeps with new name */ +Cell n; { + + if (isName(n)) /* ignore: */ + if (name(n).defn == CFUN || /* - constructor functions */ + name(n).defn == MFUN) /* - member fns (shouldn't occur) */ + return; + + if (!cellIsMember(n,scDeps)) /* add to list of dependents */ + scDeps = cons(n,scDeps); +} + +static Void local build(e,co) /* Generate code which will build */ +Cell e; /* instance of given expression but*/ +Int co; { /* perform no evaluation */ + Int n; + + switch (whatIs(e)) { + + case LETREC : n = buildLoc(fst(snd(e)),co); + build(snd(snd(e)),co+n); + asSLIDE(n); + break; + + case FATBAR : build(snd(snd(e)),co); + build(fst(snd(e)),co); + asCELL(nameFatbar); + asMKAP(2); + break; + + case COND : build(thd3(snd(e)),co); + build(snd3(snd(e)),co); + build(fst3(snd(e)),co); + asCELL(nameIf); + asMKAP(3); + break; + + case GUARDED : buildGuards(snd(e),co); + break; + + case AP : buildAp(e,co,shouldntFail,FALSE); + break; + + case NAME : dependsOn(e); + case UNIT : + case TUPLE : asCELL(e); + break; + + case DICTCELL : asCELL(dict(dictOf(e))); /* see comments for*/ + dependsOn(dict(dictOf(e))); /* DICTCELL in make*/ + break; /* function above */ + + case INTCELL : asINTEGER(intOf(e)); + break; + + case FLOATCELL : asFLOAT(floatOf(e)); + break; + + case STRCELL : asSTRING(textOf(e)); + break; + + case CHARCELL : asCHAR(charOf(e)); + break; + + case OFFSET : asLOAD(offsPosn[offsetOf(e)]); + break; + + default : internal("build"); + } +} + +static Void local buildGuards(gs,co) /* Generate code to compile list */ +List gs; /* of guards to a conditional expr */ +Int co; { /* without evaluation */ + if (isNull(gs)) { + asCELL(nameFail); + } + else { + buildGuards(tl(gs),co); + build(snd(hd(gs)),co); + build(fst(hd(gs)),co); + asCELL(nameIf); + asMKAP(3); + } +} + +static Int local buildLoc(vs,co) /* Generate code to build local var*/ +List vs; /* bindings on stack, with no eval*/ +Int co; { + Int n = length(vs); + Int i; + + for (i=1; i<=n; i++) + offsPosn[co+i] = srsp+i; + asALLOC(n); + for (i=1; i<=n; i++) { + build(hd(vs),co+n); + asUPDATE(offsPosn[co+i]); + vs = tl(vs); + } + return n; +} + +/* -------------------------------------------------------------------------- + * We frequently encounter functions which call themselves recursively with + * a number of initial arguments preserved: + * e.g. (map f) [] = [] + * (map f) (x:xs) = f x : (map f) xs + * Lambda lifting, in particular, is likely to introduce such functions. + * Rather than reconstructing a new instance of the recursive function and + * it's arguments, we can extract the relevant portion of the root of the + * current redex. + * + * The following functions implement this optimisation. + * ------------------------------------------------------------------------*/ + +static Int nonRoots; /* #args which can't get from root */ +static Int rootPortion; /* portion of root used ... */ +static Name definingName; /* name of func being defined,if any*/ +static Int definingArity; /* arity of definingName */ + +static Void local analyseAp(e) /* Determine if any portion of an */ +Cell e; { /* application can be built using a */ + if (isAp(e)) { /* portion of the root */ + analyseAp(fun(e)); + if (nonRoots==0 && rootPortion>1 + && isOffset(arg(e)) + && offsetOf(arg(e))==rootPortion-1) + rootPortion--; + else + nonRoots++; + } + else if (e==definingName) + rootPortion = definingArity+1; + else + rootPortion = 0; +} + +static Void local buildAp(e,co,f,str) /* Build application, making use of*/ +Cell e; /* root optimisation if poss. */ +Int co; +Label f; +Bool str; { + Int nr, rp, i; + + nonRoots = 0; + analyseAp(e); + nr = nonRoots; + rp = rootPortion; + + for (i=0; i0) { + asDICT(selectOf(e)); + } + } + else { + if (isName(e) && name(e).defn==MFUN) { + asDICT(name(e).number); + nr--; /* AP node for member function need never be built */ + } + else { + if (00) { + asMKAP(nr); + } + } +} + +/* -------------------------------------------------------------------------- + * Code generator entry point: + * ------------------------------------------------------------------------*/ + +Addr codeGen(n,arity,e) /* Generate code for expression e, */ +Name n; /* treating return value of CAFs */ +Int arity; /* differently to functs with args */ +Cell e; { + extern Void pScDef Args((Text,Int,Cell)); + extern Bool dumpScs; + + definingName = n; + definingArity = arity; + scDeps = NIL; +#ifdef DEBUG_CODE +printf("------------------\n"); +if (nonNull(n)) printf("name=%s\n",textToStr(name(n).text)); +printf("Arity = %d\n",arity); +printf("codeGen = "); printExp(stdout,e); putchar('\n'); +#endif + if (dumpScs) + pScDef(name(n).text,arity,e); + else { + Int i; + asSTART(); + for (i=1; i<=arity; i++) + offsPosn[i] = ++srsp; + make(e,arity,FAIL,functionReturn); + asEND(); + } + name(n).defn = scDeps; + scDeps = NIL; +#ifdef DEBUG_CODE +dissassemble(startInstr); +printf("------------------\n"); +#endif + return startInstr; +} + +Void externalPrim(n,s) /* add name n as an external primitive */ +Name n; +String s; { + asSTART(); + asEXTERN(findText(s)); + name(n).arity = externArity(name(n).type); + name(n).code = startInstr; + name(n).primDef = 0; +} + +/* -------------------------------------------------------------------------- + * C code generator: produces (portable, I hope) C output to implement a + * specified main program. + * ------------------------------------------------------------------------*/ + +Void outputCode(fp,mn,topLevel) /* print complete C program to */ +FILE *fp; /* implement program with main mn */ +Name mn; /* using specified top level */ +String topLevel; { + List scs = identifyDeps(mn); /* determine which supercombinator */ + Target t = length(scs); /* definitions are needed in prog. */ + Target i = 0; + + fprintf(fp,"#include %s\n\nint argcheck=ARGCHECK;\n\n",GOFC_INCLUDE); + fprintf(fp,"TopLevel topLevel = %s;\n\n",topLevel); + outputCDecls(fp,scs); + outputCDicts(fp); + + setGoal("Compiling to C",t); + for (; nonNull(scs); scs=tl(scs)) { + outputCSc(fp,hd(scs)); + soFar(i++); + } + done(); +} + +static int *dictUse = 0; /* records dictionaries required */ +static int num_dicts = 0; /* dictionaries required */ +static int num_sdicts = 0; /* all dictionaries known to system*/ + +static List local identifyDeps(mn) /* list all dependents scs for mn */ +Name mn; { + List needed = singleton(mn); /* Start with dependents of mn */ + List scs = NIL; + List ns = NIL; + Int i; + + num_sdicts = newDict(0); + dictUse = (int *)calloc(num_sdicts,sizeof(int)); + if (!dictUse) { + ERROR(0) "Cannot allocate dictionary use table" + EEND; + } + for (i=0; i not required */ + + while (nonNull(needed)) { /* Cycle through to find all */ + Cell t = needed; /* dependents ... */ + Cell n = hd(t); + needed = tl(needed); + if (isName(n)) { /* Dependent is a name */ + if (!name(n).primDef && name(n).defn!=NEEDED) { + tl(t) = scs; + scs = t; + map1Proc(checkPrimDep,n,name(n).defn); + needed = appendOnto(name(n).defn,needed); + name(n).defn = NEEDED; + } + } + else { /* Dependent is a dictionary */ + if (dictUse[dictOf(n)]<0) + for (i=dictOf(n); (dictUse[i++]=0), i=0) { + if (isAp(dict(dn))) { + if (fst(dict(dn))==nameUndefMem) + tableItem(fp,"0"); + else { + sprintf(buffer,"mkDict(%d)", + dictUse[dictOf(arg(dict(dn)))]); + tableItem(fp,buffer); + } + } + else { + sprintf(buffer,"mkDict(%d)",dictUse[dictOf(dict(dn))]); + tableItem(fp,buffer); + } + } + } + finishTable(fp); + fprintf(fp,"};\nint dictImps[] = {\n"); + startTable(" ", ",", "\n"); + for (dn=0; dn=0) + if (isAp(dict(dn))) { + sprintf(buffer,"%d",name(fun(dict(dn))).number); + tableItem(fp,buffer); + } + else + tableItem(fp,"-1"); + finishTable(fp); + fprintf(fp,"};\n\n"); + } +} + +/* -------------------------------------------------------------------------- + * Supercombinator C code generator: + * + * The C code generator re-interprets the sequence of machine instructions + * produced by the G-code code generator given above, using a simulated + * stack, in much the same way as described in Simon Peyton Jones's book, + * section 19.3.2. To be quite honest, I don't think I really understood + * that section of the book until I started to work on this piece of code! + * ------------------------------------------------------------------------*/ + +static int rsp; /* Runtime stack pointer */ +static int rspMax; /* Maximum value of stack pointer */ +static int pushes; /* number of actual pushes in code */ + +#define rPush if (++rsp>=rspMax) {rspMax=rsp;} push(mkOffset(rsp)) + +static Void local rspRecalc() { /* Recalculate rsp after change to */ + Int i = sp; /* simulated stack pointer sp */ + for (rsp=(-1); i>=0; --i) + if (isOffset(stack(i))) + rsp++; + if (rsp>rspMax) /* should never happen! */ + rspMax = rsp; +} + +/* -------------------------------------------------------------------------- + * Output code for a single supercombinator: + * ------------------------------------------------------------------------*/ + +#define ppushed(n) (isOffset(pushed(n)) ? POP : pushed(n)) +#define tpushed(n) (isOffset(pushed(n)) ? TOP : pushed(n)) + +static Void local outputCSc(fp,n) /* Print C code for supercombinator*/ +FILE *fp; +Name n; { + String s = 0; + + if (name(n).arity<10) /* Print header */ + fprintf(fp,"comb%d(%s)",name(n).arity,scNameOf(n)); + else + fprintf(fp,"comb(%s,%d)",scNameOf(n),name(n).arity); + + fprintf(fp," /* "); /* include supercombinator name */ + for (s=textToStr(name(n).text); *s; s++) { + fputc(*s,fp); + if (*s=='*' && *(s+1)=='/') /* avoid premature comment ending */ + fputc(' ',fp); + } + fprintf(fp," */\n"); + + if (instrAt(name(n).code)==iEXTERN) /* link to an external function */ + externBody(fp,textToStr(textAt(name(n).code+1)),name(n).type); + else { /* regular supercombinator */ + List instrs = heapUse(cCode(name(n).arity,name(n).code)); + + if (pushes>0 && rspMax>name(n).arity) + fprintf(fp," needStack(%d);\n",rspMax-name(n).arity); + + for (; nonNull(instrs); instrs=tl(instrs)) { + Cell instr = hd(instrs); + + if (whatIs(instr)==C_LABEL){/* Handle printing of labels */ + instrs = tl(instrs); /* move on to next instruction */ + if (isNull(instrs)) + internal("no instr for label"); + outputLabel(fp,intOf(snd(instr))); + fputc(':',fp); + instr = hd(instrs); + } + else + fprintf(fp," "); + + outputCinst(fp,instr); + fprintf(fp,";\n"); + } + } + fprintf(fp,"End\n\n"); +} + +static List local cCode(arity,pc) /* simulate execution of G-code to */ +Int arity; /* calculate corresponding C code */ +Addr pc; { + Cell instrs = NIL; /* holds sequence of C instrs */ + Int i; + Cell t; + + clearStack(); /* initialise simulated stack */ + for (i=0; i<=arity; i++) { + push(mkOffset(i)); + } + rsp = arity; /* and set Real stack ptr to match */ + rspMax = rsp; + pushes = 0; + +#define outC0(c) instrs = cons(c,instrs) +#define outC1(c,o) instrs = cons(ap(c,o),instrs) +#define outC2(c,o,p) instrs = cons(ap(c,pair(o,p)),instrs) +#define outC3(c,o,p,q) instrs = cons(ap(c,triple(o,p,q)),instrs) + + for (;;) + switch (instrAt(pc)) { + + case iEND : return rev(instrs); /* end of code */ + + case iLABEL : outC1(C_LABEL, /* program label */ + mkInt(labAt(pc+1))); + pc+=2; + continue; + + case iLOAD : push(ap(COPY,stack(intAt(pc+1)))); + pc+=2; /* load from stack*/ + continue; + + case iCELL : push(cellAt(pc+1)); /* load const Cell*/ + pc+=2; + continue; + + case iCHAR : push(mkChar(intAt(pc+1))); /* load char const*/ + pc+=2; + continue; + + /* the treatment of integers used here relies on the assumption*/ + /* that any number represented by a small int in the compiler */ + /* can also be represented by a small int in the runtime system*/ + + case iINT : t = mkInt(intAt(pc+1)); /* load int const */ + if (!isSmall(t)) { /* assume BIG int */ + rPush; + pushes++; + outC0(t); + } + else { /* assume SMALL */ + push(t); + } + pc+=2; + continue; + + case iFLOAT : rPush; /* load float cnst*/ + pushes++; +#if BREAK_FLOATS + outC0(mkFloat(floatFromParts + (cellAt(pc+1),cellAt(pc+2)))); + pc+=3; +#else + outC0(mkFloat(floatAt(pc+1))); + pc+=2; +#endif + continue; + + case iFLUSH : if (!isOffset(top())) { /* force top of */ + outC1(C_FLUSH,pop()); /* simulated stack*/ + rPush; /* onto real stack*/ + pushes++; + } + pc++; + continue; + + case iSTRING : rPush; /* load str const */ + pushes++; + outC0(mkStr(textAt(pc+1))); + pc+=2; + continue; + + case iMKAP : for (i=intAt(pc+1); i>0; --i){/* make AP nodes */ + if (isOffset(pushed(0))) + if (isOffset(pushed(1))) { + outC0(C_MKAP); + rsp-=2; + } + else { + outC1(C_TOPARG,pushed(1)); + rsp--; + } + else + if (isOffset(pushed(1))) { + outC1(C_TOPFUN,pushed(0)); + rsp--; + } + else { + pushes++; + outC2(C_PUSHPAIR,pushed(0),pushed(1)); + } + drop(); + drop(); + rPush; + } + pc+=2; + continue; + + case iUPDATE : t = stack(intAt(pc+1)); /* update cell ...*/ + if (!isOffset(t)) + internal("iUPDATE"); + if (isOffset(pushed(0))) /* update cell ...*/ + rsp--; + + outC2(C_UPDATE,t,ppushed(0)); + + drop(); + pc+=2; + continue; + + case iUPDAP : t = stack(intAt(pc+1)); /* update AP node */ + if (!isOffset(t)) + internal("iUPDAP"); + if (isOffset(pushed(0))) + if (isOffset(pushed(1))) { + outC1(C_UPDAP2,t); + rsp-=2; + } + else { + outC3(C_UPDAP,t,POP,pushed(1)); + rsp--; + } + else + if (isOffset(pushed(1))) { + outC3(C_UPDAP,t,pushed(0),POP); + rsp--; + } + else + outC3(C_UPDAP,t,pushed(0),pushed(1)); + + drop(); + drop(); + pc+=2; + continue; + + case iALLOC : for (i=intAt(pc+1); i>0; --i){/* alloc loc vars */ + outC0(C_ALLOC); + rPush; + pushes++; + } + pc+=2; + continue; + + case iSLIDE : i = intAt(pc+1); /* remove loc vars*/ + if (!isOffset(top())) + i--; + outC2(C_SLIDE,mkInt(i),tpushed(0)); + rsp -= i; + sp -= intAt(pc+1); + pc += 2; + continue; + + case iDICT : if (isNull(top())) /* dict lookup */ + internal("iDICT"); + + if (whatIs(top())==DICTCELL) + top() = mkDict(dictOf(top())+intAt(pc+1)); + else + top() = ap(mkSelect(intAt(pc+1)),top()); + + pc+=2; /* dict lookup */ + continue; + + case iROOT : t = mkOffset(0); /* partial root */ + for (i=intAt(pc+1); i>0; --i) + t = ap(ROOTFST,t); + push(t); + pc+=2; + continue; + + case iRETURN : outC0(C_RETURN); /* terminate */ + pc++; + continue; + + case iGOTO : outC1(C_GOTO, /* goto label */ + mkInt(labAt(pc+1))); + pc+=2; + continue; + + case iSETSTK : sp = intAt(pc+1); /* set stack ptr */ + rspRecalc(); + outC1(C_SETSTK,mkInt(rsp)); + pc += 2; + continue; + + case iSTKIS : sp = intAt(pc+1); /* set stack ptr */ + rspRecalc(); /* but no C code */ + pc += 2; + continue; + + case iINTEQ : /* test integer ==*/ + outC2(C_INTEQ,mkInt(intAt(pc+1)), + mkInt(labAt(pc+2))); + pc+=3; + continue; + +#if NPLUSK + case iINTGE : rPush; /* test integer >=*/ + pushes++; + outC3(C_INTGE,mkInt(0), + mkInt(intAt(pc+1)), + mkInt(labAt(pc+2))); + pc+=3; + continue; + + case iINTDV : rPush; /* test for mult */ + pushes++; + outC3(C_INTDV,mkInt(0), + mkInt(intAt(pc+1)), + mkInt(labAt(pc+2))); + pc+=3; + continue; +#endif + + case iTEST : t = cellAt(pc+1); /* test for cell */ + switch (whatIs(t)) { + case UNIT : i = 0; + break; + + case TUPLE : i = tupleOf(t); + break; + + case NAME : i = name(t).arity; + outC2(C_TEST,t, + mkInt(labAt(pc+2))); + break; + + case CHARCELL : i = 0; + outC2(C_TEST,t, + mkInt(labAt(pc+2))); + break; + + default : internal("iTEST"); + } + + while (i-- > 0) { + rPush; + } + pc+=3; + continue; + + case iEVAL : if (isOffset(pushed(0))) /* evaluate top() */ + rsp--; + outC1(C_EVAL,ppushed(0)); + drop(); + pc++; + continue; + + default : internal("illegal instruction"); + break; + } + +#undef outC0 +#undef outC1 +#undef outC2 +#undef outC3 +} + +/* -------------------------------------------------------------------------- + * Insert heap use annotations: + * ------------------------------------------------------------------------*/ + +static Int heapNeeded; /* used to return # heap cells reqd*/ + +static List local heapUse(instrs) /* add annotations for heap use */ +List instrs; { + instrs = heapAnalyse(instrs); + if (heapNeeded>0) + instrs = cons(ap(C_HEAP,mkInt(heapNeeded)),instrs); + return instrs; +} + +static List local heapAnalyse(instrs) /* analyse heap use in instruction */ +List instrs; { + Int heap = 0; /* number of heap cells needed */ + List next; + + for (next=instrs; nonNull(next); next=tl(next)) + switch (whatIs(hd(next))) { + case FLOATCELL : heap+=4; /*conservative overestimate*/ + continue; /*without BREAK_FLOATS this*/ + /*will always use just one */ + /*cell, with it may use 1-4*/ + + case INTCELL : /*conservative overestimate*/ + /*again. Small ints may not*/ + /*require any heap storage */ + case STRCELL : + case C_MKAP : + case C_TOPFUN : + case C_TOPARG : + case C_PUSHPAIR : + case C_ALLOC : heap++; + case C_UPDAP : + case C_UPDAP2 : + case C_UPDATE : + case C_SLIDE : + case C_SETSTK : + case C_FLUSH : continue; + +#if NPLUSK + case C_INTGE : + case C_INTDV : tl(next) = heapAnalyse(tl(next)); + fst3(snd(hd(next))) = mkInt(1+heapNeeded); + heapNeeded = heap; + return instrs; +#endif + + case C_TEST : + case C_INTEQ : + case C_LABEL : + case C_GOTO : + case C_RETURN : + case C_EVAL : tl(next) = heapUse(tl(next)); + heapNeeded = heap; + return instrs; + + default : internal("heapAnalyse"); + } + + heapNeeded = heap; + return instrs; +} + +/* -------------------------------------------------------------------------- + * Output individual C code instructions: + * ------------------------------------------------------------------------*/ + +static Void local outputCinst(fp,instr) /* Output single C instruction */ +FILE *fp; +Cell instr; { + switch (whatIs(instr)) { + case INTCELL : fprintf(fp,"pushInt(%d)",intOf(instr)); + break; + + case FLOATCELL : fprintf(fp,"pushFloat(%s)", + floatToString(floatOf(instr))); + break; + + case STRCELL : fprintf(fp,"pushStr("); + outputCStr(fp,textToStr(textOf(instr))); + fputc(')',fp); + break; + + case C_MKAP : fprintf(fp,"mkap()"); + break; + + case C_TOPARG : fprintf(fp,"toparg("); + expr(fp,snd(instr)); + fputc(')',fp); + break; + + case C_TOPFUN : fprintf(fp,"topfun("); + expr(fp,snd(instr)); + fputc(')',fp); + break; + + case C_PUSHPAIR : fprintf(fp,"pushpair("); + expr(fp,fst(snd(instr))); + fputc(',',fp); + expr(fp,snd(snd(instr))); + fputc(')',fp); + break; + + case C_UPDATE : fprintf(fp,"update(%d,",offsetOf(fst(snd(instr)))); + expr(fp,snd(snd(instr))); + fputc(')',fp); + break; + + case C_UPDAP : fprintf(fp,"updap(%d,",offsetOf(fst3(snd(instr)))); + expr(fp,snd3(snd(instr))); + fputc(',',fp); + expr(fp,thd3(snd(instr))); + fputc(')',fp); + break; + + case C_UPDAP2 : fprintf(fp,"updap2(%d)",offsetOf(snd(instr))); + break; + + case C_ALLOC : fprintf(fp,"alloc()"); + break; + + case C_SLIDE : fprintf(fp,"slide(%d,",intOf(fst(snd(instr)))); + expr(fp,snd(snd(instr))); + fputc(')',fp); + break; + + case C_RETURN : fprintf(fp,"ret()"); + break; + + case C_GOTO : outputJump(fp,intOf(snd(instr))); + break; + + case C_FLUSH : fprintf(fp,"onto("); + expr(fp,snd(instr)); + fputc(')',fp); + break; + + case C_SETSTK : fprintf(fp,"setstk(%d)",intOf(snd(instr))); + break; + + case C_HEAP : fprintf(fp,"heap(%d)",intOf(snd(instr))); + break; + + case C_INTEQ : fprintf(fp,"inteq(%d) ",intOf(fst(snd(instr)))); + outputJump(fp,intOf(snd(snd(instr)))); + break; + +#if NPLUSK + case C_INTGE : fprintf(fp,"intge(%d,%d) ",intOf(fst3(snd(instr))), + intOf(snd3(snd(instr)))); + outputJump(fp,intOf(thd3(snd(instr)))); + break; + + case C_INTDV : fprintf(fp,"intdv(%d,%d) ",intOf(fst3(snd(instr))), + intOf(snd3(snd(instr)))); + outputJump(fp,intOf(thd3(snd(instr)))); + break; +#endif + + case C_TEST : fprintf(fp,"test("); + expr(fp,fst(snd(instr))); + fprintf(fp,") "); + outputJump(fp,intOf(snd(snd(instr)))); + break; + + case C_EVAL : fprintf(fp,"eval("); + expr(fp,snd(instr)); + fputc(')',fp); + break; + + default : internal("bad C code"); + } +} + +/* -------------------------------------------------------------------------- + * Output small parts of an expression: + * ------------------------------------------------------------------------*/ + +static Void local expr(fp,n) /* print C expression for value */ +FILE *fp; +Cell n; { + + switch (whatIs(n)) { + + case TOP : fprintf(fp,"top()"); + break; + + case POP : fprintf(fp,"pop()"); + break; + + case COPY : expr(fp,snd(n)); + break; + + case OFFSET : fprintf(fp,"offset(%d)",offsetOf(n)); + break; + + case CHARCELL : fprintf(fp,"mkChar(%d)",charOf(n)); + break; + + case INTCELL : fprintf(fp,"mkSmall(%d)",intOf(n)); + break; + + case AP : if (fst(n)==ROOTFST) { + fprintf(fp,"rootFst("); + expr(fp,arg(n)); + fputc(')',fp); + } + else if (isSelect(fst(n))) { + fprintf(fp,"dsel(%d,",selectOf(fst(n))); + expr(fp,arg(n)); + fputc(')',fp); + } + else + internal("exprAP"); + break; + + case DICTCELL : fprintf(fp,"dict[%d]",dictUse[dictOf(n)]); + break; + + case UNIT : fprintf(fp,"mkCfun(0)"); + break; + + case TUPLE : fprintf(fp,"mkCfun(%d)",tupleOf(n)); + break; + + case NAME : if (name(n).defn==CFUN) + fprintf(fp,"mkCfun(%d)",name(n).number); + else if (name(n).primDef) + fprintf(fp,"%s",primitives[name(n).number].ref); + else + fprintf(fp,"sc[%d]",name(n).number); + break; + + default : internal("expr"); + } +} + +static Void local outputLabel(fp,lab) /* print C program label */ +FILE *fp; +Int lab; { + if (lab<=26) + fputc('a'+lab-1, fp); + else + fprintf(fp,"a%d",lab-26); +} + +static Void local outputJump(fp,lab) /* print jump to label, taking */ +FILE *fp; /* special account of FAIL label */ +Int lab; { + if (lab==FAIL) + fprintf(fp,"fail()"); + else { + fprintf(fp,"goto "); + outputLabel(fp,lab); + } +} + +static Void local outputCStr(fp,s) /* print out string, taking care */ +FILE *fp; /* to avoid problems with C escape */ +String s; { /* sequences */ + fputc('"',fp); + for (; *s; s++) { + if (*s=='\\' || *s=='"') + fprintf(fp,"\\%c",*s); + else if (isprint(*s)) + fputc(*s,fp); + else if (*s=='\n') + fprintf(fp,"\\n"); + else + fprintf(fp,"\\%03o",(*s<0 ? *s+NUM_CHARS : *s)); + } + fputc('"',fp); +} + +static Bool local validCIdent(s) /* check whether string s is valid */ +String s; { /* C identifier */ + if (*s=='v' && isdigit(s[1])) /* avoid clashes with Gofer's own */ + return FALSE; /* generated function names ... */ + for (; *s && isascii(*s) && isalnum(*s); s++) + ; + return *s=='\0'; +} + +static String local scNameOf(n) /* get name of C implementation of */ +Name n; { /* a particular supercombinator */ + String s = textToStr(name(n).text); + static char buffer[100]; + + if (validCIdent(s) && strlen(s)<96) + sprintf(buffer,"sc_%s",s); + else + sprintf(buffer,"sc_%d",name(n).number); + + return buffer; +} + +/* -------------------------------------------------------------------------- + * Pretty printing of tables: + * ------------------------------------------------------------------------*/ + +#define TABLEWIDTH 72 +static int tableCol; +static int tableItems; +static String tableStart; +static String tableEndLine; +static String tableEndTab; + +static Void local startTable(start,endLine,endTab) +String start; +String endLine; +String endTab; { + tableStart = start; + tableEndLine = endLine; + tableEndTab = endTab; + tableCol = 0; + tableItems = 0; +} + +static Void local finishTable(fp) +FILE *fp; { + if (tableCol>0) + fprintf(fp,tableEndTab); +} + +static Void local tableItem(fp,s) +FILE *fp; +String s; { + int n = strlen(s); + + if (tableItems++ == 0) { + fprintf(fp,tableStart); + tableCol = strlen(tableStart); + } + else { + if (tableCol+n+2>TABLEWIDTH) { + fprintf(fp,"%s\n%s",tableEndLine,tableStart); + tableCol = strlen(tableStart); + } + else { + fprintf(fp,", "); + tableCol+=2; + } + } + fprintf(fp,"%s",s); + tableCol += n; +} + +/* -------------------------------------------------------------------------- + * Interfacing to external code: + * + * The following functions are used to support a simple external function + * calling mechanism. It currently supports argument values: + * NIL a Cell value, passed or returned without evaluation + * other special type, recognized, evaluated an returned + * + * When available, arrays, mutable arrays, and mutable variables are + * allowed to be passed across the interface, after they have been + * evaluated. + * + * The unit value UNIT is also used for a void return in the IO monad. + * ------------------------------------------------------------------------*/ + +static Int local externArity(ty) /* find arity of exernal function */ +Type ty; { /* with type ty */ + Int arity = 0; + if (isPolyType(ty)) + ty = monoTypeOf(ty); + if (whatIs(ty)==QUAL) { + arity = length(fst(snd(ty))); + ty = snd(snd(ty)); + } + while (isAp(ty) && isAp(fun(ty)) && fun(fun(ty))==ARROW) { + arity++; + ty = arg(ty); + } +#if IO_MONAD + if (isAp(ty) && (fun(ty)==typeIO || + (isAp(fun(ty)) && fun(fun(ty)==typeST)))) + arity++; +#endif + return arity; +} + +static Type local transExtType(ty) /* translate to external type */ +Type ty; { + if (ty==typeBool || ty==typeChar || ty==typeInt || ty==typeFloat) + return ty; + else { +#if (IO_MONAD | HASKELL_ARRAYS) + Type h = getHead(ty); +#if HASKELL_ARRAYS + if (h==typeArray && argCount==2) return h; +#if IO_MONAD + if (h==typeMutArr && argCount==3) return h; +#endif +#endif +#if IO_MONAD + if (h==typeMutVar && argCount==2) return h; +#endif +#endif + return NIL; + } +} + +static String local showExtType(ty) /* give C type for Gofer type */ +Type ty; { + if (ty==typeBool || ty==typeChar || ty==typeInt || ty==typeFloat) + return textToStr(tycon(ty).text); + else if (ty==UNIT) + return "Void"; + else + return "Cell"; +} + +static String local showExtRes(ty) /* expression to get result of */ +Type ty; { /* evaluation expr of type ty */ + if (ty==typeBool) return "(whnf==mkCfun(1))"; + if (ty==typeChar) return "charOf(whnf)"; + if (ty==typeInt) return "intOf(whnf)"; + if (ty==typeFloat) return "floatOf(whnf)"; + return "whnf"; +} + +static String local showExtRet(ty) /* expression to turn result r to */ +Type ty; { /* a value of type ty */ + if (ty==typeBool) return "mkCfun(r ? 1 : 0)"; + if (ty==typeChar) return "mkChar(r)"; + if (ty==typeInt) return "mkInt(r)"; + if (ty==typeFloat) return "mkFloat(r)"; + if (ty==UNIT) return "mkCfun(0)"; + return "r"; +} + +static Void local externBody(fp,exn,ty) /* generate body for call to extern*/ +FILE *fp; /* function */ +String exn; +Type ty; { + List argTypes = NIL; /* list of types of arguments */ + Bool ioMonad = FALSE; /* TRUE => fn called via IO monad */ + Int args = 0; + Int i; + List ts; + + /* Step 1: analyse type, to determine args required etc. */ + + if (isPolyType(ty)) + ty = monoTypeOf(ty); + if (whatIs(ty)==QUAL) + ty = snd(snd(ty)); + while (isAp(ty) && isAp(fun(ty)) && fun(fun(ty))==ARROW) { + argTypes = cons(transExtType(arg(fun(ty))),argTypes); + ty = arg(ty); + ++args; + } +#if IO_MONAD + if (isAp(ty) && (fun(ty)==typeIO || + (isAp(fun(ty)) && fun(fun(ty))==typeST))) { + ioMonad = TRUE; + ty = arg(ty); + ++args; + } + if (ty!=UNIT) + ty = transExtType(ty); +#else + ty = transExtType(ty); +#endif + argTypes = rev(argTypes); + + /* Step 2: Print definitions for external function, and temp vars */ + + fprintf(fp,"{ extern %s %s Args((",showExtType(ty),exn); + if (isNull(argTypes)) + fprintf(fp,"Void));\n"); + else { + for (ts=argTypes; nonNull(ts); ts=tl(ts)) { + fprintf(fp,showExtType(hd(ts))); + if (nonNull(tl(ts))) + fprintf(fp,","); + } + fprintf(fp,"));\n"); + for (i=args, ts=argTypes; nonNull(ts); ts=tl(ts), --i) + if (nonNull(hd(ts))) + fprintf(fp," %s o%d;\n",showExtType(hd(ts)),i); + } + if (ty!=UNIT) + fprintf(fp," %s r;\n",showExtType(ty)); + + /* Step 3: Evaluate arguments if necessary */ + + if (ioMonad) { + fprintf(fp," eval(offset(1));\n"); + i++; + } + for (i=args, ts=argTypes; nonNull(ts); ts=tl(ts), --i) + if (nonNull(hd(ts))) { + fprintf(fp," eval(offset(%d));\n",i); + fprintf(fp," o%d = %s;\n",i,showExtRes(hd(ts))); + } + + /* Step 4: Call function and return result */ + + fprintf(fp," "); + if (ty!=UNIT) + fprintf(fp,"r = "); + fprintf(fp,"%s(",exn); + for (i=args, ts=argTypes; nonNull(ts); ts=tl(ts), --i) { + if (isNull(hd(ts))) + fprintf(fp,"offset(%d)",i); + else + fprintf(fp,"o%d",i); + if (nonNull(tl(ts))) + fprintf(fp,","); + } + fprintf(fp,");\n"); + + if (ioMonad) { + fprintf(fp," heap(1);\n"); + fprintf(fp," updap(0,pair(mkCfun(2),%s),offset(1));\n", + showExtRet(ty)); + } + else + fprintf(fp," update(0,%s);\n",showExtRet(ty)); + + fprintf(fp," ret();\n}\n"); +} + +/* -------------------------------------------------------------------------- + * Machine control: + * ------------------------------------------------------------------------*/ + +Void machine(what) +Int what; { + switch (what) { + case RESET : scDeps = NIL; + break; + + case MARK : mark(scDeps); + mark(shouldntFail); + mark(functionReturn); + mark(noAction); + break; + + case INSTALL : machine(RESET); + memory = (Memory)farCalloc(NUM_ADDRS,sizeof(MemCell)); + if (memory==0) + fatal("Cannot allocate program memory"); + + shouldntFail = pair(mkInt(0),ERRCONT); + functionReturn = pair(mkInt(0),UPDRETC); + noAction = pair(mkInt(0),RUNONC); + break; + } +} + +/* ------------------------------------------------------------------------*/ diff --git a/src/command.h b/src/command.h new file mode 100644 index 0000000..d2fa68e --- /dev/null +++ b/src/command.h @@ -0,0 +1,37 @@ +/* -------------------------------------------------------------------------- + * command.h: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Interpreter command structure + * ------------------------------------------------------------------------*/ + +typedef Int Command; + +struct cmd { + String cmdString; + Command cmdCode; +}; + +extern Command readCommand Args((struct cmd *, Char, Char)); + +#define EDIT 0 +#define FIND 1 +#define LOAD 2 +#define ALSO 3 +#define PROJECT 4 +#define RELOAD 5 +#define EVAL 6 +#define TYPEOF 7 +#define HELP 8 +#define NAMES 9 +#define BADCMD 10 +#define SET 11 +#define QUIT 12 +#define SYSTEM 13 +#define CHGDIR 14 +#define INFO 15 +#define COLLECT 16 +#define NOCMD 17 + +/*-------------------------------------------------------------------------*/ diff --git a/src/commonui.c b/src/commonui.c new file mode 100644 index 0000000..a788bd8 --- /dev/null +++ b/src/commonui.c @@ -0,0 +1,383 @@ +/* -------------------------------------------------------------------------- + * commonui.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Parts of user interface common to both compiler and interpreter. + * ------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local toggleSet Args((Char,Bool)); +static Void local togglesIn Args((Bool)); +static Void local optionInfo Args((Void)); +static Void local processOption Args((String)); +static Int local argToInt Args((String *)); + +static Void local loadProject Args((String)); +static Void local clearProject Args((Void)); +static Void local addScriptName Args((String)); +static Void local addScript Args((String,Long)); +static Void local forgetScriptsFrom Args((Module)); + +static Void local setLastEdit Args((String,Int)); + +static Void local failed Args((Void)); + +static String local strCopy Args((String)); +static Int local substr Args((String,String)); + +/* -------------------------------------------------------------------------- + * Local data areas: + * ------------------------------------------------------------------------*/ + +static String scriptName[NUM_MODULES]; /* Script file names */ +static Int numScripts; /* Number of scripts loaded */ +static Int namesUpto; /* Number of script names set */ + +static String currProject = 0; /* Name of current project file */ +static Bool projectLoaded = FALSE; /* TRUE => project file loaded */ +static String scriptFile; /* Name of current script (if any) */ + +#if RISCOS +static Bool useDots = TRUE; /* TRUE => use dots in progress */ +#else +static Bool useDots = FALSE; /* TRUE => use dots in progress */ +#endif +static String lastEdit = 0; /* Name of file to edit (if any) */ +static Int lastLine = 0; /* Editor line number (if possible)*/ +static String prompt = 0; /* Prompt string (gofer only) */ +static String outputFile = 0; /* User spec. output file (gofc) */ + +/* -------------------------------------------------------------------------- + * Command line options: + * ------------------------------------------------------------------------*/ + +struct options { /* command line option toggles */ + char c; /* table defined in main app. */ + String description; + Bool *flag; +}; +extern struct options toggle[]; + +static Void local toggleSet(c,state) /* Set command line toggle */ +Char c; +Bool state; { + Int i; + for (i=0; toggle[i].c; ++i) + if (toggle[i].c == c) { + *toggle[i].flag = state; + return; + } + ERROR(0) "Unknown toggle `%c'", c + EEND; +} + +static Void local togglesIn(state) /* Print current list of toggles in*/ +Bool state; { /* given state */ + Int count = 0; + Int i; + for (i=0; toggle[i].c; ++i) + if (*toggle[i].flag == state) { + if (count==0) + putchar(state ? '+' : '-'); + putchar(toggle[i].c); + count++; + } + if (count>0) + putchar(' '); +} + +static Void local optionInfo() { /* Print information about command */ + static String fmts = "%-5s%s\n"; /* line settings */ + static String fmtc = "%-5c%s\n"; + Int i; + + printf("TOGGLES: groups begin with +/- to turn options on/off resp.\n"); + for (i=0; toggle[i].c; ++i) + printf(fmtc,toggle[i].c,toggle[i].description); + + printf("\nOTHER OPTIONS: (leading + or - makes no difference)\n"); + printf(fmts,"hnum","Set heap size (cannot be changed within Gofer)"); + printf(fmts,"pstr","Set prompt string to str"); + printf(fmts,"rstr","Set repeat last expression string to str"); +#ifdef TECH_TOGGLES + printf(fmts,"xnum","Set maximum depth for evidence search"); +#endif + + printf("\nCurrent settings: "); + togglesIn(TRUE); + togglesIn(FALSE); +#ifdef TECH_TOGGLES + printf("-h%d -p%s -x%d -r%s\n",heapSize,prompt,maxEvidLevel,repeatStr); +#else + printf("-h%d -p%s -r%s\n",heapSize,prompt,repeatStr); +#endif +} + +static Void local processOption(s) /* process option string s */ +String s; { + Bool state = (s[0]=='+' ? TRUE : FALSE); + + while (*++s) + switch (*s) { + case 'n' : if (s[1]) { + if (outputFile) free(outputFile); + outputFile = strCopy(s+1); + } + return; + + case 'p' : if (s[1]) { + if (prompt) free(prompt); + prompt = strCopy(s+1); + } + return; + + case 'r' : if (s[1]) { + if (repeatStr) free(repeatStr); + repeatStr = strCopy(s+1); + } + return; + + case 'h' : if (heapBuilt()) { + ERROR(0) "Cannot change heap size" + EEND; + } + heapSize = argToInt(&s); + if (heapSizeMAXIMUMHEAP) + heapSize = MAXIMUMHEAP; + break; + +#ifdef TECH_TOGGLES + case 'x' : maxEvidLevel = argToInt(&s); + break; +#endif + + default : toggleSet(*s,state); + break; + } +} + +static Int local argToInt(sp) /* read integer from argument str */ +String *sp; { + Int num = 0; + while (isascii((*sp)[1]) && isdigit((*sp)[1])) { + num = 10*num + (*(++*sp) - '0'); + } + return num; +} + +/* -------------------------------------------------------------------------- + * Loading project and script files: + * ------------------------------------------------------------------------*/ + +static Void local loadProject(s) /* Load project file */ +String s; { + clearProject(); + currProject = s; + projInput(currProject); + scriptFile = currProject; + forgetScriptsFrom(1); + while (s=readFilename()) + addScriptName(s); + if (namesUpto<=1) { + ERROR(0) "Empty project file" + EEND; + } + scriptFile = 0; + projectLoaded = TRUE; +} + +static Void local clearProject() { /* clear name for current project */ + if (currProject) + free(currProject); + currProject = 0; + projectLoaded = FALSE; +} + +static Void local addScriptName(s) /* add script name to list of files */ +String s; { /* to be read in ... */ + if (s[0]=='-' || s[0]=='+') + processOption(s); + else if (namesUpto>=NUM_MODULES) { + ERROR(0) "Too many script files (maximum of %d allowed)", + NUM_MODULES + EEND; + } + else + scriptName[namesUpto++] = strCopy(s); +} + +static Void local addScript(fname,len) /* read single script file */ +String fname; /* name of script file */ +Long len; { /* length of script file */ + scriptFile = fname; + + printf("Reading script file \"%s\":\n",fname); + setLastEdit(fname,0); + + parseScript(fname,len); /* process script file */ + checkDefns(); + if (numScripts==0) /* initialisation to be done once */ + everybody(PRELUDE); /* prelude Tycons and Classes known*/ + typeCheckDefns(); + compileDefns(); + + scriptFile = 0; +} + +static Void local forgetScriptsFrom(scno)/* remove scripts from system */ +Module scno; { + Module i; + for (i=scno; i0) + numScripts = scno; +} + +static Void local setLastEdit(fname,line)/* keep name of last file to edit */ +String fname; +Int line; { + if (lastEdit) + free(lastEdit); + lastEdit = strCopy(fname); + lastLine = line; +} + +/* -------------------------------------------------------------------------- + * Display progress towards goal: + * ------------------------------------------------------------------------*/ + +static Target currTarget; +static Bool aiming = FALSE; +static Int currPos; +static Int maxPos; +static Int charCount; + +Void setGoal(what, t) /* Set goal for what to be t */ +String what; +Target t; { + currTarget = (t?t:1); + aiming = TRUE; + if (useDots) { + currPos = strlen(what); + maxPos = getTerminalWidth() - 1; + printf("%s",what); + } + else + for (charCount=0; *what; charCount++) + putchar(*what++); + fflush(stdout); +} + +Void soFar(t) /* Indicate progress towards goal */ +Target t; { /* has now reached t */ + if (useDots) { + Int newPos = (Int)((maxPos * ((long)t))/currTarget); + + if (newPos>maxPos) + newPos = maxPos; + + if (newPos>currPos) { + do + putchar('.'); + while (newPos>++currPos); + fflush(stdout); + } + fflush(stdout); + } +} + +Void done() { /* Goal has now been achieved */ + if (useDots) { + while (maxPos>currPos++) + putchar('.'); + putchar('\n'); + aiming = FALSE; + } + else + for (; charCount>0; charCount--) { + putchar('\b'); + putchar(' '); + putchar('\b'); + } + fflush(stdout); +} + +static Void local failed() { /* Goal cannot be reached due to */ + if (aiming) { /* errors */ + aiming = FALSE; + putchar('\n'); + fflush(stdout); + } +} + +/* -------------------------------------------------------------------------- + * Send message to each component of system: + * ------------------------------------------------------------------------*/ + +Void everybody(what) /* send command `what' to each component of*/ +Int what; { /* system to respond as appropriate ... */ + machdep(what); /* The order of calling each component is */ + storage(what); /* important for the INSTALL command */ + input(what); + staticAnalysis(what); + typeChecker(what); + compiler(what); + machine(what); + builtIn(what); +} + +/* -------------------------------------------------------------------------- + * Read value from environment variable: + * ------------------------------------------------------------------------*/ + +String fromEnv(var,def) /* return value of: */ +String var; /* environment variable named by var */ +String def; { /* or: default value given by def */ + String s = getenv(var); + + return (s ? s : def); +} + +/* -------------------------------------------------------------------------- + * String manipulation routines: + * ------------------------------------------------------------------------*/ + +static String local strCopy(s) /* make malloced copy of a string */ +String s; { + if (s) { + char *t,*r; + if ((t=(char *)malloc(strlen(s)+1))==0) { + ERROR(0) "String storage space exhausted" + EEND; + } + for (r=t; *r++ = *s++; ) + ; + return t; + } + return s; +} + +static Int local substr(s1,s2) /* find posn of substring s1 in s2 */ +String s1, s2; { /* (naive implementation) */ + String t; + + for (t=s2; *t; t++) { + Int i = 0; + while (s1[i] && s1[i]==t[i]) + i++; + if (s1[i]=='\0') + return t-s2; + } + return (-1); +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/compiler.c b/src/compiler.c new file mode 100644 index 0000000..084a15e --- /dev/null +++ b/src/compiler.c @@ -0,0 +1,1514 @@ +/* -------------------------------------------------------------------------- + * compiler.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * This is the Gofer compiler, handling translation of typechecked code to + * `kernel' language, elimination of pattern matching and translation to + * super combinators (lambda lifting). + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "connect.h" + +Bool useConformality = TRUE; /* TRUE => check pat-bind conform'y*/ +Addr inputCode; /* Addr of compiled code for expr */ + +Name nameResult, nameBind; /* for translating monad comps */ +Name nameZero; /* for monads with a zero */ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Cell local translate Args((Cell)); +static Void local transPair Args((Pair)); +static Void local transTriple Args((Triple)); +static Void local transAlt Args((Cell)); +static Void local transCase Args((Cell)); +static List local transBinds Args((List)); +static Cell local transRhs Args((Cell)); +static Cell local mkConsList Args((List)); +static Cell local expandLetrec Args((Cell)); + +static Cell local transComp Args((Cell,List,Cell)); +static Cell local transMComp Args((Cell,Cell,Cell,List)); + +static Cell local refutePat Args((Cell)); +static List local remPat Args((Cell,Cell,List)); +static List local remPat1 Args((Cell,Cell,List)); + +static Cell local pmcTerm Args((Int,List,Cell)); +static Cell local pmcPair Args((Int,List,Pair)); +static Cell local pmcTriple Args((Int,List,Triple)); +static Cell local pmcVar Args((List,Text)); +static Void local pmcLetrec Args((Int,List,Pair)); +static Cell local pmcVarDef Args((Int,List,List)); +static Void local pmcFunDef Args((Int,List,Triple)); + +static Cell local match Args((Int,List,List)); +static Void local tidyHdPat Args((Offset,Cell)); +static Cell local hdDiscr Args((List)); +static Int local discrKind Args((Cell)); + +static Cell local matchVar Args((Int,List,List,Cell)); + +static Cell local matchCon Args((Int,List,List,Cell)); +static List local addConTable Args((Cell,Cell,List)); +static Cell local makeCases Args((Int,List,List)); + +static Cell local matchInt Args((Int,List,List,Cell)); + +static List local addOffsets Args((Int,Int,List)); +static Cell local mkSwitch Args((List,Pair)); +static Cell local joinSw Args((Int,List)); +static Bool local canFail Args((Cell)); + +static Cell local lift Args((Int,List,Cell)); +static Void local liftPair Args((Int,List,Pair)); +static Void local liftTriple Args((Int,List,Triple)); +static Void local liftAlt Args((Int,List,Cell)); +static Cell local liftVar Args((List,Cell)); +static Cell local liftLetrec Args((Int,List,Cell)); +static Void local liftFundef Args((Int,List,Triple)); +static Void local solve Args((List)); + +static Cell local preComp Args((Cell)); +static Cell local preCompPair Args((Pair)); +static Cell local preCompTriple Args((Triple)); +static Void local preCompCase Args((Pair)); +static Cell local preCompOffset Args((Int)); + +static Void local compileGlobalFunction Args((Pair)); +static Void local compileMemberFunction Args((Name)); +static Void local newGlobalFunction Args((Name,Int,List,Int,Cell)); + +/* -------------------------------------------------------------------------- + * Transformation: Convert input expressions into a less complex language + * of terms using only LETREC, AP, constants and vars. + * Also remove pattern definitions on lhs of eqns. + * ------------------------------------------------------------------------*/ + +static Cell local translate(e) /* Translate expression: */ +Cell e; { + switch (whatIs(e)) { + case LETREC : snd(snd(e)) = translate(snd(snd(e))); + return expandLetrec(e); + + case COND : transTriple(snd(e)); + break; + + case AP : transPair(e); + break; + + case UNIT : + case TUPLE : + case NAME : + case SELECT : + case VAROPCELL : + case VARIDCELL : + case DICTVAR : + case DICTCELL : + case INTCELL : + case FLOATCELL : + case STRCELL : + case CHARCELL : break; + + case FINLIST : mapOver(translate,snd(e)); + return mkConsList(snd(e)); + + case LISTCOMP : return transComp(translate(fst(snd(e))), + snd(snd(e)), + nameNil); + + case MONADCOMP : if (dictOf(fst(fst(snd(e)))) == listMonadDict()) + return transComp(translate(fst(snd(snd(e)))), + snd(snd(snd(e))), + nameNil); + /*intentional fall-thru*/ + case DOCOMP : { Cell m = fst(fst(snd(e))); + Cell m0 = snd(fst(snd(e))); + Cell r = translate(fst(snd(snd(e)))); + if (fst(e)!=DOCOMP) + r = ap(ap(nameResult,m),r); + return transMComp(m,m0,r,snd(snd(snd(e)))); + } + +#if IO_MONAD + case RUNST : fst(e) = nameSTRun; + snd(e) = translate(snd(e)); + break; +#endif + + case CASE : { Cell nv = inventVar(); + mapProc(transCase,snd(snd(e))); + return ap(LETREC, + pair(singleton(pair(nv,snd(snd(e)))), + ap(nv,translate(fst(snd(e)))))); + } + + case LAMBDA : { Cell nv = inventVar(); + transAlt(snd(e)); + return ap(LETREC, + pair(singleton(pair( + nv, + singleton(snd(e)))), + nv)); + } + + default : internal("translate"); + } + return e; +} + +static Void local transPair(pr) /* Translate each component in a */ +Pair pr; { /* pair of expressions. */ + fst(pr) = translate(fst(pr)); + snd(pr) = translate(snd(pr)); +} + +static Void local transTriple(tr) /* Translate each component in a */ +Triple tr; { /* triple of expressions. */ + fst3(tr) = translate(fst3(tr)); + snd3(tr) = translate(snd3(tr)); + thd3(tr) = translate(thd3(tr)); +} + +static Void local transAlt(e) /* Translate alt: */ +Cell e; { /* ([Pat], Rhs) ==> ([Pat], Rhs') */ + snd(e) = transRhs(snd(e)); +} + +static Void local transCase(c) /* Translate case: */ +Cell c; { /* (Pat, Rhs) ==> ([Pat], Rhs') */ + fst(c) = singleton(fst(c)); + snd(c) = transRhs(snd(c)); +} + +static List local transBinds(bs) /* Translate list of bindings: */ +List bs; { /* eliminating pattern matching on */ + List newBinds; /* lhs of bindings. */ + + for (newBinds=NIL; nonNull(bs); bs=tl(bs)) { + if (isVar(fst(hd(bs)))) { + mapProc(transAlt,snd(hd(bs))); + newBinds = cons(hd(bs),newBinds); + } + else + newBinds = remPat(fst(snd(hd(bs))), + snd(snd(hd(bs)))=transRhs(snd(snd(hd(bs)))), + newBinds); + } + + return newBinds; +} + +static Cell local transRhs(rhs) /* Translate rhs: removing line nos */ +Cell rhs; { + switch (whatIs(rhs)) { + case LETREC : snd(snd(rhs)) = transRhs(snd(snd(rhs))); + return expandLetrec(rhs); + + case GUARDED : mapOver(snd,snd(rhs)); /* discard line number */ + mapProc(transPair,snd(rhs)); + return rhs; + + default : return translate(snd(rhs)); /* discard line number */ + } +} + +static Cell local mkConsList(es) /* Construct expression for list es */ +List es; { /* using nameNil and nameCons */ + if (isNull(es)) + return nameNil; + else + return ap(ap(nameCons,hd(es)),mkConsList(tl(es))); +} + +static Cell local expandLetrec(root) /* translate LETREC with list of */ +Cell root; { /* groups of bindings (from depend. */ + Cell e = snd(snd(root)); /* analysis) to use nested LETRECs */ + List bss = fst(snd(root)); + Cell temp; + + if (isNull(bss)) /* should never happen, but just in */ + return e; /* case: LETREC [] IN e ==> e */ + + mapOver(transBinds,bss); /* translate each group of bindings */ + + for (temp=root; nonNull(tl(bss)); bss=tl(bss)) { + fst(snd(temp)) = hd(bss); + snd(snd(temp)) = ap(LETREC,pair(NIL,e)); + temp = snd(snd(temp)); + } + fst(snd(temp)) = hd(bss); + + return root; +} + +/* -------------------------------------------------------------------------- + * Transformation of list comprehensions is based on the description in + * `The Implementation of Functional Programming Languages': + * + * [ e | qs ] ++ L => transComp e qs [] + * transComp e [] l => e : l + * transComp e ((p<-xs):qs) l => LETREC _h [] = l + * _h (p:_xs) = transComp e qs (_h _xs) + * _h (_:_xs) = _h _xs --if p refutable. + * IN _h xs + * transComp e (b:qs) l => if b then transComp e qs l else l + * transComp e (decls:qs) l => LETREC decls IN transComp e qs l + * ------------------------------------------------------------------------*/ + +static Cell local transComp(e,qs,l) /* Translate [e | qs] ++ l */ +Cell e; +List qs; +Cell l; { + if (nonNull(qs)) { + Cell q = hd(qs); + Cell qs1 = tl(qs); + + switch (fst(q)) { + case FROMQUAL : { Cell ld = NIL; + Cell hVar = inventVar(); + Cell xsVar = inventVar(); + + if (refutable(fst(snd(q)))) + ld = cons(pair(singleton( + ap(ap(nameCons, + WILDCARD), + xsVar)), + ap(hVar,xsVar)), + ld); + + ld = cons(pair(singleton( + ap(ap(nameCons, + fst(snd(q))), + xsVar)), + transComp(e, + qs1, + ap(hVar,xsVar))), + ld); + ld = cons(pair(singleton(nameNil), + l), + ld); + + return ap(LETREC, + pair(singleton(pair(hVar, + ld)), + ap(hVar, + translate(snd(snd(q)))))); + } + + case QWHERE : return + expandLetrec(ap(LETREC, + pair(snd(q), + transComp(e,qs1,l)))); + + case BOOLQUAL : return ap(COND, + triple(translate(snd(q)), + transComp(e,qs1,l), + l)); + } + } + + return ap(ap(nameCons,e),l); +} + +/* -------------------------------------------------------------------------- + * Transformation of monad comprehensions is based on the description in + * Comprehending monads / The essence of functional programming: + * + * [ e | ] => return m e (return is applied in translate()) + * [ e | p <- exp, qs ] => LETREC _h p = [ e | qs] + * _h _ = zero m0 -- if monad with 0 + * IN bind m exp _h + * [ e | LET decls, qs ] => LETREC decls IN [ e | qs ] + * [ e | guard, qs ] => if guard then [ e | qs ] else zero m0 + * [ e | DO expr, qs ] => LETREC _h _ = [ e | qs ] in bind m exp _h + * + * where m :: Monad f, m0 :: Monad0 f + * ------------------------------------------------------------------------*/ + +static Cell local transMComp(m,m0,e,qs) /* Translate [e | qs] */ +Cell m; +Cell m0; +Cell e; +List qs; { + if (nonNull(qs)) { + Cell q = hd(qs); + Cell qs1 = tl(qs); + + switch (fst(q)) { + case FROMQUAL : { Cell ld = NIL; + Cell hVar = inventVar(); + + if (refutable(fst(snd(q))) && nonNull(m0)) + ld = cons(pair(singleton(WILDCARD), + ap(nameZero,m0)),ld); + + ld = cons(pair(singleton(fst(snd(q))), + transMComp(m,m0,e,qs1)), + ld); + + return ap(LETREC, + pair(singleton(pair(hVar,ld)), + ap(ap(ap(nameBind, + m), + translate(snd(snd(q)))), + hVar))); + } + +#if DO_COMPS + case DOQUAL : { Cell hVar = inventVar(); + Cell ld = cons(pair(singleton(WILDCARD), + transMComp(m,m0,e,qs1)), + NIL); + return ap(LETREC, + pair(singleton(pair(hVar,ld)), + ap(ap(ap(nameBind, + m), + translate(snd(q))), + hVar))); + } +#endif + + case QWHERE : return + expandLetrec(ap(LETREC, + pair(snd(q), + transMComp(m,m0,e,qs1)))); + + case BOOLQUAL : return ap(COND, + triple(translate(snd(q)), + transMComp(m,m0,e,qs1), + ap(nameZero,m0))); + } + } + + return e; /* If necessary, a monad unit/return will have already been + applied to the expression e during translate() ... */ +} + +/* -------------------------------------------------------------------------- + * Elimination of pattern bindings: + * + * The following code adopts the definition of irrefutable patterns as given + * in the Haskell report in which only variables, wildcards and ~pat patterns + * are irrefutable. As a special case (and contrary to definition of Haskell), + * we also treat tuples as irrefutable, so long as all their components are + * irrefutable. Note that the definition in Peyton Jones takes this even + * further and allows arbitrary product constructor functions as irrefutable + * patterns. + * ------------------------------------------------------------------------*/ + +Bool refutable(pat) /* is pattern refutable (do we need to */ +Cell pat; { /* to use a conformality check?) */ + Cell c = getHead(pat); + + switch (whatIs(c)) { + case ASPAT : return refutable(snd(snd(pat))); + + case TUPLE : for (; isAp(pat); pat=fun(pat)) + if (refutable(arg(pat))) + return TRUE; + /*intentional fall-thru*/ + case LAZYPAT : + case VAROPCELL : + case VARIDCELL : + case DICTVAR : + case WILDCARD : return FALSE; + + default : return TRUE; + } +} + +static Cell local refutePat(pat) /* find pattern to refute in conformality*/ +Cell pat; { /* test with pat. */ + /* e.g. refPat (x:y) == (_:_) */ + /* refPat ~(x:y) == _ etc.. */ + + switch (whatIs(pat)) { + case ASPAT : return refutePat(snd(snd(pat))); + + case FINLIST : { Cell ys = snd(pat); + Cell xs = NIL; + for (; nonNull(ys); ys=tl(ys)) + xs = ap(ap(nameCons,refutePat(hd(ys))),xs); + return revOnto(xs,nameNil); + } + + case VAROPCELL : + case VARIDCELL : + case DICTVAR : + case WILDCARD : + case LAZYPAT : return WILDCARD; + + case INTCELL : + case FLOATCELL : + case STRCELL : + case CHARCELL : +#if NPLUSK + case ADDPAT : + case MULPAT : +#endif + case UNIT : + case TUPLE : + case NAME : return pat; + + case AP : return ap(refutePat(fun(pat)),refutePat(arg(pat))); + + default : internal("refutePat"); + return NIL; /*NOTREACHED*/ + } +} + +#define addEqn(v,val,lds) cons(pair(v,singleton(pair(NIL,val))),lds) + +static List local remPat(pat,expr,lds) +Cell pat; /* Produce list of definitions for eqn */ +Cell expr; /* pat = expr, including a conformality */ +List lds; { /* check if required. */ + + /* Conformality test (if required): + * pat = expr ==> nv = LETREC confCheck nv@pat = nv + * IN confCheck expr + * remPat1(pat,nv,.....); + */ + + if (useConformality && refutable(pat)) { + Cell confVar = inventVar(); + Cell nv = inventVar(); + Cell locfun = pair(confVar, /* confVar [([nv@refPat],nv)] */ + singleton(pair(singleton(ap(ASPAT, + pair(nv, + refutePat(pat)))), + nv))); + + if (whatIs(expr)==GUARDED) { /* A spanner ... special case */ + lds = addEqn(nv,expr,lds); /* for guarded pattern binding*/ + expr = nv; + nv = inventVar(); + } + + if (whatIs(pat)==ASPAT) { /* avoid using new variable if*/ + nv = fst(snd(pat)); /* a variable is already given*/ + pat = snd(snd(pat)); /* by an as-pattern */ + } + + lds = addEqn(nv, /* nv = */ + ap(LETREC,pair(singleton(locfun), /* LETREC [locfun] */ + ap(confVar,expr))), /* IN confVar expr */ + lds); + + return remPat1(pat,nv,lds); + } + + return remPat1(pat,expr,lds); +} + +static List local remPat1(pat,expr,lds) +Cell pat; /* Add definitions for: pat = expr to */ +Cell expr; /* list of local definitions in lds. */ +List lds; { + Cell c; + + switch (whatIs(c=getHead(pat))) { + case WILDCARD : + case UNIT : + case INTCELL : + case FLOATCELL : + case STRCELL : + case CHARCELL : break; + + case ASPAT : return remPat1(snd(snd(pat)), /* v@pat = expr */ + fst(snd(pat)), + addEqn(fst(snd(pat)),expr,lds)); + + case LAZYPAT : { Cell nv; + + if (isVar(expr) || isName(expr)) + nv = expr; + else { + nv = inventVar(); + lds = addEqn(nv,expr,lds); + } + + return remPat(snd(pat),nv,lds); + } + +#if NPLUSK + case ADDPAT : return addEqn(snd(pat), /* n + k = expr */ + ap(ap(nameMinus,expr), + mkInt(intValOf(fst(pat)))), + lds); + + case MULPAT : return addEqn(snd(pat), /* c * n = expr */ + ap(ap(nameDivide,expr), + mkInt(intValOf(fst(pat)))), + lds); +#endif + + case FINLIST : return remPat1(mkConsList(snd(pat)),expr,lds); + + case DICTVAR : /* shouldn't really occur */ + case VARIDCELL : + case VAROPCELL : return addEqn(pat,expr,lds); + + case TUPLE : + case NAME : { List ps = getArgs(pat); + + if (nonNull(ps)) { + Cell nv, sel; + Int i; + + if (isVar(expr) || isName(expr)) + nv = expr; + else { + nv = inventVar(); + lds = addEqn(nv,expr,lds); + } + + sel = ap(ap(nameSel,c),nv); + for (i=1; nonNull(ps); ++i, ps=tl(ps)) + lds = remPat1(hd(ps), + ap(sel,mkInt(i)), + lds); + } + } + break; + + default : internal("remPat1"); + break; + } + return lds; +} + +/* -------------------------------------------------------------------------- + * Eliminate pattern matching in function definitions -- pattern matching + * compiler: + * + * Based on Wadler's algorithms described in `Implementation of functional + * programming languages'. + * + * During the translation, in preparation for later stages of compilation, + * all local and bound variables are replaced by suitable offsets, and + * locally defined function symbols are given new names (which will + * eventually be their names when lifted to make top level definitions). + * ------------------------------------------------------------------------*/ + +static Offset freeBegin; /* only variables with offset <= freeBegin are of */ +static List freeVars; /* interest as `free' variables */ +static List freeFuns; /* List of `free' local functions */ + +static Cell local pmcTerm(co,sc,e) /* apply pattern matching compiler */ +Int co; /* co = current offset */ +List sc; /* sc = scope */ +Cell e; { /* e = expr to transform */ + switch (whatIs(e)) { + case GUARDED : map2Over(pmcPair,co,sc,snd(e)); + break; + + case LETREC : pmcLetrec(co,sc,snd(e)); + break; + + case VARIDCELL: + case VAROPCELL: + case DICTVAR : return pmcVar(sc,textOf(e)); + + case COND : return ap(COND,pmcTriple(co,sc,snd(e))); + + case AP : return pmcPair(co,sc,e); + + case UNIT : + case TUPLE : + case NAME : + case SELECT : + case DICTCELL : + case CHARCELL : + case INTCELL : + case FLOATCELL: + case STRCELL : break; + + default : internal("pmcTerm"); + break; + } + return e; +} + +static Cell local pmcPair(co,sc,pr) /* apply pattern matching compiler */ +Int co; /* to a pair of exprs */ +List sc; +Pair pr; { + return pair(pmcTerm(co,sc,fst(pr)), + pmcTerm(co,sc,snd(pr))); +} + +static Cell local pmcTriple(co,sc,tr) /* apply pattern matching compiler */ +Int co; /* to a triple of exprs */ +List sc; +Triple tr; { + return triple(pmcTerm(co,sc,fst3(tr)), + pmcTerm(co,sc,snd3(tr)), + pmcTerm(co,sc,thd3(tr))); +} + +static Cell local pmcVar(sc,t) /* find translation of variable */ +List sc; /* in current scope */ +Text t; { + List xs; + Name n; + + for (xs=sc; nonNull(xs); xs=tl(xs)) { + Cell x = hd(xs); + if (t==textOf(fst(x))) + if (isOffset(snd(x))) { /* local variable ... */ + if (snd(x)<=freeBegin && !cellIsMember(snd(x),freeVars)) + freeVars = cons(snd(x),freeVars); + return snd(x); + } + else { /* local function ... */ + if (!cellIsMember(snd(x),freeFuns)) + freeFuns = cons(snd(x),freeFuns); + return fst3(snd(x)); + } + } + + if (isNull(n=findName(t))) /* Lookup global name - the only way*/ + n = newName(t); /* this (should be able to happen) */ + /* is with new global var introduced*/ + /* after type check; e.g. remPat1 */ + return n; +} + +static Void local pmcLetrec(co,sc,e) /* apply pattern matching compiler */ +Int co; /* to LETREC, splitting decls into */ +List sc; /* two sections */ +Pair e; { + List fs = NIL; /* local function definitions */ + List vs = NIL; /* local variable definitions */ + List ds; + + for (ds=fst(e); nonNull(ds); ds=tl(ds)) { /* Split decls into two */ + Cell v = fst(hd(ds)); + Int arity = length(fst(hd(snd(hd(ds))))); + + if (arity==0) { /* Variable declaration */ + vs = cons(snd(hd(ds)),vs); + sc = cons(pair(v,mkOffset(++co)),sc); + } + else { /* Function declaration */ + fs = cons(triple(inventVar(),mkInt(arity),snd(hd(ds))),fs); + sc = cons(pair(v,hd(fs)),sc); + } + } + vs = rev(vs); /* Put declaration lists back in */ + fs = rev(fs); /* original order */ + fst(e) = pair(vs,fs); /* Store declaration lists */ + map2Over(pmcVarDef,co,sc,vs); /* Translate variable definitions */ + map2Proc(pmcFunDef,co,sc,fs); /* Translate function definitions */ + snd(e) = pmcTerm(co,sc,snd(e)); /* Translate LETREC body */ + freeFuns = diffList(freeFuns,fs); /* Delete any `freeFuns' bound in fs*/ +} + +static Cell local pmcVarDef(co,sc,vd) /* apply pattern matching compiler */ +Int co; /* to variable definition */ +List sc; +List vd; { /* vd :: [ ([], rhs) ] */ + Cell d = snd(hd(vd)); + if (nonNull(tl(vd)) && canFail(d)) + return ap(FATBAR,pair(pmcTerm(co,sc,d), + pmcVarDef(co,sc,tl(vd)))); + return pmcTerm(co,sc,d); +} + +static Void local pmcFunDef(co,sc,fd) /* apply pattern matching compiler */ +Int co; /* to function definition */ +List sc; +Triple fd; { /* fd :: (Var, Arity, [Alt]) */ + Offset saveFreeBegin = freeBegin; + List saveFreeVars = freeVars; + List saveFreeFuns = freeFuns; + Int arity = intOf(snd3(fd)); + Cell temp = thd3(fd); + Cell xs; + + map1Over(mkSwitch,sc,temp); + + freeBegin = mkOffset(co); + freeVars = NIL; + freeFuns = NIL; + temp = match(co+arity,temp,addOffsets(co+arity,co+1,NIL)); + thd3(fd) = triple(freeVars,freeFuns,temp); + + for (xs=freeVars; nonNull(xs); xs=tl(xs)) + if (hd(xs)<=saveFreeBegin && !cellIsMember(hd(xs),saveFreeVars)) + saveFreeVars = cons(hd(xs),saveFreeVars); + + for (xs=freeFuns; nonNull(xs); xs=tl(xs)) + if (!cellIsMember(hd(xs),saveFreeFuns)) + saveFreeFuns = cons(hd(xs),saveFreeFuns); + + freeBegin = saveFreeBegin; + freeVars = saveFreeVars; + freeFuns = saveFreeFuns; +} + +/* -------------------------------------------------------------------------- + * Main part of pattern matching compiler: convert lists of Alt to case + * construct: + * + * At each stage, each branch is represented by an element of type: + * Switch ::= ([Pat],Scope,Rhs) + * which indicates that, if we can succeed in matching the given list of + * patterns, then the result will be the indicated Rhs. The Scope component + * has type: + * Scope ::= [(Var,Expr)] + * and provides a mapping from variable names to offsets used in the matching + * process. + * + * ------------------------------------------------------------------------*/ + +#define switchPats(s) fst3(s) +#define switchSyms(s) snd3(s) +#define switchRhs(s) thd3(s) +#define addSym(v,o,s) switchSyms(s) = cons(pair(v,o),switchSyms(s)) +#define matchMore(sw,c,co,us) nonNull(sw)?ap(FATBAR,pair(c,match(co,sw,us))):c + + /* There are three kinds of case: */ +#define CONDISCR 0 /* Constructor */ +#define INTDISCR 1 /* Integer (integer const/n+k) */ +#define VARDISCR 2 /* variable (or wildcard) */ + +#define isConPat(discr) (discrKind(discr)==CONDISCR) +#define isVarPat(discr) (discrKind(discr)==VARDISCR) +#define isIntPat(discr) (discrKind(discr)==INTDISCR) + +static Cell local match(co,sws,us) /* produce case statement to select */ +Int co; /* between switches in sw, matching */ +List sws; /* pats against values at offsets */ +List us; { /* given by us. co is the current */ + if (nonNull(us)) { /* offset at which new values are */ + Cell discr; /* saved */ + + map1Proc(tidyHdPat,hd(us),sws); + switch (discrKind(discr=hdDiscr(sws))) { + case CONDISCR : return matchCon(co,sws,us,discr); + case INTDISCR : return matchInt(co,sws,us,discr); + case VARDISCR : return matchVar(co,sws,us,discr); + } + } + return joinSw(co,sws); +} + +static Void local tidyHdPat(u,s) /* tidy head of pat list in a switch*/ +Offset u; /* (Principally eliminating @ pats) */ +Cell s; { + Cell p = hd(switchPats(s)); + +thp:switch (whatIs(p)) { + case ASPAT : addSym(fst(snd(p)),u,s); + p = snd(snd(p)); + goto thp; + + case LAZYPAT : { Cell nv = inventVar(); + switchRhs(s) = ap(LETREC, + pair(remPat(snd(p),nv,NIL), + switchRhs(s))); + p = nv; + } + break; + + case FINLIST : p = mkConsList(snd(p)); + break; + + case STRCELL : { Text t = textOf(p); + Int c; + p = NIL; + while ((c=textToStr(t++)[0])!='\0') { + if (c=='\\' && (c=textToStr(t++)[0])!='\\') + c = 0; + p = ap(consChar(c),p); + } + p = revOnto(p,nameNil); + } + break; + + } + hd(switchPats(s)) = p; +} + +static Cell local hdDiscr(sws) /* get discriminant of head pattern */ +List sws; { /* in first branch of a [Switch]. */ + return getHead(hd(fst3(hd(sws)))); +} + +static Int local discrKind(e) /* find kind of discriminant */ +Cell e; { + switch (whatIs(e)) { + case NAME : + case TUPLE : + case UNIT : + case STRCELL : /* shouldn't be here? */ + case CHARCELL : return CONDISCR; + +#if NPLUSK + case ADDPAT : + case MULPAT : +#endif + case INTCELL : return INTDISCR; + + case VARIDCELL : + case VAROPCELL : + case DICTVAR : + case WILDCARD : return VARDISCR; + } + internal("discrKind"); + return 0;/*NOTREACHED*/ +} + +Int discrArity(e) /* find arity of discriminant */ +Cell e; { + switch (whatIs(e)) { + case NAME : return name(e).arity; + + case TUPLE : return tupleOf(e); + + case UNIT : + case STRCELL : /* shouldn't be here? */ + case FLOATCELL : + case CHARCELL : + case INTCELL : return 0; + +#if NPLUSK + case ADDPAT : + case MULPAT : +#endif + case VARIDCELL : + case VAROPCELL : + case DICTVAR : + case WILDCARD : return 1; + } + internal("discrArity"); + return 0;/*NOTREACHED*/ +} + +/* -------------------------------------------------------------------------- + * Match on variables: + * ------------------------------------------------------------------------*/ + +static Cell local matchVar(co,sws,us,discr)/* matching against a variable */ +Int co; /* does not trigger any evaluation, */ +List sws; /* but can extend the scope with a */ +List us; /* new binding */ +Cell discr; { + List varsw = NIL; + Cell s; + + do { + s = hd(sws); + if (discr!=WILDCARD) + addSym(discr,hd(us),s); + switchPats(s) = tl(switchPats(s)); + varsw = cons(s,varsw); + sws = tl(sws); + } while (nonNull(sws) && isVarPat(discr=hdDiscr(sws))); + + s = match(co,rev(varsw),tl(us)); + return matchMore(sws,s,co,us); +} + +/* -------------------------------------------------------------------------- + * Match on constructors: + * ------------------------------------------------------------------------*/ + +static Cell local matchCon(co,sws,us,discr) /* matching against constructor*/ +Int co; +List sws; +List us; +Cell discr; { + List tab = NIL; /* build table of (discr, [Switch]) */ + Cell s; + List ps; + + do { + s = hd(sws); + ps = switchPats(s); + ps = appendOnto(getArgs(hd(ps)),tl(ps)); + switchPats(s) = ps; + tab = addConTable(discr,s,tab); + sws = tl(sws); + } while (nonNull(sws) && isConPat(discr=hdDiscr(sws))); + + s = ap(CASE,pair(hd(us),makeCases(co,rev(tab),tl(us)))); + return matchMore(sws,s,co,us); +} + +/* type Table a b = [(a, [b])] + * + * addTable :: a -> b -> Table a b -> Table a b + * addTable x y [] = [(x,[y])] + * addTable x y (z@(n,sws):zs) + * | n == x = (n,sws++[y]):zs + * | otherwise = (n,sws):addTable x y zs + */ + +static List local addConTable(x,y,tab) /* add element (x,y) to table */ +Cell x, y; +List tab; { + if (isNull(tab)) + return singleton(pair(x,singleton(y))); + else if (fst(hd(tab))==x) + snd(hd(tab)) = appendOnto(snd(hd(tab)),singleton(y)); + else + tl(tab) = addConTable(x,y,tl(tab)); + + return tab; +} + +static Cell local makeCases(co,tab,us) /* build CASE construct for constr */ +Int co; /* match */ +List tab; +List us; { + List cases; + + for (cases=NIL; nonNull(tab); tab=tl(tab)) { + Cell n = fst(hd(tab)); + Int co1 = co+discrArity(n); + cases = cons(pair(n, + match(co1, + snd(hd(tab)), + addOffsets(co1,co+1,us))), + cases); + } + return cases; +} + +/* -------------------------------------------------------------------------- + * Match on integers: + * ------------------------------------------------------------------------*/ + +static Cell local matchInt(co,sws,us,discr)/* match against integer values */ +Int co; +List sws; +List us; +Cell discr; { + List tab = NIL; /* table of (discr, [Switch]) pairs */ + Cell s = hd(sws); +#if NPLUSK + Cell cnkPat = NIL; /* Current MULPAT or ADDPAT */ + Cell intPat = NIL; /* Current INTCELL pattern */ +#endif + List ps; + + do { +#if NPLUSK + if (whatIs(discr)==INTCELL) { + if (nonNull(cnkPat)) + break; + if (isNull(intPat)) + intPat = discr; + } + else { + if (nonNull(intPat)) + break; + if (isNull(cnkPat)) + cnkPat = discr; + else + if (fst(cnkPat)!=fst(discr)||intValOf(cnkPat)!=intValOf(discr)) + break; + else + discr = cnkPat; + } +#endif + + s = hd(sws); + ps = switchPats(s); + ps = appendOnto(getArgs(hd(ps)),tl(ps)); + switchPats(s) = ps; + tab = addConTable(discr,s,tab); + sws = tl(sws); + } while (nonNull(sws) && isIntPat(discr=hdDiscr(sws))); + + s = ap(CASE,pair(hd(us),makeCases(co,rev(tab),tl(us)))); + return matchMore(sws,s,co,us); +} + +/* -------------------------------------------------------------------------- + * Miscellaneous: + * ------------------------------------------------------------------------*/ + +static List local addOffsets(m,n,us) /* addOffsets m n us */ +Int m, n; /* = map mkOffset [m,m-1..n] ++ us */ +List us; { + for (; m>=n; n++) + us = cons(mkOffset(n),us); + return us; +} + +static Cell local mkSwitch(sc,alt) /* convert Alt into Switch: */ +List sc; /* mkSwitch sc (ps,r) = (ps,sc,r) */ +Pair alt; { + return triple(fst(alt),sc,snd(alt)); +} + +static Cell local joinSw(co,sws) /* Combine list of Switches into rhs*/ +Int co; /* using FATBARs as necessary */ +List sws; { /* :: [ ([], Scope, Rhs) ] */ + Cell s = hd(sws); + + if (nonNull(tl(sws)) && canFail(thd3(s))) + return ap(FATBAR, + pair(pmcTerm(co,snd3(s),thd3(s)), + joinSw(co,tl(sws)))); + return pmcTerm(co,snd3(s),thd3(s)); +} + +static Bool local canFail(rhs) /* Determine if expression (as rhs) */ +Cell rhs; { /* might ever be able to fail */ + switch (whatIs(rhs)) { + case LETREC : return canFail(snd(snd(rhs))); + case GUARDED : return TRUE; /* could get more sophisticated ..? */ + default : return FALSE; + } +} + +/* -------------------------------------------------------------------------- + * Lambda Lifter: replace local function definitions with new global + * functions. Based on Johnsson's algorithm. + * ------------------------------------------------------------------------*/ + +static Cell local lift(co,tr,e) /* lambda lift term */ +Int co; +List tr; +Cell e; { + switch (whatIs(e)) { + case GUARDED : map2Proc(liftPair,co,tr,snd(e)); + break; + + case FATBAR : liftPair(co,tr,snd(e)); + break; + + case CASE : map2Proc(liftAlt,co,tr,snd(snd(e))); + break; + + case COND : liftTriple(co,tr,snd(e)); + break; + + case AP : liftPair(co,tr,e); + break; + + case VAROPCELL : + case VARIDCELL : + case DICTVAR : return liftVar(tr,e); + + case LETREC : return liftLetrec(co,tr,e); + + case UNIT : + case TUPLE : + case NAME : + case SELECT : + case DICTCELL : + case INTCELL : + case FLOATCELL : + case STRCELL : + case OFFSET : + case CHARCELL : break; + + default : internal("lift"); + break; + } + return e; +} + +static Void local liftPair(co,tr,pr) /* lift pair of terms */ +Int co; +List tr; +Pair pr; { + fst(pr) = lift(co,tr,fst(pr)); + snd(pr) = lift(co,tr,snd(pr)); +} + +static Void local liftTriple(co,tr,e) /* lift triple of terms */ +Int co; +List tr; +Triple e; { + fst3(e) = lift(co,tr,fst3(e)); + snd3(e) = lift(co,tr,snd3(e)); + thd3(e) = lift(co,tr,thd3(e)); +} + +static Void local liftAlt(co,tr,pr) /* lift (discr,case) pair */ +Int co; +List tr; +Cell pr; { /* pr :: (discr,case) */ + snd(pr) = lift(co+discrArity(fst(pr)), tr, snd(pr)); +} + +static Cell local liftVar(tr,e) /* lift variable */ +List tr; +Cell e; { + Text t = textOf(e); + + while (nonNull(tr) && textOf(fst(hd(tr)))!=t) + tr = tl(tr); + if (isNull(tr)) + internal("liftVar"); + return snd(hd(tr)); +} + +static Cell local liftLetrec(co,tr,e) /* lift letrec term */ +Int co; +List tr; +Cell e; { + List vs = fst(fst(snd(e))); + List fs = snd(fst(snd(e))); + List fds; + + co += length(vs); + solve(fs); + + for (fds=fs; nonNull(fds); fds=tl(fds)) { + Triple fundef = hd(fds); + List fvs = fst3(thd3(fundef)); + Cell n = newName(textOf(fst3(fundef))); + Cell e0; + + for (e0=n; nonNull(fvs); fvs=tl(fvs)) + e0 = ap(e0,hd(fvs)); + + tr = cons(pair(fst3(fundef),e0),tr); + fst3(fundef) = n; + } + + map2Proc(liftFundef,co,tr,fs); + if (isNull(vs)) + return lift(co,tr,snd(snd(e))); + map2Over(lift,co,tr,vs); + fst(snd(e)) = vs; + snd(snd(e)) = lift(co,tr,snd(snd(e))); + return e; +} + +static Void local liftFundef(co,tr,fd) /* lift function definition */ +Int co; +List tr; +Triple fd; { + Int arity = intOf(snd3(fd)); + newGlobalFunction(fst3(fd), /* name */ + arity, /* arity */ + fst3(thd3(fd)), /* free variables */ + co+arity, /* current offset */ + lift(co+arity,tr,thd3(thd3(fd)))); /* lifted case */ +} + +/* Each element in a list of fundefs has the form: (v,a,(fvs,ffs,rhs)) + * where fvs is a list of free variables which must be added as extra + * parameters to the lifted version of function v, + * ffs is a list of fundefs defined either in the group of definitions + * including v, or in some outer LETREC binding. + * + * In order to determine the correct value for fvs, we must include: + * - all variables explicitly appearing in the body rhs (this much is + * achieved in pmcVar). + * - all variables required for lifting those functions appearing in ffs. + * - If f is a fundef in an enclosing group of definitions then the + * correct list of variables to include with each occurrence of f will + * have already been calculated and stored in the fundef f. We simply + * take the union of this list with fvs. + * - If f is a fundef in the same group of bindings as v, then we iterate + * to find the required solution. + */ + +#ifdef DEBUG_CODE +static Void dumpFundefs(fs) +List fs; { + printf("Dumping Fundefs:\n"); + for (; nonNull(fs); fs=tl(fs)) { + Cell t = hd(fs); + List fvs = fst3(thd3(t)); + List ffs = snd3(thd3(t)); + printf("Var \"%s\", arity %d:\n",textToStr(textOf(fst3(t))), + intOf(snd3(t))); + printf("Free variables: "); + printExp(stdout,fvs); + putchar('\n'); + printf("Local functions: "); + for (; nonNull(ffs); ffs=tl(ffs)) { + printExp(stdout,fst3(hd(ffs))); + printf(" "); + } + putchar('\n'); + } + printf("----------------\n"); +} +#endif + +static Void local solve(fs) /* Solve eqns for lambda-lifting */ +List fs; { /* of local function definitions */ + Bool hasChanged; + List fs0, fs1; + + /* initial pass distinguishes between those functions defined in fs and + * those defined in enclosing LETREC clauses ... + */ + + for (fs0=fs; nonNull(fs0); fs0=tl(fs0)) { + List fvs = fst3(thd3(hd(fs0))); + List ffs = NIL; + + for (fs1=snd3(thd3(hd(fs0))); nonNull(fs1); fs1=tl(fs1)) { + if (cellIsMember(hd(fs1),fs)) /* function in same LETREC*/ + ffs = cons(hd(fs1),ffs); + else { /* enclosing letrec */ + List fvs1 = fst3(thd3(hd(fs1))); + for (; nonNull(fvs1); fvs1=tl(fvs1)) + if (!cellIsMember(hd(fvs1),fvs)) + fvs = cons(hd(fvs1),fvs); + } + } + fst3(thd3(hd(fs0))) = fvs; + snd3(thd3(hd(fs0))) = ffs; + } + + /* now that the ffs component of each fundef in fs has been restricted + * to a list of fundefs in fs, we iterate to add any extra free variables + * that are needed (in effect, calculating the reflexive transitive + * closure of the local call graph of fs). + */ + + do { + hasChanged = FALSE; + for (fs0=fs; nonNull(fs0); fs0=tl(fs0)) { + List fvs0 = fst3(thd3(hd(fs0))); + for (fs1=snd3(thd3(hd(fs0))); nonNull(fs1); fs1=tl(fs1)) + if (hd(fs1)!=hd(fs0)) { + List fvs1 = fst3(thd3(hd(fs1))); + for (; nonNull(fvs1); fvs1=tl(fvs1)) + if (!cellIsMember(hd(fvs1),fvs0)) { + hasChanged = TRUE; + fvs0 = cons(hd(fvs1),fvs0); + } + } + if (hasChanged) fst3(thd3(hd(fs0))) = fvs0; + } + } while (hasChanged); +} + +/* -------------------------------------------------------------------------- + * Pre-compiler: Uses output from lambda lifter to produce terms suitable + * for input to code generator. + * ------------------------------------------------------------------------*/ + +static List extraVars; /* List of additional vars to add to function */ +static Int numExtraVars; /* Length of extraVars */ +static Int localOffset; /* offset value used in original definition */ +static Int localArity; /* arity of function being compiled w/o extras */ + +/* -------------------------------------------------------------------------- + * Arrangement of arguments on stack prior to call of + * n x_1 ... x_e y_1 ... y_a + * where + * e = numExtraVars, x_1,...,x_e are the extra params to n + * a = localArity of n, y_1,...,y_a are the original params + * + * offset 1 : y_a } STACKPART1 + * .. } + * offset a : y_1 } + * + * offset 1+a : x_e } STACKPART2 + * .. } + * offset e+a : x_1 } + * + * offset e+a+1 : used for temporary results ... STACKPART3 + * .. + * .. + * + * In the original defn for n, the offsets in STACKPART1 and STACKPART3 + * are contiguous. To add the extra parameters we need to insert the + * offsets in STACKPART2, adjusting offset values as necessary. + * ------------------------------------------------------------------------*/ + +static Cell local preComp(e) /* Adjust output from compiler to */ +Cell e; { /* include extra parameters */ + switch (whatIs(e)) { + case GUARDED : mapOver(preCompPair,snd(e)); + break; + + case LETREC : mapOver(preComp,fst(snd(e))); + snd(snd(e)) = preComp(snd(snd(e))); + break; + + case COND : return ap(COND,preCompTriple(snd(e))); + + case FATBAR : return ap(FATBAR,preCompPair(snd(e))); + + case AP : return preCompPair(e); + + case CASE : fst(snd(e)) = preComp(fst(snd(e))); + mapProc(preCompCase,snd(snd(e))); + break; + + case OFFSET : return preCompOffset(offsetOf(e)); + + case UNIT : + case TUPLE : + case NAME : + case SELECT : + case DICTCELL : + case INTCELL : + case FLOATCELL : + case STRCELL : + case CHARCELL : break; + + default : internal("preComp"); + } + return e; +} + +static Cell local preCompPair(e) /* Apply preComp to pair of Exprs */ +Pair e; { + return pair(preComp(fst(e)), + preComp(snd(e))); +} + +static Cell local preCompTriple(e) /* Apply preComp to triple of Exprs */ +Triple e; { + return triple(preComp(fst3(e)), + preComp(snd3(e)), + preComp(thd3(e))); +} + +static Void local preCompCase(e) /* Apply preComp to (Discr,Expr) */ +Pair e; { + snd(e) = preComp(snd(e)); +} + +static Cell local preCompOffset(n) /* Determine correct offset value */ +Int n; { /* for local variable/function arg. */ + if (n>localOffset-localArity) + if (n>localOffset) /* STACKPART3 */ + return mkOffset(n-localOffset+localArity+numExtraVars); + else /* STACKPART1 */ + return mkOffset(n-localOffset+localArity); + else { /* STACKPART2 */ + List fvs = extraVars; + Int i = localArity+numExtraVars; + + for (; nonNull(fvs) && offsetOf(hd(fvs))!=n; --i) + fvs=tl(fvs); + return mkOffset(i); + } +} + +/* -------------------------------------------------------------------------- + * Main entry points to compiler: + * ------------------------------------------------------------------------*/ + +Void compileExp() { /* compile input expression */ + compiler(RESET); + + inputExpr = lift(0,NIL,pmcTerm(0,NIL,translate(inputExpr))); + extraVars = NIL; + numExtraVars = 0; + localOffset = 0; + localArity = 0; + inputCode = codeGen(NIL,0,preComp(inputExpr)); + inputExpr = NIL; +} + +Void compileDefns() { /* compile script definitions */ + Target t = length(valDefns) + length(overDefns); + Target i = 0; + + setGoal("Compiling",t); + for (; nonNull(valDefns); valDefns=tl(valDefns)) { + mapProc(compileGlobalFunction,transBinds(hd(valDefns))); + soFar(i++); + } + for (; nonNull(overDefns); overDefns=tl(overDefns)) { + compileMemberFunction(hd(overDefns)); + soFar(i++); + } + done(); +} + +static Void local compileGlobalFunction(bind) +Pair bind; { + Name n = findName(textOf(fst(bind))); + List defs = snd(bind); + Int arity = length(fst(hd(defs))); + + if (isNull(n)) + internal("compileGlobalFunction"); + compiler(RESET); + map1Over(mkSwitch,NIL,defs); + newGlobalFunction(n, + arity, + NIL, + arity, + lift(arity, + NIL, + match(arity, + defs, + addOffsets(arity,1,NIL)))); +} + +static Void local compileMemberFunction(n) +Name n; { + List defs = name(n).defn; + Int arity = length(fst(hd(defs))); + + compiler(RESET); + mapProc(transAlt,defs); + map1Over(mkSwitch,NIL,defs); + newGlobalFunction(n, + arity, + NIL, + arity, + lift(arity, + NIL, + match(arity, + defs, + addOffsets(arity,1,NIL)))); +} + +static Void local newGlobalFunction(n,arity,fvs,co,e) +Name n; +Int arity; +List fvs; +Int co; +Cell e; { + extraVars = fvs; + numExtraVars = length(extraVars); + localOffset = co; + localArity = arity; + name(n).arity = arity+numExtraVars; + name(n).code = codeGen(n,name(n).arity,preComp(e)); +} + +/* -------------------------------------------------------------------------- + * Compiler control: + * ------------------------------------------------------------------------*/ + +Void compiler(what) +Int what; { + switch (what) { + case INSTALL : + case RESET : freeVars = NIL; + freeFuns = NIL; + freeBegin = mkOffset(0); + extraVars = NIL; + numExtraVars = 0; + localOffset = 0; + localArity = 0; + break; + + case MARK : mark(freeVars); + mark(freeFuns); + mark(extraVars); + break; + } +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/connect.h b/src/connect.h new file mode 100644 index 0000000..937f1ba --- /dev/null +++ b/src/connect.h @@ -0,0 +1,215 @@ +/* -------------------------------------------------------------------------- + * connect.h: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Connections between components of the Gofer system + * ------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Standard data: + * ------------------------------------------------------------------------*/ + +extern Name nameFalse, nameTrue; /* primitive constructor functions */ +extern Name nameNil, nameCons; +extern Name nameFatbar, nameFail; /* primitives reqd for translation */ +extern Name nameIf, nameSel; +extern Name nameMinus, nameDivide; +extern Name nameUndefMem; /* undefined member primitive */ +extern Name nameError; /* for runtime error messages */ +extern Name nameBlackHole; /* for GC-detected black hole */ +extern Name nameAnd, nameOr; /* for optimisation of && and || */ +extern Name nameOtherwise; + +extern Name nameResult, nameBind; /* for translation of monad comps */ +extern Name nameZero; + +extern Name namePrint; /* printing primitive */ + +#if IO_DIALOGUE +extern Name nameReadFile, nameWriteFile;/* I/O name primitives */ +extern Name nameAppendFile, nameReadChan; +extern Name nameAppendChan, nameEcho; +extern Name nameGetArgs, nameGetProgName; +extern Name nameGetEnv; +extern Name nameSuccess, nameStr; +extern Name nameFailure, nameStrList; +extern Name nameWriteError; +extern Name nameReadError, nameSearchError; +extern Name nameFormatError,nameOtherError; +#endif +#if IO_MONAD +extern Type typeIO, typeProgIO; /* for the IO monad, IO and IO () */ +extern Type typeWorld, typeST; /* built on top of IO = ST World */ +extern Void ioExecute Args((Cell)); /* IO monad executor */ +extern Name nameSTRun; /* encapsulator */ +extern Type typeMutVar; /* type constr for mutable vars */ +#if HASKELL_ARRAYS +extern Type typeMutArr; /* type constr for mutable arrays */ +#endif +#endif +#ifdef LAMBDAVAR +extern Name nameVar; /* internal lambda var constructor */ +extern Type typeProg; /* type of a lambda var program */ +extern Void lvExecute Args((Cell)); /* lambda var executor */ +#endif +#ifdef LAMBDANU +extern Name nameTag; /* internal lambda nu constructor */ +extern Type typeLnProg; /* type of a lambda nu prog */ +extern Void lnExecute Args((Cell)); /* Lambda nu executor */ +#endif +#if HASKELL_ARRAYS +extern Type typeArray; /* type constr for arrays */ +#endif + +extern Text textPlus, textMult; /* used to recognise n+k/c*n pats */ + +extern String repeatStr; /* repeat last command string */ + +extern Type typeString; /* String == [Char] */ +extern Type typeDialogue; /* Dialogue== [Response]->[Request]*/ +extern Type typeBool; +extern Type typeInt; +extern Type typeFloat; +extern Type typeChar; + +extern Cell *CStackBase; /* pointer to base of C stack */ + +extern List tyconDefns; /* list of type constructor defns */ +extern List typeInDefns; /* list of synonym restrictions */ +extern List valDefns; /* list of value definitions */ +extern List opDefns; /* list of operator definitions */ +extern List classDefns; /* list of class definitions */ +extern List instDefns; /* list of instance definitions */ +extern List overDefns; /* list of overloaded member defns */ +extern List primDefns; /* list of primitive definitions */ +extern Cell inputExpr; /* evaluator input expression */ +extern Addr inputCode; /* Code for compiled input expr */ + +extern Int whnfArgs; /* number of args of term in whnf */ +extern Cell whnfHead; /* head of term in whnf */ +extern Int whnfInt; /* integer value of term in whnf */ +extern Float whnfFloat; /* float value of term in whnf */ +extern Long numReductions; /* number of reductions used */ +extern Long numCells; /* number of cells allocated */ +extern Int numberGcs; /* number of garbage collections */ +extern Int cellsRecovered; /* cells recovered by last gc */ + +extern Bool gcMessages; /* TRUE => print GC messages */ +extern Bool literateScripts; /* TRUE => default lit scripts */ +extern Bool literateErrors; /* TRUE => report errs in lit scrs */ +extern Bool useConformality; /* TRUE => check patbind conform'ty*/ +extern Bool anyEvidence; /* TRUE => don't search for best ev*/ +extern Bool coerceNumLiterals; /* TRUE => insert fromInteger calls*/ + /* etc for numeric literals*/ +extern Bool andorOptimise; /* TRUE => optimise uses of &&, || */ +extern Bool showDicts; /* TRUE => show dictionary params */ + /* in output expressions */ +extern Bool catchAmbigs; /* TRUE => functions with ambig. */ + /* types produce error */ +extern Bool failOnError; /* TRUE => error produces immediate*/ + /* termination */ + +extern Int maxEvidLevel; /* maximum no of selects in evid */ +extern Bool silentEvFail; /* TRUE => keep quiet if maxEvidLev*/ + /* is exceeded. */ + +extern Bool kindExpert; /* TRUE => display kind errors in */ + /* full detail */ +extern Bool overSingleton; /* TRUE => overload singleton list */ + /* notation, [x] */ + +/* -------------------------------------------------------------------------- + * Function prototypes etc... + * ------------------------------------------------------------------------*/ + +extern Void everybody Args((Int)); + +#define RESET 1 /* reset subsystem */ +#define MARK 2 /* mark parts of graph in use by subsystem */ +#define INSTALL 3 /* install subsystem (executed once only) */ +#define EXIT 4 /* Take action immediately before exit() */ +#define BREAK 5 /* Take action after program break */ +#define PRELUDE 6 /* Init. once prelude Tycons/Classes known */ + +typedef long Target; +extern Void setGoal Args((String, Target)); +extern Void soFar Args((Target)); +extern Void done Args((Void)); +extern String fromEnv Args((String,String)); + +extern Void storage Args((Int)); +extern Void setLastExpr Args((Cell)); +extern Cell getLastExpr Args((Void)); +extern List addNamesMatching Args((String,List)); + +extern Void input Args((Int)); +extern Void consoleInput Args((String)); +extern Void projInput Args((String)); +extern Void parseScript Args((String,Long)); +extern Void parseExp Args((Void)); +extern String readFilename Args((Void)); +extern String readLine Args((Void)); +extern Syntax defaultSyntax Args((Text)); +extern String unlexChar Args((Char,Char)); + +extern Void staticAnalysis Args((Int)); +extern Void tyconDefn Args((Int,Cell,Cell,Cell)); +extern Void setTypeIns Args((List)); +extern Void clearTypeIns Args((Void)); +extern Bool isAmbiguous Args((Type)); +extern Void ambigError Args((Int,String,Cell,Type)); +extern Void classDefn Args((Int,Cell,Cell)); +extern Void instDefn Args((Int,Cell,Cell)); +extern Void primDefn Args((Cell,List,Cell)); +extern Void checkExp Args((Void)); +extern Void checkDefns Args((Void)); + +extern Void typeChecker Args((Int)); +extern Type typeCheckExp Args((Void)); +extern Void typeCheckDefns Args((Void)); +extern Void insertInst Args((Int,Class,Inst)); +extern Cell rhsExpr Args((Cell)); +extern Int rhsLine Args((Cell)); +extern Bool typeMatches Args((Type,Type)); +extern Bool typeInstOf Args((Type,Type)); +extern Dict listMonadDict Args((Void)); + +extern Void kindTCGroup Args((List)); +extern Void kindSigType Args((Int,Type)); +extern Void kindInst Args((Inst,Int)); + +extern Void compiler Args((Cell)); +extern Void compileDefns Args((Void)); +extern Void compileExp Args((Void)); +extern Bool refutable Args((Cell)); +extern Int discrArity Args((Cell)); + +extern Void machine Args((Int)); +extern Addr codeGen Args((Name,Int,Cell)); +extern Void externalPrim Args((Name,String)); +extern Void unwind Args((Cell)); +extern Void eval Args((Cell)); +extern Cell evalWithNoError Args((Cell)); +extern Void evalFails Args((StackPtr)); +extern Cell graphForExp Args((Void)); + +extern Void builtIn Args((Int)); +extern Void abandon Args((String,Cell)); +extern Cell outputString Args((FILE *,Cell)); +extern Void dialogue Args((Cell)); +extern Cell consChar Args((Char)); + +extern Void machdep Args((Int)); +extern String timeString Args((Void)); +extern Int shellEsc Args((String)); +extern Int getTerminalWidth Args((Void)); +extern Void normalTerminal Args((Void)); +extern Void noechoTerminal Args((Void)); +extern Int readTerminalChar Args((Void)); +extern Void gcStarted Args((Void)); +extern Void gcScanning Args((Void)); +extern Void gcRecovered Args((Int)); +extern Void gcCStack Args((Void)); + +/*-------------------------------------------------------------------------*/ diff --git a/src/doparser.c b/src/doparser.c new file mode 100644 index 0000000..3f0316a --- /dev/null +++ b/src/doparser.c @@ -0,0 +1,1596 @@ +/* This file is provided for the benefit of those without access to an + implementation of yacc ... it should be used as a replacement for parser.c + to provide support for the new do notation. See release notes for further + details. */ + +# line 19 "doparser.y" +#ifndef lint +#define lint +#endif +#define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n +#define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t)) +#define grded(gs) ap(GUARDED,gs) +#define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) +#define yyerror(s) /* errors handled elsewhere */ +#define YYSTYPE Cell + +static Cell local gcShadow Args((Int,Cell)); +static Void local syntaxError Args((String)); +static String local unexpected Args((Void)); +static Cell local checkPrec Args((Cell)); +static Void local fixDefn Args((Syntax,Cell,Cell,List)); +static Void local setSyntax Args((Int,Syntax,Cell)); +static Cell local buildTuple Args((List)); +static Cell local checkClass Args((Cell)); +static List local checkContext Args((List)); +static Pair local checkDo Args((List)); +static Cell local checkTyLhs Args((Cell)); +static Cell local tidyInfix Args((Cell)); + +/* For the purposes of reasonably portable garbage collection, it is + * necessary to simulate the YACC stack on the Gofer stack to keep + * track of all intermediate constructs. The lexical analyser + * pushes a token onto the stack for each token that is found, with + * these elements being removed as reduce actions are performed, + * taking account of look-ahead tokens as described by gcShadow() + * below. + * + * Of the non-terminals used below, only start, topDecl & begin do not leave + * any values on the Gofer stack. The same is true for the terminals + * EVALEX and SCRIPT. At the end of a successful parse, there should only + * be one element left on the stack, containing the result of the parse. + */ + +#define gc0(e) gcShadow(0,e) +#define gc1(e) gcShadow(1,e) +#define gc2(e) gcShadow(2,e) +#define gc3(e) gcShadow(3,e) +#define gc4(e) gcShadow(4,e) +#define gc5(e) gcShadow(5,e) +#define gc6(e) gcShadow(6,e) +#define gc7(e) gcShadow(7,e) + +# define EVALEX 257 +# define SCRIPT 258 +# define COCO 259 +# define INFIXL 260 +# define INFIXR 261 +# define INFIX 262 +# define FUNARROW 263 +# define UPTO 264 +# define CASEXP 265 +# define OF 266 +# define IF 267 +# define THEN 268 +# define ELSE 269 +# define WHERE 270 +# define TYPE 271 +# define DATA 272 +# define FROM 273 +# define LET 274 +# define IN 275 +# define VAROP 276 +# define VARID 277 +# define NUMLIT 278 +# define CHARLIT 279 +# define STRINGLIT 280 +# define REPEAT 281 +# define CONOP 282 +# define CONID 283 +# define TCLASS 284 +# define IMPLIES 285 +# define TINSTANCE 286 +# define DO 287 +# define TRUNST 288 +# define PRIMITIVE 289 +# define DEFAULT 290 +# define DERIVING 291 +# define HIDING 292 +# define IMPORT 293 +# define INTERFACE 294 +# define MODULE 295 +# define RENAMING 296 +# define TO 297 +#define yyclearin yychar = -1 +#define yyerrok yyerrflag = 0 +extern int yychar; +extern short yyerrflag; +#ifndef YYMAXDEPTH +#define YYMAXDEPTH 150 +#endif +#ifndef YYSTYPE +#define YYSTYPE int +#endif +YYSTYPE yylval, yyval; +# define YYERRCODE 256 + +# line 488 "doparser.y" + + +static Cell local gcShadow(n,e) /* keep parsed fragments on stack */ +Int n; +Cell e; { + /* If a look ahead token is held then the required stack transformation + * is: + * pushed: n 1 0 1 0 + * x1 | ... | xn | la ===> e | la + * top() top() + * + * Othwerwise, the transformation is: + * pushed: n-1 0 0 + * x1 | ... | xn ===> e + * top() top() + */ + if (yychar>=0) { + pushed(n-1) = top(); + pushed(n) = e; + } + else + pushed(n-1) = e; + sp -= (n-1); + return e; +} + +static Void local syntaxError(s) /* report on syntax error */ +String s; { + ERROR(row) "Syntax error in %s (unexpected %s)", s, unexpected() + EEND; +} + +static String local unexpected() { /* find name for unexpected token */ + static char buffer[100]; + static char *fmt = "%s \"%s\""; + static char *kwd = "keyword"; + static char *hkw = "(Haskell) keyword"; + + switch (yychar) { + case 0 : return "end of input"; + +#define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer; + case INFIXL : keyword("infixl"); + case INFIXR : keyword("infixr"); + case INFIX : keyword("infix"); + case TINSTANCE : keyword("instance"); + case TCLASS : keyword("class"); + case PRIMITIVE : keyword("primitive"); + case CASEXP : keyword("case"); + case OF : keyword("of"); + case IF : keyword("if"); + case DO : keyword("do"); + case TRUNST : keyword("runST"); + case THEN : keyword("then"); + case ELSE : keyword("else"); + case WHERE : keyword("where"); + case TYPE : keyword("type"); + case DATA : keyword("data"); + case LET : keyword("let"); + case IN : keyword("in"); +#undef keyword + +#define hasword(kw) sprintf(buffer,fmt,hkw,kw); return buffer; + case DEFAULT : hasword("default"); + case DERIVING : hasword("deriving"); + case HIDING : hasword("hiding"); + case IMPORT : hasword("import"); + case INTERFACE : hasword("interface"); + case MODULE : hasword("module"); + case RENAMING : hasword("renaming"); + case TO : hasword("to"); +#undef hasword + + case FUNARROW : return "`->'"; + case '=' : return "`='"; + case COCO : return "`::'"; + case '-' : return "`-'"; + case ',' : return "comma"; + case '@' : return "`@'"; + case '(' : return "`('"; + case ')' : return "`)'"; + case '|' : return "`|'"; + case ';' : return "`;'"; + case UPTO : return "`..'"; + case '[' : return "`['"; + case ']' : return "`]'"; + case FROM : return "`<-'"; + case '\\' : return "backslash (lambda)"; + case '~' : return "tilde"; + case '`' : return "backquote"; + case VAROP : + case VARID : + case CONOP : + case CONID : sprintf(buffer,"symbol \"%s\"", + textToStr(textOf(yylval))); + return buffer; + case NUMLIT : return "numeric literal"; + case CHARLIT : return "character literal"; + case STRINGLIT : return "string literal"; + case IMPLIES : return "`=>"; + default : return "token"; + } +} + +static Cell local checkPrec(p) /* Check for valid precedence value */ +Cell p; { + if (!isInt(p) || intOf(p)MAX_PREC) { + ERROR(row) "Precedence value must be an integer in the range [%d..%d]", + MIN_PREC, MAX_PREC + EEND; + } + return p; +} + +static Void local fixDefn(a,line,p,ops)/* Declare syntax of operators */ +Syntax a; +Cell line; +Cell p; +List ops; { + Int l = intOf(line); + a = mkSyntax(a,intOf(p)); + map2Proc(setSyntax,l,a,ops); +} + +static Void local setSyntax(line,sy,op)/* set syntax of individ. operator */ +Int line; +Syntax sy; +Cell op; { + addSyntax(line,textOf(op),sy); + opDefns = cons(op,opDefns); +} + +static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from list*/ +List tup; { /* [xn,...,x1] */ + Int n = 0; + Cell t = tup; + Cell x; + + do { /* . . */ + x = fst(t); /* / \ / \ */ + fst(t) = snd(t); /* xn . . xn */ + snd(t) = x; /* . ===> . */ + x = t; /* . . */ + t = fun(x); /* . . */ + n++; /* / \ / \ */ + } while (nonNull(t)); /* x1 NIL (n) x1 */ + fst(x) = mkTuple(n); + return tup; +} + +/* The yacc parser presented above is not sufficiently powerful to + * determine whether a tuple at the front of a sigType is part of a + * context: e.g. (Eq a, Num a) => a -> a -> a + * or a type: e.g. (Tree a, Tree a) -> Tree a + * + * Rather than complicate the grammar, both are parsed as tuples of types, + * using the following checks afterwards to ensure that the correct syntax + * is used in the case of a tupled context. + */ + +static List local checkContext(con) /* validate type class context */ +Type con; { + if (con==UNIT) /* allows empty context () */ + return NIL; + else if (whatIs(getHead(con))==TUPLE) { + List qs = NIL; + + while (isAp(con)) { /* undo work of buildTuple :-( */ + Cell temp = fun(con); + fun(con) = arg(con); + arg(con) = qs; + qs = con; + con = temp; + checkClass(hd(qs)); + } + return qs; + } + else /* single context expression */ + return singleton(checkClass(con)); +} + +static Cell local checkClass(c) /* check that type expr is a class */ +Cell c; { /* constrnt of the form C t1 .. tn */ + Cell cn = getHead(c); + + if (!isCon(cn)) + syntaxError("class expression"); + else if (argCount<1) { + ERROR(row) "Class \"%s\" must have at least one argument", + textToStr(textOf(cn)) + EEND; + } + return c; +} + +static Pair local checkDo(dqs) /* convert reversed list of dquals */ +List dqs; { /* to a (expr,quals) pair */ +#if DO_COMPS + if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { + ERROR(row) "Last generator in do {...} must be an expression" + EEND; + } + fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ + snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ +#endif + return dqs; +} + +static Cell local checkTyLhs(c) /* check that lhs is of the form */ +Cell c; { /* T a1 ... a */ + Cell tlhs = c; + while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) + tlhs = fun(tlhs); + if (whatIs(tlhs)!=CONIDCELL) { + ERROR(row) "Illegal left hand side in datatype definition" + EEND; + } + return c; +} + +/* expressions involving a sequence of two or more infix operator symbols + * are parsed as elements of type: + * InfixExpr ::= [Expr] + * | ap(ap(Operator,InfixExpr),Expr) + * + * thus x0 +1 x1 ... +n xn is parsed as: +n (....(+1 [x0] x1)....) xn + * + * Once the expression has been completely parsed, this parsed form is + * `tidied' according to the precedences and associativities declared for + * each operator symbol. + * + * The tidy process uses a `stack' of type: + * TidyStack ::= ap(ap(Operator,TidyStack),Expr) + * | NIL + * when the ith layer of an InfixExpr has been transferred to the stack, the + * stack is of the form: +i (....(+n NIL xn)....) xi + * + * The tidy function is based on a simple shift-reduce parser: + * + * tidy :: InfixExpr -> TidyStack -> Expr + * tidy [m] ss = foldl (\x f-> f x) m ss + * tidy (m*n) [] = tidy m [(*n)] + * tidy (m*n) ((+o):ss) + * | amb = error "Ambiguous" + * | shift = tidy m ((*n):(+o):ss) + * | reduce = tidy (m*(n+o)) ss + * where sye = syntaxOf (*) + * (ae,pe) = sye + * sys = syntaxOf (+) + * (as,ps) = sys + * amb = pe==ps && (ae/=as || ae==NON_ASS) + * shift = pe>ps || (ps==pe && ae==LEFT_ASS) + * reduce = otherwise + * + * N.B. the conditions amb, shift, reduce are NOT mutually exclusive and + * must be tested in that order. + * + * As a concession to efficiency, we lower the number of calls to syntaxOf + * by keeping track of the values of sye, sys throughout the process. The + * value APPLIC is used to indicate that the syntax value is unknown. + */ + +static Cell local tidyInfix(e) /* convert InfixExpr to Expr */ +Cell e; { /* :: InfixExpr */ + Cell s = NIL; /* :: TidyStack */ + Syntax sye = APPLIC; /* Syntax of op in e (init unknown) */ + Syntax sys = APPLIC; /* Syntax of op in s (init unknown) */ + Cell temp; + + while (nonNull(tl(e))) { + if (isNull(s)) { + s = e; + e = arg(fun(s)); + arg(fun(s)) = NIL; + sys = sye; + sye = APPLIC; + } + else { + if (sye==APPLIC) { /* calculate sye (if unknown) */ + sye = syntaxOf(textOf(fun(fun(e)))); + if (sye==APPLIC) sye=DEF_OPSYNTAX; + } + if (sys==APPLIC) { /* calculate sys (if unknown) */ + sys = syntaxOf(textOf(fun(fun(s)))); + if (sys==APPLIC) sys=DEF_OPSYNTAX; + } + + if (precOf(sye)==precOf(sys) && /* amb */ + (assocOf(sye)!=assocOf(sys) || assocOf(sye)==NON_ASS)) { + ERROR(row) "Ambiguous use of operator \"%s\" with \"%s\"", + textToStr(textOf(fun(fun(e)))), + textToStr(textOf(fun(fun(s)))) + EEND; + } + else if (precOf(sye)>precOf(sys) || /* shift */ + (precOf(sye)==precOf(sys) && assocOf(sye)==LEFT_ASS)) { + temp = arg(fun(e)); + arg(fun(e)) = s; + s = e; + e = temp; + sys = sye; + sye = APPLIC; + } + else { /* reduce */ + temp = arg(fun(s)); + arg(fun(s)) = arg(e); + arg(e) = s; + s = temp; + sys = APPLIC; + /* sye unchanged */ + } + } + } + + e = hd(e); + while (nonNull(s)) { + temp = arg(fun(s)); + arg(fun(s)) = e; + e = s; + s = temp; + } + + return e; +} + +/*-------------------------------------------------------------------------*/ +short yyexca[] ={ +-1, 1, + 0, -1, + -2, 0, +-1, 88, + 259, 143, + 44, 143, + -2, 169, +-1, 97, + 285, 75, + -2, 74, +-1, 158, + 285, 75, + -2, 118, +-1, 246, + 264, 19, + -2, 41, +-1, 285, + 96, 78, + 282, 78, + -2, 65, + }; +# define YYNPROD 223 +# define YYLAST 979 +short yyact[]={ + + 19, 6, 22, 95, 335, 364, 97, 327, 117, 358, + 137, 5, 282, 283, 86, 313, 112, 385, 243, 135, + 38, 264, 53, 54, 242, 384, 275, 35, 37, 328, + 214, 72, 64, 220, 88, 87, 44, 70, 230, 218, + 173, 404, 41, 48, 395, 111, 141, 144, 43, 106, + 74, 91, 390, 88, 87, 107, 107, 331, 380, 226, + 225, 148, 261, 103, 326, 195, 37, 368, 103, 302, + 93, 349, 68, 92, 143, 93, 39, 272, 92, 240, + 232, 205, 229, 154, 262, 145, 113, 46, 278, 114, + 158, 158, 160, 299, 269, 88, 87, 155, 381, 387, + 128, 4, 2, 3, 155, 40, 219, 349, 168, 314, + 178, 183, 73, 238, 104, 296, 103, 314, 188, 104, + 332, 292, 191, 103, 226, 290, 193, 98, 197, 273, + 196, 190, 155, 103, 198, 215, 199, 88, 87, 185, + 172, 203, 206, 208, 192, 155, 187, 211, 132, 94, + 186, 258, 56, 210, 131, 152, 224, 52, 58, 295, + 96, 156, 217, 234, 162, 233, 403, 104, 15, 184, + 147, 386, 245, 244, 104, 236, 169, 162, 239, 49, + 248, 249, 142, 23, 104, 235, 382, 402, 10, 383, + 88, 87, 247, 293, 265, 324, 329, 88, 87, 287, + 211, 270, 166, 127, 267, 377, 260, 116, 378, 123, + 379, 90, 103, 176, 361, 245, 182, 324, 376, 136, + 297, 103, 281, 298, 284, 154, 323, 288, 133, 49, + 122, 179, 121, 279, 28, 11, 250, 291, 21, 146, + 202, 312, 268, 47, 157, 157, 159, 294, 311, 209, + 140, 149, 150, 201, 115, 256, 221, 222, 257, 301, + 249, 300, 321, 104, 303, 169, 276, 45, 138, 20, + 304, 305, 104, 47, 88, 87, 237, 245, 316, 206, + 318, 319, 213, 306, 99, 138, 253, 30, 315, 271, + 227, 88, 87, 88, 87, 279, 380, 88, 87, 245, + 101, 350, 340, 347, 341, 101, 102, 336, 31, 265, + 367, 102, 23, 74, 30, 348, 355, 10, 211, 320, + 354, 333, 359, 343, 360, 245, 353, 365, 342, 351, + 352, 344, 99, 330, 31, 284, 216, 369, 338, 284, + 356, 31, 366, 362, 31, 370, 174, 280, 374, 99, + 30, 216, 317, 101, 371, 227, 23, 121, 373, 102, + 101, 153, 375, 28, 11, 322, 102, 21, 134, 31, + 101, 223, 93, 88, 87, 246, 102, 392, 391, 161, + 289, 394, 31, 211, 359, 398, 360, 365, 399, 336, + 396, 401, 400, 397, 189, 23, 63, 165, 20, 139, + 60, 286, 266, 79, 80, 81, 372, 28, 14, 307, + 13, 21, 194, 171, 77, 78, 139, 12, 204, 36, + 31, 24, 25, 26, 27, 310, 30, 83, 99, 84, + 16, 17, 82, 85, 23, 177, 76, 285, 254, 10, + 251, 255, 20, 252, 65, 126, 28, 11, 127, 101, + 21, 46, 42, 124, 89, 102, 125, 309, 101, 8, + 138, 308, 23, 69, 102, 263, 50, 10, 9, 29, + 167, 164, 138, 71, 100, 138, 67, 163, 138, 334, + 231, 20, 228, 66, 151, 28, 11, 181, 180, 21, + 23, 389, 388, 363, 325, 10, 346, 345, 357, 277, + 241, 105, 274, 212, 170, 34, 33, 32, 108, 1, + 0, 0, 0, 28, 11, 0, 23, 21, 0, 138, + 20, 10, 0, 0, 0, 0, 0, 0, 75, 0, + 0, 0, 79, 80, 81, 23, 0, 14, 0, 13, + 10, 28, 11, 77, 78, 21, 12, 138, 20, 31, + 24, 25, 26, 27, 0, 30, 83, 0, 84, 16, + 17, 82, 85, 0, 0, 76, 0, 28, 11, 0, + 0, 21, 23, 175, 0, 0, 20, 10, 0, 0, + 0, 0, 0, 0, 0, 0, 28, 11, 105, 0, + 21, 139, 0, 31, 24, 25, 26, 27, 18, 30, + 23, 0, 20, 139, 17, 10, 139, 0, 0, 139, + 51, 7, 0, 0, 55, 0, 57, 0, 0, 59, + 14, 20, 13, 28, 11, 0, 0, 21, 0, 12, + 0, 61, 31, 24, 25, 26, 27, 62, 30, 23, + 200, 0, 16, 17, 10, 259, 0, 0, 55, 110, + 393, 28, 11, 23, 175, 21, 0, 120, 20, 14, + 0, 13, 0, 0, 0, 0, 129, 130, 12, 0, + 0, 31, 24, 25, 26, 27, 0, 30, 139, 0, + 0, 16, 17, 0, 0, 23, 20, 14, 0, 13, + 28, 11, 0, 23, 21, 0, 12, 0, 10, 31, + 24, 25, 26, 27, 28, 30, 7, 0, 21, 16, + 17, 0, 0, 0, 0, 14, 0, 13, 0, 0, + 0, 0, 0, 0, 12, 20, 0, 31, 24, 25, + 26, 27, 7, 30, 0, 23, 28, 16, 17, 20, + 21, 14, 0, 339, 28, 11, 0, 0, 21, 0, + 12, 337, 0, 31, 24, 25, 26, 27, 0, 30, + 14, 0, 13, 16, 17, 0, 0, 0, 0, 12, + 0, 20, 31, 24, 25, 26, 27, 0, 30, 20, + 0, 0, 16, 17, 0, 0, 28, 0, 7, 0, + 21, 0, 0, 0, 0, 0, 0, 14, 0, 13, + 0, 0, 0, 0, 0, 0, 207, 0, 0, 31, + 24, 25, 26, 27, 0, 30, 7, 0, 0, 16, + 17, 20, 0, 0, 0, 14, 0, 119, 0, 0, + 0, 0, 0, 0, 118, 0, 0, 31, 24, 25, + 26, 27, 0, 30, 0, 0, 0, 16, 17, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 0, 13, 0, 0, 0, + 0, 0, 0, 12, 0, 0, 31, 24, 25, 26, + 27, 0, 30, 0, 0, 0, 16, 17, 0, 0, + 31, 24, 25, 26, 27, 0, 30, 0, 0, 0, + 0, 17, 0, 0, 0, 0, 0, 0, 109, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, + 13, 0, 31, 24, 25, 26, 27, 12, 30, 0, + 31, 24, 25, 26, 27, 0, 30, 0, 0, 0, + 16, 17, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 31, 24, 25, 26, 27, 0, 30 }; +short yypact[]={ + +-155,-1000, 450,-229,-1000,-194,-154,-1000, -9, -9, + 613, 695, 34, 450, 450, 695, 29, 695,-1000, 94, + 695,-1000,-1000, 355,-1000,-1000,-1000,-1000, 450,-1000, +-1000,-1000,-1000, 272,-267,-1000,-1000,-205,-1000, 26, + 93, 653,-1000,-1000,-1000,-1000,-228,-1000, 653, 695, + 645,-1000, 653,-182,-177,-1000, 560,-1000, 695,-1000, + 316, 189, 168,-1000, 412, 404, -9, 695, 695, 61, + 104, 159, 160,-1000,-1000,-1000,-210,-209, 93,-217, +-217,-217, 105, 93, 93, 93, 120, 141, 94,-1000, + 373,-1000,-1000,-1000, 653,-1000,-245,-1000, 83,-1000, +-1000,-1000,-1000, 172, 76, -9, 54, 50,-1000, 450, +-1000, 335,-1000, 450, 21, 353,-1000,-208, 7, 450, +-1000,-1000,-1000,-1000,-1000, 450,-1000, 450, 599, 212, + 199,-1000, 450, 532, 450,-1000, 143,-1000,-1000,-1000, + -10,-1000, 74,-1000,-1000, 101,-246, -9,-1000, -9, + -9, 112,-1000,-1000,-220, 79,-188,-247,-1000,-190, +-1000, 93, 57,-1000,-194,-1000, 450, 52,-1000, 450, +-191, 92, 335, 93, 93,-1000,-1000, 195, 399, 23, + 397, 214,-1000, 58,-1000, 653,-1000,-1000,-1000, 422, +-213,-185, 653,-1000, 560, 450, 653,-182,-1000,-1000, +-1000,-1000,-1000,-170, 157,-1000, 16, 6,-1000,-1000, +-1000,-1000,-270, 226, 64, 93,-1000, 181,-209, 155, +-1000, 155, 155, 93, 57,-1000, 191, 189,-1000, 2, + 93,-1000, -2,-1000,-1000,-1000, 149,-1000, 450, 98, + -8, 179,-1000,-1000,-171,-1000, 221,-1000,-1000,-1000, +-1000,-1000, 93, 28,-1000,-1000,-1000, 93,-1000,-1000, +-1000, 450, 450, 350,-1000, -15,-1000,-1000, 335, 450, + 532, 450, 450, 653,-1000, 222, 64, 185, 151,-1000, + 221,-211, -95,-1000, -39,-1000, 59, -9,-1000,-1000, + 495,-1000, 653, 476, 149, 450, 272,-1000, 92,-1000, + 67,-1000,-1000,-1000,-1000,-1000,-1000, 422,-1000,-194, + -7, 450,-1000,-1000, 653,-213,-1000,-1000,-1000,-1000, + 335, 31, 173,-1000, 64,-1000, 57,-1000, 181, 27, + 93,-227, 181,-1000, 347,-1000,-1000,-1000, 335, 450, +-1000,-1000, 160,-1000, 177, 164, 169,-1000, 133, 14, +-1000,-1000,-1000,-1000,-1000,-165,-213, 145,-1000,-272, +-280,-1000,-1000, 127,-1000,-160,-1000,-1000,-231,-1000, + -95,-1000, 394,-1000,-182,-1000,-1000,-1000, 4,-1000, + 168, 450,-1000, 31, 57, 4, 57, 93, 146, 122, +-1000,-1000,-1000,-1000,-1000,-224,-1000,-1000,-1000,-1000, +-1000,-1000,-1000,-242,-1000 }; +short yypgo[]={ + + 0, 509, 8, 20, 507, 506, 31, 19, 505, 112, + 16, 419, 173, 504, 503, 502, 500, 24, 18, 88, + 499, 498, 9, 0, 2, 497, 496, 14, 182, 6, + 494, 12, 7, 160, 493, 5, 3, 13, 48, 492, + 491, 127, 474, 488, 487, 170, 106, 33, 452, 484, + 155, 161, 482, 480, 479, 45, 4, 1, 477, 471, + 470, 108, 469, 459, 468, 168, 466, 465, 598, 444, + 463, 21, 461, 457, 425, 15, 418, 81, 254, 10, + 207 }; +short yyr1[]={ + + 0, 1, 1, 1, 1, 4, 4, 5, 6, 6, + 6, 6, 6, 8, 8, 11, 11, 9, 9, 12, + 12, 13, 13, 16, 16, 17, 17, 14, 14, 14, + 20, 20, 19, 19, 15, 15, 21, 21, 22, 22, + 18, 18, 18, 18, 18, 25, 25, 26, 26, 9, + 9, 9, 28, 28, 28, 30, 30, 34, 34, 35, + 35, 31, 31, 37, 37, 37, 32, 32, 32, 39, + 39, 40, 40, 36, 36, 33, 29, 29, 29, 41, + 41, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 43, 43, 44, 44, 9, 9, 9, 45, 45, + 46, 46, 47, 47, 47, 48, 48, 38, 38, 9, + 49, 49, 49, 50, 9, 9, 9, 51, 51, 52, + 52, 53, 53, 54, 54, 56, 56, 10, 10, 55, + 55, 58, 58, 58, 59, 59, 3, 60, 60, 61, + 61, 61, 27, 27, 23, 23, 62, 62, 24, 24, + 2, 2, 2, 57, 57, 57, 64, 64, 63, 63, + 63, 63, 63, 63, 66, 66, 65, 65, 65, 68, + 68, 68, 68, 68, 68, 68, 68, 68, 68, 68, + 68, 68, 68, 68, 68, 69, 69, 67, 67, 71, + 72, 72, 73, 73, 73, 74, 74, 75, 70, 70, + 70, 70, 70, 70, 70, 70, 76, 76, 77, 77, + 77, 77, 63, 80, 80, 80, 80, 78, 78, 7, + 7, 79, 79 }; +short yyr2[]={ + + 0, 2, 3, 2, 1, 3, 1, 1, 3, 3, + 1, 1, 1, 2, 1, 7, 2, 4, 2, 1, + 1, 0, 3, 3, 1, 1, 2, 0, 4, 3, + 0, 1, 3, 1, 0, 4, 3, 1, 3, 3, + 1, 1, 4, 4, 4, 3, 1, 0, 1, 5, + 5, 7, 2, 1, 1, 2, 0, 3, 1, 3, + 1, 3, 1, 3, 1, 1, 0, 2, 4, 0, + 1, 3, 1, 3, 1, 1, 1, 3, 1, 2, + 1, 1, 1, 2, 3, 3, 4, 3, 3, 3, + 2, 2, 1, 3, 3, 3, 3, 3, 1, 0, + 3, 1, 1, 1, 1, 1, 3, 1, 3, 4, + 3, 1, 1, 2, 3, 3, 2, 3, 1, 4, + 0, 4, 0, 3, 1, 1, 1, 3, 2, 3, + 1, 2, 1, 1, 2, 1, 4, 2, 1, 4, + 5, 4, 3, 1, 1, 3, 1, 3, 1, 3, + 3, 1, 1, 1, 3, 1, 3, 5, 2, 4, + 6, 6, 6, 1, 2, 1, 2, 2, 1, 1, + 3, 2, 1, 1, 2, 1, 1, 1, 1, 3, + 3, 3, 4, 4, 4, 3, 3, 3, 1, 2, + 2, 1, 1, 2, 1, 2, 1, 4, 0, 1, + 1, 3, 3, 4, 2, 5, 3, 1, 3, 3, + 1, 4, 4, 3, 4, 2, 1, 3, 1, 2, + 1, 1, 1 }; +short yychk[]={ + +-1000, -1, 257, 258, 256, -2, -57, 256, -63, -64, + 45, 92, 274, 267, 265, -65, 287, 288, -68, -23, + 126, 95, -24, 40, 278, 279, 280, 281, 91, -62, + 283, 277, -4, -5, -8, 256, -11, 295, -3, 270, + 259, -47, -48, -38, 45, 276, 96, 282, -47, -65, + -66, -68, 123, -2, -2, -68, 123, -68, 64, -68, + 45, 276, 282, 41, -2, -69, -63, -48, -38, -70, + -2, -69, -6, -9, -10, 256, 293, 271, 272, 260, + 261, 262, 289, 284, 286, 290, -27, -57, -23, -11, + -12, 256, 283, 280, 123, -36, -33, -29, -41, 256, + -42, 277, 283, 40, 91, -63, 277, 283, -63, 263, + -68, -55, -10, 268, 266, -78, -80, -2, 274, 267, + -68, 41, 41, 41, 41, 44, 41, 44, -47, -68, + -68, 93, 44, 124, 264, -7, 59, -79, 125, 256, + -12, 256, -28, 283, 256, -29, -33, -45, 278, -45, + -45, -49, -50, 256, -23, 40, -51, -33, -29, -51, + -29, 259, 44, -58, -59, 256, 61, -60, -61, 124, + -13, 40, -55, 285, 263, -42, 41, 263, -29, -41, + -43, -44, 44, -29, 93, -47, 96, 96, -2, 59, + -7, -2, 123, -79, 59, 273, 123, -2, -2, -2, + 41, 41, 41, -2, -76, -77, -2, 274, -2, -9, + -10, -79, -14, 292, 40, 61, 277, 61, 285, -46, + -47, -46, -46, 259, 44, 280, 45, 276, -52, 270, + 285, -53, 270, -36, -23, -3, -2, -61, 61, -2, + 270, -16, -17, -18, -12, -23, 283, -7, -29, -29, + 41, 41, 44, 263, 41, 44, 41, 44, 93, -63, + -10, 275, 269, -67, -71, -57, -80, -2, -55, 264, + 44, 273, 61, 123, -15, 296, 40, -20, -19, -18, + 283, -29, -31, -37, -29, 256, -28, 44, -36, -50, + 123, -29, 123, 44, -2, 61, 123, 41, 44, 264, + 40, -29, 41, -29, -2, -2, -7, 59, -72, -73, + -74, 263, 256, -75, 124, -7, -2, -77, -2, -2, + -55, 40, -19, 41, 44, -30, 275, -32, 124, 291, + -38, 96, 61, -47, -54, -56, -10, 256, -55, 267, + -2, -2, -6, -17, 264, -25, -26, -24, -27, 40, + -23, -71, -3, -75, -2, -57, -7, -21, -22, -23, + -24, 41, -18, -34, -35, -23, -37, 283, 40, -29, + -31, -7, 59, -7, -2, -7, 41, 41, 44, 41, + 282, 263, 41, 44, 297, 297, 44, 259, -39, -40, + 283, -32, -56, 256, -24, 40, -2, -22, -23, -24, + -35, -36, 41, 44, 283 }; +short yydef[]={ + + 0, -2, 0, 0, 4, 1, 151, 152, 153, 155, + 0, 0, 0, 0, 0, 163, 0, 0, 168, 169, + 0, 172, 173, 0, 175, 176, 177, 178, 198, 144, + 148, 146, 3, 0, 6, 7, 14, 0, 2, 0, + 0, 0, 102, 103, 104, 105, 0, 107, 0, 158, + 0, 165, 0, 0, 0, 166, 0, 167, 0, 171, + 0, 105, 107, 174, 0, 0, 153, 0, 0, 0, + 199, 200, 0, 10, 11, 12, 0, 0, 0, 99, + 99, 99, 0, 0, 0, 0, 0, 0, -2, 13, + 21, 16, 19, 20, 0, 150, 0, -2, 76, 78, + 80, 81, 82, 0, 0, 154, 0, 0, 156, 0, + 164, 0, 130, 0, 0, 0, 218, 216, 0, 0, + 170, 145, 147, 149, 179, 0, 180, 0, 0, 0, + 0, 181, 0, 0, 204, 5, 0, 220, 221, 222, + 27, 18, 0, 53, 54, 75, 0, 0, 98, 0, + 0, 0, 111, 112, 0, 0, 120, 0, -2, 122, + 116, 0, 0, 128, 132, 133, 0, 135, 138, 0, + 0, 0, 0, 0, 0, 79, 83, 0, 0, 76, + 0, 0, 92, 0, 90, 0, 106, 108, 159, 0, + 0, 0, 0, 212, 0, 0, 0, 215, 186, 185, + 182, 183, 184, 186, 201, 207, 210, 0, 202, 8, + 9, 219, 34, 0, 30, 0, 52, 0, 0, 95, + 101, 96, 97, 0, 0, 113, 0, 0, 114, 0, + 0, 115, 0, 127, 142, 131, 134, 137, 0, 0, + 0, 0, 24, 25, 0, 40, -2, 136, 73, 77, + 84, 85, 0, 0, 87, 91, 88, 0, 89, 157, + 129, 0, 0, 0, 188, 0, 217, 213, 0, 203, + 0, 0, 0, 0, 17, 0, 0, 0, 31, 33, + 41, 56, 66, 62, 64, -2, 0, 0, 109, 110, + 0, 117, 0, 0, 0, 0, 0, 22, 0, 26, + 47, 94, 86, 93, 160, 161, 162, 0, 189, 191, + 192, 0, 194, 196, 0, 214, 205, 206, 208, 209, + 0, 0, 0, 29, 0, 49, 0, 50, 0, 0, + 0, 0, 0, 100, 0, 124, 125, 126, 0, 0, + 141, 139, 0, 23, 0, 0, 0, 46, 48, 0, + 143, 187, 190, 195, 193, 0, 211, 0, 37, 0, + 0, 28, 32, 55, 58, 60, 61, 67, 69, 63, + 66, 119, 0, 121, 140, 15, 42, 43, 0, 44, + 0, 0, 35, 0, 0, 0, 0, 0, 0, 70, + 72, 51, 123, 126, 45, 0, 197, 36, 38, 39, + 57, 59, 68, 0, 71 }; +# line 1 "/usr/lib/yaccpar" +#ifndef lint +static char yaccpar_sccsid[] = "@(#)yaccpar 4.1 (Berkeley) 2/11/83"; +#endif not lint + +# define YYFLAG -1000 +# define YYERROR goto yyerrlab +# define YYACCEPT return(0) +# define YYABORT return(1) + +/* parser for yacc output */ + +#ifdef YYDEBUG +int yydebug = 0; /* 1 for debugging */ +#endif +YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +int yychar = -1; /* current input token number */ +int yynerrs = 0; /* number of errors */ +short yyerrflag = 0; /* error recovery flag */ + +yyparse() { + + short yys[YYMAXDEPTH]; + short yyj, yym; + register YYSTYPE *yypvt; + register short yystate, *yyps, yyn; + register YYSTYPE *yypv; + register short *yyxi; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerrflag = 0; + yyps= &yys[-1]; + yypv= &yyv[-1]; + + yystack: /* put a state and value onto the stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); +#endif + if( ++yyps>= &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); } + *yyps = yystate; + ++yypv; + *yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG ) goto yydefault; /* simple state */ + + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; + if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerrflag > 0 ) --yyerrflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) { + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; + /* look through exception table */ + + for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ + + while( *(yyxi+=2) >= 0 ){ + if( *yyxi == yychar ) break; + } + if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerrflag ){ + + case 0: /* brand new error */ + + yyerror( "syntax error" ); + yyerrlab: + ++yynerrs; + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerrflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + YYERRCODE; + if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); +#endif + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + yyabort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery discards char %d\n", yychar ); +#endif + + if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + +#ifdef YYDEBUG + if( yydebug ) printf("reduce %d\n",yyn); +#endif + yyps -= yyr2[yyn]; + yypvt = yypv; + yypv -= yyr2[yyn]; + yyval = yypv[1]; + yym=yyn; + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; + switch(yym){ + +case 1: +# line 86 "doparser.y" +{inputExpr = yypvt[-0]; sp-=1;} break; +case 2: +# line 87 "doparser.y" +{inputExpr = letrec(yypvt[-0],yypvt[-1]); sp-=2;} break; +case 3: +# line 88 "doparser.y" +{valDefns = yypvt[-0]; sp-=1;} break; +case 4: +# line 89 "doparser.y" +{syntaxError("input");} break; +case 5: +# line 102 "doparser.y" +{yyval = gc2(yypvt[-1]);} break; +case 6: +# line 103 "doparser.y" +{yyval = yypvt[-0];} break; +case 7: +# line 105 "doparser.y" +{yyerrok; goOffside(startColumn);} break; +case 8: +# line 107 "doparser.y" +{yyval = gc2(yypvt[-2]);} break; +case 9: +# line 108 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 10: +# line 109 "doparser.y" +{yyval = gc0(NIL);} break; +case 11: +# line 110 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 12: +# line 111 "doparser.y" +{syntaxError("definition");} break; +case 13: +# line 113 "doparser.y" +{yyval = gc2(appendOnto(yypvt[-0],yypvt[-1]));} break; +case 14: +# line 114 "doparser.y" +{yyval = yypvt[-0];} break; +case 15: +# line 117 "doparser.y" +{yyval = gc7(yypvt[-1]);} break; +case 16: +# line 118 "doparser.y" +{syntaxError("module definition");} break; +case 17: +# line 120 "doparser.y" +{sp-=4;} break; +case 18: +# line 121 "doparser.y" +{syntaxError("import declaration");} break; +case 19: +# line 123 "doparser.y" +{yyval = yypvt[-0];} break; +case 20: +# line 124 "doparser.y" +{yyval = yypvt[-0];} break; +case 21: +# line 126 "doparser.y" +{yyval = gc0(NIL);} break; +case 22: +# line 127 "doparser.y" +{yyval = gc3(NIL);} break; +case 23: +# line 129 "doparser.y" +{yyval = gc3(NIL);} break; +case 24: +# line 130 "doparser.y" +{yyval = yypvt[-0];} break; +case 25: +# line 132 "doparser.y" +{yyval = yypvt[-0];} break; +case 26: +# line 133 "doparser.y" +{yyval = gc2(NIL);} break; +case 27: +# line 135 "doparser.y" +{yyval = gc0(NIL);} break; +case 28: +# line 136 "doparser.y" +{yyval = gc4(NIL);} break; +case 29: +# line 137 "doparser.y" +{yyval = gc3(NIL);} break; +case 30: +# line 139 "doparser.y" +{yyval = gc0(NIL);} break; +case 31: +# line 140 "doparser.y" +{yyval = yypvt[-0];} break; +case 32: +# line 142 "doparser.y" +{yyval = gc3(NIL);} break; +case 33: +# line 143 "doparser.y" +{yyval = yypvt[-0];} break; +case 34: +# line 145 "doparser.y" +{yyval = gc0(NIL);} break; +case 35: +# line 146 "doparser.y" +{yyval = gc4(NIL);} break; +case 36: +# line 148 "doparser.y" +{yyval = gc3(NIL);} break; +case 37: +# line 149 "doparser.y" +{yyval = yypvt[-0];} break; +case 38: +# line 151 "doparser.y" +{yyval = gc3(NIL);} break; +case 39: +# line 152 "doparser.y" +{yyval = gc3(NIL);} break; +case 40: +# line 154 "doparser.y" +{yyval = yypvt[-0];} break; +case 41: +# line 155 "doparser.y" +{yyval = yypvt[-0];} break; +case 42: +# line 156 "doparser.y" +{yyval = gc4(NIL);} break; +case 43: +# line 157 "doparser.y" +{yyval = gc4(NIL);} break; +case 44: +# line 158 "doparser.y" +{yyval = gc4(NIL);} break; +case 45: +# line 160 "doparser.y" +{yyval = gc3(NIL);} break; +case 46: +# line 161 "doparser.y" +{yyval = yypvt[-0];} break; +case 47: +# line 163 "doparser.y" +{yyval = gc0(NIL);} break; +case 48: +# line 164 "doparser.y" +{yyval = yypvt[-0];} break; +case 49: +# line 169 "doparser.y" +{defTycon(5,yypvt[-2],yypvt[-3],yypvt[-1],yypvt[-0]);} break; +case 50: +# line 171 "doparser.y" +{defTycon(5,yypvt[-2],checkTyLhs(yypvt[-3]), + rev(yypvt[-1]),DATATYPE);} break; +case 51: +# line 174 "doparser.y" +{defTycon(7,yypvt[-2],yypvt[-3], + ap(QUAL,pair(yypvt[-5],rev(yypvt[-1]))), + DATATYPE);} break; +case 52: +# line 178 "doparser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 53: +# line 179 "doparser.y" +{yyval = yypvt[-0];} break; +case 54: +# line 180 "doparser.y" +{syntaxError("type defn lhs");} break; +case 55: +# line 182 "doparser.y" +{yyval = gc2(yypvt[-0]);} break; +case 56: +# line 183 "doparser.y" +{yyval = gc0(SYNONYM);} break; +case 57: +# line 185 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 58: +# line 186 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 59: +# line 188 "doparser.y" +{yyval = gc3(sigdecl(yypvt[-1],singleton(yypvt[-2]), + yypvt[-0]));} break; +case 60: +# line 190 "doparser.y" +{yyval = yypvt[-0];} break; +case 61: +# line 192 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 62: +# line 193 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 63: +# line 195 "doparser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 64: +# line 196 "doparser.y" +{if (!isCon(getHead(yypvt[-0]))) + syntaxError("data constructor"); + yyval = yypvt[-0];} break; +case 65: +# line 199 "doparser.y" +{syntaxError("data type definition");} break; +case 66: +# line 201 "doparser.y" +{yyval = gc0(NIL);} break; +case 67: +# line 202 "doparser.y" +{yyval = gc2(singleton(yypvt[-0]));} break; +case 68: +# line 203 "doparser.y" +{yyval = gc4(yypvt[-1]);} break; +case 69: +# line 205 "doparser.y" +{yyval = gc0(NIL);} break; +case 70: +# line 206 "doparser.y" +{yyval = yypvt[-0];} break; +case 71: +# line 208 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 72: +# line 209 "doparser.y" +{yyval = gc1(singleton(yypvt[-0]));} break; +case 73: +# line 220 "doparser.y" +{yyval = gc3(ap(QUAL,pair(yypvt[-2],yypvt[-0])));} break; +case 74: +# line 221 "doparser.y" +{yyval = yypvt[-0];} break; +case 75: +# line 223 "doparser.y" +{yyval = gc1(checkContext(yypvt[-0]));} break; +case 76: +# line 225 "doparser.y" +{yyval = yypvt[-0];} break; +case 77: +# line 226 "doparser.y" +{yyval = gc3(ap(ap(ARROW,yypvt[-2]),yypvt[-0]));} break; +case 78: +# line 227 "doparser.y" +{syntaxError("type expression");} break; +case 79: +# line 229 "doparser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 80: +# line 230 "doparser.y" +{yyval = yypvt[-0];} break; +case 81: +# line 232 "doparser.y" +{yyval = yypvt[-0];} break; +case 82: +# line 233 "doparser.y" +{yyval = yypvt[-0];} break; +case 83: +# line 234 "doparser.y" +{yyval = gc2(UNIT);} break; +case 84: +# line 235 "doparser.y" +{yyval = gc3(ARROW);} break; +case 85: +# line 236 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 86: +# line 237 "doparser.y" +{yyval = gc4(ap(ARROW,yypvt[-2]));} break; +case 87: +# line 238 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 88: +# line 239 "doparser.y" +{yyval = gc3(buildTuple(yypvt[-1]));} break; +case 89: +# line 240 "doparser.y" +{yyval = gc3(ap(LIST,yypvt[-1]));} break; +case 90: +# line 241 "doparser.y" +{yyval = gc2(LIST);} break; +case 91: +# line 243 "doparser.y" +{yyval = gc2(mkTuple(tupleOf(yypvt[-1])+1));} break; +case 92: +# line 244 "doparser.y" +{yyval = gc1(mkTuple(2));} break; +case 93: +# line 246 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 94: +# line 247 "doparser.y" +{yyval = gc3(cons(yypvt[-0],cons(yypvt[-2],NIL)));} break; +case 95: +# line 252 "doparser.y" +{fixDefn(LEFT_ASS,yypvt[-2],yypvt[-1],yypvt[-0]); sp-=3;} break; +case 96: +# line 253 "doparser.y" +{fixDefn(RIGHT_ASS,yypvt[-2],yypvt[-1],yypvt[-0]);sp-=3;} break; +case 97: +# line 254 "doparser.y" +{fixDefn(NON_ASS,yypvt[-2],yypvt[-1],yypvt[-0]); sp-=3;} break; +case 98: +# line 256 "doparser.y" +{yyval = gc1(checkPrec(yypvt[-0]));} break; +case 99: +# line 257 "doparser.y" +{yyval = gc0(mkInt(DEF_PREC));} break; +case 100: +# line 259 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 101: +# line 260 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 102: +# line 262 "doparser.y" +{yyval = yypvt[-0];} break; +case 103: +# line 263 "doparser.y" +{yyval = yypvt[-0];} break; +case 104: +# line 264 "doparser.y" +{yyval = gc1(varMinus);} break; +case 105: +# line 266 "doparser.y" +{yyval = yypvt[-0];} break; +case 106: +# line 267 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 107: +# line 269 "doparser.y" +{yyval = yypvt[-0];} break; +case 108: +# line 270 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 109: +# line 275 "doparser.y" +{primDefn(yypvt[-3],yypvt[-2],yypvt[-0]); sp-=4;} break; +case 110: +# line 277 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 111: +# line 278 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 112: +# line 279 "doparser.y" +{syntaxError("primitive defn");} break; +case 113: +# line 281 "doparser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 114: +# line 286 "doparser.y" +{classDefn(intOf(yypvt[-2]),yypvt[-1],yypvt[-0]); sp-=3;} break; +case 115: +# line 287 "doparser.y" +{instDefn(intOf(yypvt[-2]),yypvt[-1],yypvt[-0]); sp-=3;} break; +case 116: +# line 288 "doparser.y" +{sp-=2;} break; +case 117: +# line 290 "doparser.y" +{yyval = gc3(pair(yypvt[-2],checkClass(yypvt[-0])));} break; +case 118: +# line 291 "doparser.y" +{yyval = gc1(pair(NIL,checkClass(yypvt[-0])));} break; +case 119: +# line 293 "doparser.y" +{yyval = gc4(yypvt[-1]);} break; +case 120: +# line 294 "doparser.y" +{yyval = gc0(NIL);} break; +case 121: +# line 296 "doparser.y" +{yyval = gc4(yypvt[-1]);} break; +case 122: +# line 297 "doparser.y" +{yyval = gc0(NIL);} break; +case 123: +# line 299 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 124: +# line 300 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 125: +# line 302 "doparser.y" +{yyval = gc1(yypvt[-0]);} break; +case 126: +# line 303 "doparser.y" +{syntaxError("class body");} break; +case 127: +# line 308 "doparser.y" +{yyval = gc3(sigdecl(yypvt[-1],yypvt[-2],yypvt[-0]));} break; +case 128: +# line 309 "doparser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 129: +# line 311 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 130: +# line 312 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 131: +# line 314 "doparser.y" +{yyval = gc2(letrec(yypvt[-0],yypvt[-1]));} break; +case 132: +# line 315 "doparser.y" +{yyval = yypvt[-0];} break; +case 133: +# line 316 "doparser.y" +{syntaxError("declaration");} break; +case 134: +# line 318 "doparser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 135: +# line 319 "doparser.y" +{yyval = gc1(grded(rev(yypvt[-0])));} break; +case 136: +# line 321 "doparser.y" +{yyval = gc4(yypvt[-1]);} break; +case 137: +# line 323 "doparser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 138: +# line 324 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 139: +# line 326 "doparser.y" +{yyval = gc4(pair(yypvt[-1],pair(yypvt[-2],yypvt[-0])));} break; +case 140: +# line 333 "doparser.y" +{yyval = gc5(pair(yypvt[-4],pair(yypvt[-0],yypvt[-3])));} break; +case 141: +# line 334 "doparser.y" +{yyval = gc4(pair(yypvt[-3],pair(yypvt[-0],yypvt[-2])));} break; +case 142: +# line 336 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 143: +# line 337 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 144: +# line 339 "doparser.y" +{yyval = yypvt[-0];} break; +case 145: +# line 340 "doparser.y" +{yyval = gc3(varMinus);} break; +case 146: +# line 342 "doparser.y" +{yyval = yypvt[-0];} break; +case 147: +# line 343 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 148: +# line 345 "doparser.y" +{yyval = yypvt[-0];} break; +case 149: +# line 346 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 150: +# line 351 "doparser.y" +{yyval = gc3(ap(ESIGN,pair(yypvt[-2],yypvt[-0])));} break; +case 151: +# line 352 "doparser.y" +{yyval = yypvt[-0];} break; +case 152: +# line 353 "doparser.y" +{syntaxError("expression");} break; +case 153: +# line 355 "doparser.y" +{yyval = yypvt[-0];} break; +case 154: +# line 356 "doparser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 155: +# line 357 "doparser.y" +{yyval = gc1(tidyInfix(yypvt[-0]));} break; +case 156: +# line 359 "doparser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 157: +# line 360 "doparser.y" +{yyval = gc5(ap(ap(yypvt[-1], + ap(ap(yypvt[-3],singleton(yypvt[-4])), + yypvt[-2])),yypvt[-0]));} break; +case 158: +# line 364 "doparser.y" +{if (isInt(yypvt[-0])) + yyval = gc2(mkInt(-intOf(yypvt[-0]))); + else + yyval = gc2(ap(varNegate,yypvt[-0])); + } break; +case 159: +# line 369 "doparser.y" +{yyval = gc4(ap(LAMBDA, + pair(rev(yypvt[-2]), + pair(yypvt[-1],yypvt[-0]))));} break; +case 160: +# line 372 "doparser.y" +{yyval = gc6(letrec(yypvt[-3],yypvt[-0]));} break; +case 161: +# line 373 "doparser.y" +{yyval = gc6(ap(COND,triple(yypvt[-4],yypvt[-2],yypvt[-0])));} break; +case 162: +# line 374 "doparser.y" +{yyval = gc6(ap(CASE,pair(yypvt[-4],rev(yypvt[-1]))));} break; +case 163: +# line 375 "doparser.y" +{yyval = yypvt[-0];} break; +case 164: +# line 377 "doparser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 165: +# line 378 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 166: +# line 380 "doparser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 167: +# line 381 "doparser.y" +{yyval = gc2(ap(RUNST,yypvt[-0]));} break; +case 168: +# line 382 "doparser.y" +{yyval = yypvt[-0];} break; +case 169: +# line 384 "doparser.y" +{yyval = yypvt[-0];} break; +case 170: +# line 385 "doparser.y" +{yyval = gc3(ap(ASPAT,pair(yypvt[-2],yypvt[-0])));} break; +case 171: +# line 386 "doparser.y" +{yyval = gc2(ap(LAZYPAT,yypvt[-0]));} break; +case 172: +# line 387 "doparser.y" +{yyval = gc1(WILDCARD);} break; +case 173: +# line 388 "doparser.y" +{yyval = yypvt[-0];} break; +case 174: +# line 389 "doparser.y" +{yyval = gc2(UNIT);} break; +case 175: +# line 390 "doparser.y" +{yyval = yypvt[-0];} break; +case 176: +# line 391 "doparser.y" +{yyval = yypvt[-0];} break; +case 177: +# line 392 "doparser.y" +{yyval = yypvt[-0];} break; +case 178: +# line 393 "doparser.y" +{yyval = yypvt[-0];} break; +case 179: +# line 394 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 180: +# line 395 "doparser.y" +{yyval = gc3(buildTuple(yypvt[-1]));} break; +case 181: +# line 396 "doparser.y" +{yyval = gc3(yypvt[-1]);} break; +case 182: +# line 397 "doparser.y" +{yyval = gc4(ap(yypvt[-1],yypvt[-2]));} break; +case 183: +# line 398 "doparser.y" +{yyval = gc4(ap(ap(varFlip,yypvt[-2]),yypvt[-1]));} break; +case 184: +# line 399 "doparser.y" +{yyval = gc4(ap(ap(varFlip,yypvt[-2]),yypvt[-1]));} break; +case 185: +# line 401 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 186: +# line 402 "doparser.y" +{yyval = gc3(cons(yypvt[-0],cons(yypvt[-2],NIL)));} break; +case 187: +# line 404 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 188: +# line 405 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 189: +# line 407 "doparser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 190: +# line 409 "doparser.y" +{yyval = gc2(letrec(yypvt[-0],yypvt[-1]));} break; +case 191: +# line 410 "doparser.y" +{yyval = yypvt[-0];} break; +case 192: +# line 412 "doparser.y" +{yyval = gc1(grded(rev(yypvt[-0])));} break; +case 193: +# line 413 "doparser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 194: +# line 414 "doparser.y" +{syntaxError("case expression");} break; +case 195: +# line 416 "doparser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 196: +# line 417 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 197: +# line 419 "doparser.y" +{yyval = gc4(pair(yypvt[-1],pair(yypvt[-2],yypvt[-0])));} break; +case 198: +# line 424 "doparser.y" +{yyval = gc0(nameNil);} break; +case 199: +# line 425 "doparser.y" +{yyval = gc1(ap(FINLIST,cons(yypvt[-0],NIL)));} break; +case 200: +# line 426 "doparser.y" +{yyval = gc1(ap(FINLIST,rev(yypvt[-0])));} break; +case 201: +# line 427 "doparser.y" +{yyval = gc3(ap(COMP,pair(yypvt[-2],rev(yypvt[-0]))));} break; +case 202: +# line 428 "doparser.y" +{yyval = gc3(ap(ap(varFromTo,yypvt[-2]),yypvt[-0]));} break; +case 203: +# line 429 "doparser.y" +{yyval = gc4(ap(ap(varFromThen,yypvt[-3]),yypvt[-1]));} break; +case 204: +# line 430 "doparser.y" +{yyval = gc2(ap(varFrom,yypvt[-1]));} break; +case 205: +# line 431 "doparser.y" +{yyval = gc5(ap(ap(ap(varFromThenTo, + yypvt[-4]),yypvt[-2]),yypvt[-0]));} break; +case 206: +# line 434 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 207: +# line 435 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 208: +# line 437 "doparser.y" +{yyval = gc3(ap(FROMQUAL,pair(yypvt[-2],yypvt[-0])));} break; +case 209: +# line 438 "doparser.y" +{yyval = gc3(ap(QWHERE, + singleton( + pair(yypvt[-2],pair(yypvt[-1], + yypvt[-0])))));} break; +case 210: +# line 442 "doparser.y" +{yyval = gc1(ap(BOOLQUAL,yypvt[-0]));} break; +case 211: +# line 443 "doparser.y" +{yyval = gc4(ap(QWHERE,yypvt[-1]));} break; +case 212: +# line 454 "doparser.y" +{yyval = gc4(ap(DOCOMP,checkDo(yypvt[-1])));} break; +case 213: +# line 456 "doparser.y" +{yyval = gc3(ap(FROMQUAL,pair(yypvt[-2],yypvt[-0])));} break; +case 214: +# line 457 "doparser.y" +{yyval = gc4(ap(QWHERE,yypvt[-1]));} break; +case 215: +# line 458 "doparser.y" +{yyval = gc2(ap(BOOLQUAL,yypvt[-0]));} break; +case 216: +# line 459 "doparser.y" +{yyval = gc1(ap(DOQUAL,yypvt[-0]));} break; +case 217: +# line 461 "doparser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 218: +# line 462 "doparser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 219: +# line 469 "doparser.y" +{yyval = gc2(yypvt[-0]);} break; +case 220: +# line 470 "doparser.y" +{yyval = yypvt[-0];} break; +case 221: +# line 472 "doparser.y" +{yyval = yypvt[-0];} break; +case 222: +# line 473 "doparser.y" +{yyerrok; + if (canUnOffside()) { + unOffside(); + /* insert extra token on stack*/ + push(NIL); + pushed(0) = pushed(1); + pushed(1) = mkInt(column); + } + else + syntaxError("definition"); + } break; +# line 148 "/usr/lib/yaccpar" + + } + goto yystack; /* stack new state and value */ + + } diff --git a/src/errors.h b/src/errors.h new file mode 100644 index 0000000..d377efc --- /dev/null +++ b/src/errors.h @@ -0,0 +1,36 @@ +/* -------------------------------------------------------------------------- + * errors.h: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Error handling support functions + * ------------------------------------------------------------------------*/ + +#define errorStream stdout +#define ERROR(l) errHead(l);fprintf(errorStream, +#define EEND ); errFail() +#define ETHEN ); +#define ERRTEXT fprintf(errorStream, +#define ERREXPR(e) printExp(errorStream,e) +#define ERRTYPE(e) printType(errorStream,e) +#define ERRCONTEXT(qs) printContext(errorStream,qs) +#define ERRPRED(pi) printPred(errorStream,pi) +#define ERRKIND(k) printKind(errorStream,k) +#define ERRSIG(sig) printSig(errorStream,sig) + +extern Void errHead Args((Int)); /* in main.c */ +extern Void errFail Args((Void)); +extern Void errAbort Args((Void)); + +extern sigProto(breakHandler); + +extern Bool breakOn Args((Bool)); /* in machdep.c */ + +extern Void printExp Args((FILE *,Cell)); /* in output.c */ +extern Void printType Args((FILE *,Cell)); +extern Void printContext Args((FILE *,List)); +extern Void printPred Args((FILE *,Cell)); +extern Void printKind Args((FILE *,Kind)); +extern Void printSig Args((FILE *,Cell)); + +/*-------------------------------------------------------------------------*/ diff --git a/src/gofc.c b/src/gofc.c new file mode 100644 index 0000000..a7a052a --- /dev/null +++ b/src/gofc.c @@ -0,0 +1,339 @@ +/* -------------------------------------------------------------------------- + * gofc.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer Compiler version 1.01 February 1992 + * Gofer version 2.30 March 1994 + * + * Gofer->C main program + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "command.h" +#include "connect.h" +#include "errors.h" +#include +#include + +#define VERSION "1.03 (2.30b)" + +Bool dumpScs = FALSE; /* TRUE => output sc defns */ + +typedef FILE *Fp; +static Fp gofcFp = 0; /* for output to file */ + +/* -------------------------------------------------------------------------- + * Machine dependent code for Gofer compiler: + * ------------------------------------------------------------------------*/ + +#define MACHDEP_GOFC 1 +#include "machdep.c" + +/* -------------------------------------------------------------------------- + * Shared parts of user interface: + * ------------------------------------------------------------------------*/ + +#include "commonui.c" + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local loadCompile Args((Void)); +static Fp local initOutput Args((String)); +static Void local initialise Args((Int,String [])); + +/* -------------------------------------------------------------------------- + * Gofer entry point: + * ------------------------------------------------------------------------*/ + +Main main Args((Int, String [])); /* now every func has a prototype */ + +Main main(argc,argv) +int argc; +char *argv[]; { + CStackBase = &argc; /* Save stack base for use in gc */ + + /* The startup banner now includes my name. Gofer is provided free of */ + /* charge. I ask however that you show your appreciation for the many */ + /* hours of work involved by retaining my name in the banner. Thanks! */ + + printf("Gofer->C Version %s Copyright (c) Mark P Jones 1992-1995\n\n", + VERSION); + fflush(stdout); + breakOn(TRUE); /* enable break trapping */ + initialise(argc, argv); /* initialise compiler */ + + if (dumpScs) { /* produce script of sc defns for */ + gofcFp = initOutput(".gsc"); /* debugging purposes */ + printf("[Writing supercombinators to \"%s\"]\n",outputFile); + loadCompile(); + fprintf(gofcFp,"\n/* end of %s */\n",outputFile); + fclose(gofcFp); + } + else { /* produce C code as output */ + extern Void outputCode Args((FILE *,Name,String)); + Name mn; + String topLevel = 0; + loadCompile(); + gofcFp = initOutput(".c"); + + mn = findName(findText("main"));/* check for main symbol */ + if (isNull(mn)) { + ERROR(0) "Program must include definition for \"main\" symbol" + EEND; + } + + if (name(mn).defn==CFUN || /* check that definition is ok */ + name(mn).defn==MFUN || + name(mn).primDef || + isNull(name(mn).type)) { + ERROR(0) "Invalid definition for \"main\"" + EEND; + } + +#if IO_DIALOGUE + if (typeMatches(name(mn).type,typeDialogue)) + topLevel = "dialogue"; +#endif +#if IO_MONAD + if (typeMatches(name(mn).type,typeProgIO)) + topLevel = "iomonad"; +#endif + if (topLevel==0) { + ERROR(0) "Illegal typing for \"main\":" ETHEN + ERRTEXT "\n*** inferred type : " ETHEN + ERRTYPE(name(mn).type); +#if IO_DIALOGUE +#if IO_MONAD + ERRTEXT "\n*** does not match : Dialogue or IO ()\n" +#else + ERRTEXT "\n*** does not match : Dialogue\n" +#endif +#else +#if IO_MONAD + ERRTEXT "\n*** does not match : IO ()\n" +#else + ERRTEXT "\n*** no suitable top-level available\n" +#endif +#endif + EEND; + } + + printf("\nWriting C output file \"%s\":\n",outputFile); + outputCode(gofcFp,mn,topLevel); + fclose(gofcFp); + } + + printf("[Leaving Gofer->C]\n"); + everybody(EXIT); + exit(0); + MainDone +} + +static Void local loadCompile() { /* load and compile source modules */ + Module i; + Time timeStamp; + Long fileSize; + + for (i=0; i0) + startNewModule(); + addScript(scriptName[i], fileSize); + numScripts++; + } +} + +/* -------------------------------------------------------------------------- + * Determine name of output file: + * ------------------------------------------------------------------------*/ + +static Fp local initOutput(suff) /* find name for output file, open */ +String suff; { /* it and write header ... */ + Fp fp = 0; + int i; + + if (!outputFile) { /* user specified name has priority*/ + String s,dot; + + if (projectLoaded && currProject) /* use project name if poss*/ + s = currProject; + else + s = scriptName[namesUpto-1]; /* o/w use last script name*/ + + outputFile = malloc(strlen(s)+strlen(suff)+1); + if (!outputFile) + fatal("setOutputName"); + strcpy(outputFile,s); + + for (s=outputFile, dot=0; *s; ++s) /* do something sensible */ + if (*s=='.') /* with file extensions */ + dot = s; + +#if !RISCOS + if (dot && (strcmp(dot+1,"gp") == 0 || strcmp(dot+1,"prj") ==0 || + strcmp(dot+1,"hs") == 0 || strcmp(dot+1,"lhs") ==0 || + strcmp(dot+1,"gs") == 0 || strcmp(dot+1,"lgs") ==0 || + strcmp(dot+1,"gof")== 0 || strcmp(dot+1,"has") ==0 || + strcmp(dot+1,"lit")== 0 || strcmp(dot+1,"verb")==0 || + strcmp(dot+1,"prelude")==0)) + *dot = '\0'; + + strcat(outputFile,suff); +#else + if (dot) { + char *prev = dot; + while (prev>outputFile && *--prev!='.') + ; + if (*prev == '.') + ++prev; + if (namecmp(prev, "gp") || namecmp(prev, "hs") + || namecmp(prev, "gs") || namecmp(prev, "gof") + || namecmp(prev, "lit") || namecmp(prev, "prj") + || namecmp(prev, "lhs") || namecmp(prev, "lgs") + || namecmp(prev, "has") || namecmp(prev, "verb") + || namecmp(prev, "prelude")) { + strcpy(prev, suff+1); + strcat(prev, dot); + } + else { + strcat(outputFile,suff); + outputFile[strlen(outputFile)-strlen(suff)] = '_'; /* No dot */ + } + } + else { + strcat(outputFile,suff); + outputFile[strlen(outputFile)-strlen(suff)] = '_'; /* No dot */ + } +#endif + } + + if (!(fp=fopen(outputFile,"w"))) { /* now try to open */ + ERROR(0) "Unable to open output file \"%s\" for writing", + outputFile + EEND; + } + + fprintf(fp,"/* %s\t\t\t\t%s *\n",outputFile,timeString()); + fprintf(fp," * This program produced by gofc %s from:\n",VERSION); + + if (projectLoaded && currProject) + fprintf(fp," * Project file %s comprising:\n",currProject); + + for (i=0; i1) + fprintf(stderr, + "\nUsing project file, ignoring additional filenames\n"); + loadProject(strCopy(proj)); + } +} + +Void errHead(l) /* print start of error message */ +Int l; { + failed(); /* failed to reach target ... */ + fprintf(errorStream,"ERROR"); + + if (scriptFile) { + fprintf(errorStream," \"%s\"", scriptFile); + if (l) fprintf(errorStream," (line %d)",l); + } + fprintf(errorStream,": "); + fflush(errorStream); +} + +Void errFail() { /* terminate error message */ + fprintf(errorStream,"\nAborting compilation\n"); + fflush(errorStream); + exit(1); +} + +Void errAbort() { /* altern. form of error handling */ + failed(); /* used when suitable error message*/ + errFail(); +} + +Void internal(msg) /* handle internal error */ +String msg; { + fatal(msg); /* treat as fatal condition */ +} + +Void fatal(msg) /* handle fatal error */ +String msg; { + fflush(stdout); + printf("\nINTERNAL ERROR: %s\n",msg); + everybody(EXIT); + exit(1); +} + +sigHandler(breakHandler) { /* respond to break interrupt */ + breakOn(TRUE); + printf("{Interrupted!}\n"); + everybody(BREAK); + fflush(stdout); + errAbort(); + sigResume;/*NOTREACHED*/ +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/gofc.h b/src/gofc.h new file mode 100644 index 0000000..deded10 --- /dev/null +++ b/src/gofc.h @@ -0,0 +1,349 @@ +/* -------------------------------------------------------------------------- + * gofc.h: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer Compiler version 1.00 February 1992 + * Gofer version 2.30 March 1994 + * + * Header file for Gofer Compiler runtime system. + * ------------------------------------------------------------------------*/ + +#include "prelude.h" + +/*- Garbage collected heap ------------------------------------------------*/ + +#define GC_MARKSCAN 0 /* for mark/scan collector */ +#define GC_TWOSPACE 1 /* for twospace collector */ + +typedef Int Cell; /* general cell value */ +typedef Cell far *Heap; /* storage of heap */ +extern Int heapSize; /* Pairs are stored in the */ +extern Void garbageCollect Args((Void)); + +#if HASKELL_ARRAYS +extern Void allocArray Args((Int,Cell,Cell)); +extern Void dupArray Args((Cell)); +#endif + +/*- Mark-scan collector ---------------------------------------------------*/ + +#if GC_MARKSCAN +#ifdef GLOBALfst +register Heap heapTopFst GLOBALfst; /* Cells with -ve indices */ +#else +extern Heap heapTopFst; +#endif +#ifdef GLOBALsnd +register Heap heapTopSnd GLOBALsnd; +#else +extern Heap heapTopSnd; +#endif +#define fst(c) heapTopFst[c] +#define snd(c) heapTopSnd[c] +#define isPair(c) ((c)<0) +extern Cell pair Args((Cell,Cell)); + +#if HASKELL_ARRAYS +typedef Cell ArrEltPtr; +#define arrElt(pa) fst(pa) +#define nextElt(pa) (pa=snd(pa)) +#define arrBnds(arr) fst(snd(arr)) +#define setEltPtr(pa,arr,i) { Int j = i; \ + for (pa=snd(snd(arr)); j>0; --j) \ + nextElt(pa); \ + } +#define arrMap(p,arr) { ArrEltPtr pa = snd(snd(arr)); \ + while (isPair(pa)) { p(pa); nextElt(pa); } \ + } +#endif +#endif + +/*- Two-space collector ---------------------------------------------------*/ + +#if GC_TWOSPACE +#ifdef GLOBALfst +register Heap from GLOBALfst; +#else +extern Heap from; /* top of from space */ +#endif +#ifdef GLOBALsnd +register Cell hp GLOBALsnd; +#else +extern Cell hp; /* last used heap loc */ +#endif +#define fst(c) from[c] +#define snd(c) from[(c)+1] +#define isPair(c) ((c)<0) +#define INLINE_ALLOC 0 /* 1 => allocate inline */ +#if INLINE_ALLOC +#define pair(l,r) ((from[++hp]=(l)), (from[++hp]=(r)), (hp-1)) +#else +extern Cell pair Args((Cell,Cell)); +#endif + +#if HASKELL_ARRAYS +typedef Cell ArrEltPtr; +#define arrElt(pa) from[pa] +#define nextElt(pa) (++pa) +#define arrBnds(arr) from[arr+2] +#define setEltPtr(pa,arr,i) pa=(arr+i+3) +#define arrMap(p,arr) { Int len = from[arr+1]-1; \ + ArrEltPtr pa = arr+3; \ + while (0MAXTAG represent small integers, characters, dictionaries and -- */ +/*- constructor functions -- we don't have to worry which since these ---- */ +/*- routines will only be used with well-typed source programs ----------- */ + +#define SMALLMIN (MAXTAG+2) +#define SMALLMAX MAXPOSINT +#define SMALLZERO (SMALLMIN/2 + SMALLMAX/2) +#define isSmall(c) (SMALLMIN<=(c)) +#define mkSmall(n) (SMALLZERO+(n)) +#define smallOf(c) ((Int)(c-SMALLZERO)) + +#define mkInt(n) (isSmall(mkSmall(n)) ? mkSmall(n) : mkBig(n)) +#define intOf(c) (isSmall(c) ? smallOf(c) : bigOf(c)) + +#define mkChar(c) ((Cell)(SMALLMIN+((unsigned)((c)%NUM_CHARS)))) +#define charOf(c) ((Char)((c)-SMALLMIN)) + +#define mkDict(n) ((Cell)(SMALLMIN+(n))) +#define dictOf(c) ((Int)((c)-SMALLMIN)) + +#define mkCfun(n) ((Cell)(SMALLMIN+(n))) +#define cfunOf(c) ((Int)((c)-SMALLMIN)) +#define FAIL mkCfun(-1) /* Every type has a Fail */ + +/*- Control stack implementation ------------------------------------------*/ + +typedef Cell *StackPtr; /* stack pointer */ +extern Cell cellStack[]; +#ifdef GLOBALsp +register StackPtr sp GLOBALsp; +#else +extern StackPtr sp; +#endif +#define clearStack() sp=cellStack+NUM_STACK +#define stackLoop(i) for (i=cellStack+NUM_STACK-1; i>=sp; i--) +#define push(c) if (sp>cellStack) *--sp=(c); else overflow() +#define onto(c) *--sp=(c) /* fast form of push() */ +#define pop() *sp++ +#define drop() sp++ +#define top() *sp +#define pushed(n) sp[n] +#define pushedSince(p) ((Int)((p)-sp)) +#define offset(n) root[-(n)] + +/*- references to body of compiled code -----------------------------------*/ + +#define ARGCHECK 0 /* set to 1 for no. of argument checking */ +extern int argcheck; /* check for consistency between main */ + /* program and runtime library */ + +extern int num_scs; /* supercombinators */ +extern Cell sc[]; +#if ARGCHECK +typedef Void Super Args((StackPtr)); +#else +typedef Void Super Args((Void)); +#endif +extern Super *scNames[]; + +extern int num_dicts; /* dictionaries */ +extern Cell dict[]; +extern int dictImps[]; +#define dsel(n,d) dict[dictOf(d)+n] + +/*-Super combinator skeleton definition ------------------------------------- + * the following macros are used to construct the heading for a super- + * combinator definition. The combn() family of macros is used for the + * benefit of compilers which do not automatically unroll small loops. + * combinators with >9 args are headed using the comb macro, and a loop is + * always used ... at least in the C code. Adjust according to taste! + * ------------------------------------------------------------------------*/ + +#if ARGCHECK +#define defSc(nm,args) Void nm(root) \ + register StackPtr root; { \ + if (root-sp<=args) \ + insufficientArgs(); \ + root=sp; +#else +#define defSc(nm,args) Void nm() { \ + register StackPtr root=sp; +#endif +#define Arg *root = snd(*(root+1)); root++; +#define needStack(n) if (sp-cellStack0);} +#define comb0(nm) defSc(nm,0) +#define comb1(nm) defSc(nm,1) Arg +#define comb2(nm) defSc(nm,2) Arg Arg +#define comb3(nm) defSc(nm,3) Arg Arg Arg +#define comb4(nm) defSc(nm,4) Arg Arg Arg Arg +#define comb5(nm) defSc(nm,5) Arg Arg Arg Arg Arg +#define comb6(nm) comb(nm,6) +#define comb7(nm) comb(nm,7) +#define comb8(nm) comb(nm,8) +#define comb9(nm) comb(nm,9) + +/*- macros for simple steps in compiled code -------------------------------*/ + +extern Cell whnf; /* head of term in weak head normal form */ +extern Int whnfInt; /* integer value for term in whnf */ + +#define pushInt(n) onto(mkInt(n)) +#define pushFloat(f) onto(safeMkFloat(f)) +#define pushStr(s) onto(mkString(s)) +#define mkap() sp[1]=pair(*sp,sp[1]); sp++ +#define toparg(e) *sp=pair(*sp,e) +#define topfun(e) *sp=pair(e,*sp) +#define pushpair(l,r) onto(pair(l,r)) +#define updap(o,l,r) snd(root[-o])=r; fst(root[-o])=l +#define update(o,c) updap(o,INDIRECT,c) +#define updap2(o) updap(o,*sp,sp[1]); sp+=2 +#define alloc() pushpair(0,0) +#define slide(n,e) pushed(n)=e; sp+=n +#define setstk(n) sp=root-n +#define test(c) if (whnf!=c) +#define inteq(n) if (whnfInt!=n) +#define intge(h,n) if (whnfInt>=n) { \ + heap(h); \ + onto(mkInt(whnfInt-n)); \ + } else +#define intdv(h,n) if (whnfInt>=0 && (whnfInt%n==0)) { \ + heap(h); \ + onto(mkInt(whnfInt/n)); \ + } else +#define ret() sp=root; return + +/* N.B. values in heap() calls are possibly overestimates of storage use + * if INTCELL or FLOATCELL (with BREAK_FLOATS) values are ever allocated. + * If you change the basic allocators used here so that the exact figure + * is required, it will probably be best to make sure that an INTCELL is + * _always_ heap allocated (including the two INTCELLs that make up a + * BREAK_FLOATS FLOATCELL). The alternative is to arrange that any unfilled + * cells are filled in with blanks of an appropriate form. + */ +#if GC_MARKSCAN +#define heap(n) /*do nothing*/ +#endif +#if GC_TWOSPACE +#define heap(n) if (hp+(2*n)>=0) garbageCollect() +#endif + +/*- builtin primitive functions -------------------------------------------*/ + +extern Cell primFatbar, primFail; /* System (internal) primitives */ +extern Cell primUndefMem, primBlackHole; +extern Cell primSel, primIf; +extern Cell primStrict; + +#if HASKELL_ARRAYS +extern Cell primArray, primUpdate; /* Array primitives */ +extern Cell primAccum, primAccumArray; +extern Cell primAmap, primSubscript; +extern Cell primBounds, primElems; +#endif + +extern Cell primPlusInt, primMinusInt;/* User (general) primitives */ +extern Cell primMulInt, primDivInt; +extern Cell primModInt, primRemInt; +extern Cell primNegInt, primQuotInt; +extern Cell primCharToInt, primIntToChar; +extern Cell primIntToFloat; +extern Cell primPlusFloat, primMinusFloat; +extern Cell primMulFloat, primDivFloat; +extern Cell primNegFloat; +extern Cell primEqInt, primLeInt; +extern Cell primEqChar, primLeChar; +extern Cell primEqFloat, primLeFloat; +extern Cell primGenericEq, primGenericNe; +extern Cell primGenericGt, primGenericGe; +extern Cell primGenericLt, primGenericLe; +extern Cell primShowsInt, primShowsFloat; +extern Cell primError; +extern Cell primFopen; + +#if IO_MONAD +extern Cell primSTRun, primSTReturn;/* IO and ST monad primitives */ +extern Cell primIOBind, primSTBind; +extern Cell primSTNew, primSTAssign; +extern Cell primSTDeref, primSTMutVarEq; +extern Cell primIOGetch, primIOPutchar; +#if HASKELL_ARRAYS +extern Cell primSTNewArr, primSTReadArr;/* Monadic array primitives */ +extern Cell primSTWriteArr, primSTFreeze; +#endif +#endif + +#if HAS_FLOATS +extern Cell primSinFloat, primAsinFloat; +extern Cell primCosFloat, primAcosFloat; +extern Cell primTanFloat, primAtanFloat; +extern Cell primAtan2Float, primExpFloat; +extern Cell primLogFloat, primLog10Float; +extern Cell primSqrtFloat, primFloatToInt; +#endif + +/*- runtime support functions and variables -------------------------------*/ + +typedef Void (*TopLevel) Args((Cell)); +extern TopLevel topLevel; +#if IO_DIALOGUE +extern Void dialogue Args((Cell)); +#endif +#if IO_MONAD +extern Void iomonad Args((Cell)); +#endif + +extern Void eval Args((Cell)); +extern Void overflow Args((Void)); +extern Void insufficientArgs Args((Void)); +extern Void fail Args((Void)); +extern Cell rootFst Args((Cell)); +extern Int readTerminalChar Args((Void)); +extern Void noechoTerminal Args((Void)); +extern Void normalTerminal Args((Void)); + +/* ----------------------------------------------------------------------- */ diff --git a/src/gofc.prj b/src/gofc.prj new file mode 100644 index 0000000..0cf02d0 --- /dev/null +++ b/src/gofc.prj @@ -0,0 +1,8 @@ +gofc.c (prelude.h, storage.h, connect.h, errors.h, command.h, machdep.c, commonui.c, output.c) +cmachine.c (prelude.h, storage.h, connect.h, errors.h) +cbuiltin.c (prelude.h, storage.h, connect.h, errors.h, prims.c) +storage.c (prelude.h, storage.h, connect.h, errors.h) +input.c (prelude.h, storage.h, connect.h, errors.h, parser.c, command.h) +static.c (prelude.h, storage.h, connect.h, errors.h) +type.c (prelude.h, storage.h, connect.h, errors.h, preds.c, kind.c, subst.c) +compiler.c (prelude.h, storage.h, connect.h, errors.h) diff --git a/src/gofer.c b/src/gofer.c new file mode 100644 index 0000000..21a4442 --- /dev/null +++ b/src/gofer.c @@ -0,0 +1,771 @@ +/* -------------------------------------------------------------------------- + * gofer.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Command interpreter + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "command.h" +#include "connect.h" +#include "errors.h" +#include +#include + +/* -------------------------------------------------------------------------- + * Machine dependent code for Gofer interpreter: + * ------------------------------------------------------------------------*/ + +#define MACHDEP_GOFER 1 +#include "machdep.c" + +/* -------------------------------------------------------------------------- + * Shared parts of user interface: + * ------------------------------------------------------------------------*/ + +#include "commonui.c" + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local initialise Args((Int,String [])); +static Void local interpreter Args((Int,String [])); +static Void local menu Args((Void)); +static Void local guidance Args((Void)); +static Void local forHelp Args((Void)); +static Void local set Args((Void)); +static Void local changeDir Args((Void)); +static Void local load Args((Void)); +static Void local project Args((Void)); +static Void local readScripts Args((Int)); +static Void local whatFiles Args((Void)); +static Void local editor Args((Void)); +static Void local find Args((Void)); +static Void local runEditor Args((Void)); +static Void local evaluator Args((Void)); +static Void local stopAnyPrinting Args((Void)); +static Void local showtype Args((Void)); +static Void local info Args((Void)); +static Void local describe Args((Text)); +static Void local listNames Args((Void)); + +/* -------------------------------------------------------------------------- + * Local data areas: + * ------------------------------------------------------------------------*/ + +static Time lastChange[NUM_MODULES]; /* Time of last change to file */ +static Bool printing = FALSE; /* TRUE => currently printing value*/ +static Bool addType; /* TRUE => print type with value */ +static Bool showStats = TRUE; /* TRUE => print stats after eval */ +static Bool listFiles = TRUE; /* TRUE => list files after loading*/ + +/* -------------------------------------------------------------------------- + * Gofer entry point: + * ------------------------------------------------------------------------*/ + +Main main Args((Int, String [])); /* now every func has a prototype */ + +Main main(argc,argv) +int argc; +char *argv[]; { + CStackBase = &argc; /* Save stack base for use in gc */ + + /* The startup banner now includes my name. Gofer is provided free of */ + /* charge. I ask however that you show your appreciation for the many */ + /* hours of work involved by retaining my name in the banner. Thanks! */ + + printf("Gofer Version 2.30b Copyright (c) Mark P Jones 1991-1995\n\n"); + fflush(stdout); + interpreter(argc,argv); + printf("[Leaving Gofer]\n"); + everybody(EXIT); + exit(0); + MainDone +} + +/* -------------------------------------------------------------------------- + * Initialisation, interpret command line args and read prelude: + * ------------------------------------------------------------------------*/ + +static Void local initialise(argc,argv)/* interpreter initialisation */ +Int argc; +String argv[]; { + Module i; + String proj = 0; + + setLastEdit((String)0,0); + lastEdit = 0; + scriptFile = 0; + numScripts = 0; + namesUpto = 1; + scriptName[0] = strCopy(fromEnv("GOFER",STD_PRELUDE)); + prompt = strCopy("?"); + repeatStr = strCopy("$$"); + + for (i=1; i1) + fprintf(stderr, + "\nUsing project file, ignoring additional filenames\n"); + loadProject(strCopy(proj)); + } + readScripts(0); +} + +/* -------------------------------------------------------------------------- + * Print Menu of list of commands: + * ------------------------------------------------------------------------*/ + +static struct cmd cmds[] = { + {":?", HELP}, {":type", TYPEOF}, {":load", LOAD}, + {":also", ALSO}, {":reload", RELOAD}, {":project", PROJECT}, + {":edit", EDIT}, {":find", FIND}, {":names", NAMES}, + {":set", SET}, {":quit", QUIT}, {":cd", CHGDIR}, + {":!", SYSTEM}, {":info", INFO}, {":gc", COLLECT}, + {"", EVAL}, + {0,0} +}; + +static Void local menu() { + printf("LIST OF COMMANDS: Any command may be abbreviated to :c where\n"); + printf("c is the first character in the full name.\n\n"); + printf(":load load scripts from specified files\n"); + printf(":load clear all files except prelude\n"); + printf(":also read additional script files\n"); + printf(":reload repeat last load command\n"); + printf(":project use project file\n"); + printf(":edit edit file\n"); + printf(":edit edit last file\n"); + printf(" evaluate expression\n"); + printf(":type print type of expression\n"); + printf(":? display this list of commands\n"); + printf(":set set command line options\n"); + printf(":set help on command line options\n"); + printf(":names [pat] list names currently in scope\n"); + printf(":info describe named objects\n"); + printf(":find edit file containing definition of name\n"); + printf(":!command shell escape\n"); + printf(":cd dir change directory\n"); + printf(":gc force garbage collection\n"); + printf(":quit exit Gofer interpreter\n"); +} + +static Void local guidance() { + printf("Command not recognised. "); + forHelp(); +} + +static Void local forHelp() { + printf("Type :? for help\n"); +} + +/* -------------------------------------------------------------------------- + * Setting of command line options: + * ------------------------------------------------------------------------*/ + +struct options toggle[] = { /* List of command line toggles */ + {'s', "Print no. reductions/cells after eval", &showStats}, + {'t', "Print type after evaluation", &addType}, + {'d', "Show dictionary values in output exprs",&showDicts}, + {'f', "Terminate evaluation on first error", &failOnError}, + {'g', "Print no. cells recovered after gc", &gcMessages}, + {'c', "Test conformality for pattern bindings",&useConformality}, + {'l', "Literate scripts as default", &literateScripts}, + {'e', "Warn about errors in literate scripts", &literateErrors}, + {'i', "Apply fromInteger to integer literals", &coerceNumLiterals}, + {'o', "Optimise use of (&&) and (||)", &andorOptimise}, + {'u', "Catch ambiguously typed top-level vars",&catchAmbigs}, + {'.', "Print dots to show progress", &useDots}, + {'w', "Always show which files loaded", &listFiles}, + {'1', "Overload singleton list notation", &overSingleton}, +#ifdef TECH_TOGGLES + {'a', "Use any evidence, not nec. best", &anyEvidence}, + {'E', "Fail silently if evidence not found", &silentEvFail}, +#endif + {'k', "Show kind errors in full", &kindExpert}, + {0, 0, 0} +}; + +static Void local set() { /* change command line options from*/ + String s; /* Gofer command line */ + + if (s=readFilename()) { + do { + if (s[0]=='+' || s[0]=='-') + processOption(s); + else { + ERROR(0) "Option string must begin with `+' or `-'" + EEND; + } + } while (s=readFilename()); + } + else + optionInfo(); +} + +/* -------------------------------------------------------------------------- + * Change directory command: + * ------------------------------------------------------------------------*/ + +static Void local changeDir() { /* change directory */ + extern int chdir Args((String)); + String s = readFilename(); + if (s && chdir(s)) { + ERROR(0) "Unable to change to directory \"%s\"", s + EEND; + } +} + +/* -------------------------------------------------------------------------- + * Loading and removal of script files: + * ------------------------------------------------------------------------*/ + +static Void local load() { /* read filenames from command line */ + String s; /* and add to list of files waiting */ + /* to be read */ + while (s=readFilename()) + addScriptName(s); + readScripts(1); +} + +static Void local project() { /* read list of file names from */ + String s; /* project file */ + + if ((s=readFilename()) || currProject) { + if (!s) + s = strCopy(currProject); + else if (readFilename()) { + ERROR(0) "Too many project files" + EEND; + } + else + s = strCopy(s); + } + else { + ERROR(0) "No project filename specified" + EEND; + } + loadProject(s); + readScripts(1); +} + +static Void local readScripts(first) /* reread current list of scripts, */ +Int first; { /* loading everything after and */ + Module i; /* including the first script which*/ + Time timeStamp; /* has been either changed or added*/ + Long fileSize; + + for (i=first; i=numScripts) { /* new script file to be read ? */ + timeSet(lastChange[i],timeStamp); + if (i>0) /* no new module for prelude */ + startNewModule(); + addScript(scriptName[i],fileSize); + numScripts++; + } + } + + if (listFiles) + whatFiles(); + if (numScripts<=1) + setLastEdit((String)0, 0); +} + +static Void local whatFiles() { /* list files in current session */ + int i; + printf("\nGofer session for:"); + if (projectLoaded) + printf(" (project: %s)",currProject); + for (i=0; i=0 + && (f=substr("%s",edt))>=0) + if (l0) + printf(", %u garbage collection%s",plural(numberGcs)); + printf(")\n"); +#undef plural + } + fflush(stdout); + } +} + +/* -------------------------------------------------------------------------- + * Print type of input expression: + * ------------------------------------------------------------------------*/ + +static Void local showtype() { /* print type of expression (if any)*/ + Cell type; + + startNewModule(); /* Enables recovery of storage */ + /* allocated during evaluation */ + parseExp(); + checkExp(); + type = typeCheckExp(); + printExp(stdout,inputExpr); + printf(" :: "); + printType(stdout,type); + putchar('\n'); +} + +/* -------------------------------------------------------------------------- + * Enhanced help system: print current list of scripts or give information + * about an object. + * ------------------------------------------------------------------------*/ + +static Void local info() { /* describe objects */ + Int count = 0; /* or give menu of commands */ + String s; + + startNewModule(); /* for recovery of storage */ + for (; s=readFilename(); count++) + describe(findText(s)); + if (count == 0) + whatFiles(); +} + +static Void local describe(t) /* describe an object */ +Text t; { + Tycon tc = findTycon(t); + Class cl = findClass(t); + Name nm = findName(t); + + if (nonNull(tc)) { /* as a type constructor */ + Type t = tc; + Int i; + for (i=0; i"); + break; + } + printf("\n\n"); + } + + if (nonNull(cl)) { /* as a class */ + List ins = class(cl).instances; + if (isPair(class(cl).sig) && fst(class(cl).sig)==STAR + && isNull(snd(class(cl).sig))) + printf("-- type class"); + else { + printf("-- constructor class"); + if (kindExpert) { + printf(" with arity "); + printSig(stdout,class(cl).sig); + } + } + printf("\nclass "); + if (nonNull(class(cl).supers)) { + printContext(stdout,class(cl).supers); + printf(" => "); + } + printPred(stdout,class(cl).head); + if (nonNull(class(cl).members)) { + List ms = class(cl).members; + printf(" where"); + do { + printf("\n "); + printExp(stdout,hd(ms)); + printf(" :: "); + printType(stdout,name(hd(ms)).type); + ms = tl(ms); + } while (nonNull(ms)); + } + putchar('\n'); + if (nonNull(ins)) + printf("\n-- instances:\n"); + for (; nonNull(ins); ins=tl(ins)) { + printf("instance "); + if (nonNull(inst(hd(ins)).specifics)) { + printContext(stdout,inst(hd(ins)).specifics); + printf(" => "); + } + printPred(stdout,inst(hd(ins)).head); + putchar('\n'); + } + putchar('\n'); + } + + if (nonNull(nm)) { /* as a function/name */ + printExp(stdout,nm); + printf(" :: "); + if (nonNull(name(nm).type)) + printType(stdout,name(nm).type); + else + printf(""); + switch (name(nm).defn) { + case MFUN : printf(" -- class member"); + break; + case CFUN : printf(" -- data constructor"); + break; + } + if (name(nm).primDef) + printf(" -- primitive"); + printf("\n\n"); + } + + if (isNull(tc) && isNull(cl) && isNull(nm)) { + printf("Unknown reference `%s'\n",textToStr(t)); + } +} + +/* -------------------------------------------------------------------------- + * List all names currently in scope: + * ------------------------------------------------------------------------*/ + +static Void local listNames() { /* list names matching optional pat*/ + String pat = readFilename(); + List names = NIL; + Int width = getTerminalWidth() - 1; + Int count = 0; + Int termPos; + + if (pat) /* First gather names to list */ + do + names = addNamesMatching(pat,names); + while (pat=readFilename()); + else + names = addNamesMatching((String)0,names); + + if (isNull(names)) { /* Then print them out */ + ERROR(0) "No names selected" + EEND; + } + for (termPos=0; nonNull(names); names=tl(names)) { + String s = textToStr(name(hd(names)).text); + Int l = strlen(s); + if (termPos+1+l>width) { + putchar('\n'); + termPos = 0; + } + else if (termPos>0) { + putchar(' '); + termPos++; + } + printf("%s",s); + termPos += l; + count++; + } + printf("\n(%d names listed)\n", count); +} + +/* -------------------------------------------------------------------------- + * main read-eval-print loop, with error trapping: + * ------------------------------------------------------------------------*/ + +static jmp_buf catch_error; /* jump buffer for error trapping */ + +#ifdef WANT_TIMER +#include "timer.c" +#endif + +static Void local interpreter(argc,argv)/* main interpreter loop */ +Int argc; +String argv[]; { + Int errorNumber = setjmp(catch_error); + + breakOn(TRUE); /* enable break trapping */ + if (numScripts==0) { /* only succeeds on first time, */ + if (errorNumber) /* before prelude has been loaded */ + fatal("Unable to load prelude"); + initialise(argc,argv); + forHelp(); + } + + for (;;) { + everybody(RESET); /* reset to sensible initial state */ + dropModulesFrom(numScripts-1); /* remove partially loaded scripts */ + /* not counting prelude as a module*/ + consoleInput(prompt); +#ifdef WANT_TIMER + updateTimers(); +#endif + switch (readCommand(cmds, (Char)':', (Char)'!')) { + case EDIT : editor(); + break; + case FIND : find(); + break; + case LOAD : clearProject(); + forgetScriptsFrom(1); + load(); + break; + case ALSO : clearProject(); + forgetScriptsFrom(numScripts); + load(); + break; + case RELOAD : readScripts(1); + break; + case PROJECT: project(); + break; + case EVAL : evaluator(); + break; + case TYPEOF : showtype(); + break; + case NAMES : listNames(); + break; + case HELP : menu(); + break; + case BADCMD : guidance(); + break; + case SET : set(); + break; + case SYSTEM : shellEsc(readLine()); + break; + case CHGDIR : changeDir(); + break; + case INFO : info(); + break; + case QUIT : return; + case COLLECT: garbageCollect(); + printf("Garbage collection recovered %d cells\n", + cellsRecovered); + break; + case NOCMD : break; + } +#ifdef WANT_TIMER + updateTimers(); + printf("Elapsed time (ms): %ld (user), %ld (system)\n", + millisecs(userElapsed), millisecs(systElapsed)); +#endif + } +} + +Void errHead(l) /* print start of error message */ +Int l; { + failed(); /* failed to reach target ... */ + stopAnyPrinting(); + fprintf(errorStream,"ERROR"); + + if (scriptFile) { + fprintf(errorStream," \"%s\"", scriptFile); + setLastEdit(scriptFile,l); + if (l) fprintf(errorStream," (line %d)",l); + scriptFile = 0; + } + fprintf(errorStream,": "); + fflush(errorStream); +} + +Void errFail() { /* terminate error message and */ + putc('\n',errorStream); /* produce exception to return to */ + fflush(errorStream); /* main command loop */ + longjmp(catch_error,1); +} + +Void errAbort() { /* altern. form of error handling */ + failed(); /* used when suitable error message*/ + stopAnyPrinting(); /* has already been printed */ + errFail(); +} + +Void internal(msg) /* handle internal error */ +String msg; { + failed(); + stopAnyPrinting(); + fprintf(errorStream,"INTERNAL ERROR: %s\n",msg); + fflush(errorStream); + longjmp(catch_error,1); +} + +Void fatal(msg) /* handle fatal error */ +String msg; { + fflush(stdout); + printf("\nFATAL ERROR: %s\n",msg); + everybody(EXIT); + exit(1); +} + +sigHandler(breakHandler) { /* respond to break interrupt */ + breakOn(TRUE); + printf("{Interrupted!}\n"); + everybody(BREAK); + failed(); + stopAnyPrinting(); + fflush(stdout); + longjmp(catch_error,1); + sigResume;/*NOTREACHED*/ +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/gofer.prj b/src/gofer.prj new file mode 100644 index 0000000..819c094 --- /dev/null +++ b/src/gofer.prj @@ -0,0 +1,9 @@ +gofer.c (prelude.h, storage.h, connect.h, errors.h, command.h, machdep.c, commonui.c) +machine.c (prelude.h, storage.h, connect.h, errors.h) +builtin.c (prelude.h, storage.h, connect.h, errors.h, prims.c) +storage.c (prelude.h, storage.h, connect.h, errors.h) +input.c (prelude.h, storage.h, connect.h, errors.h, parser.c, command.h) +static.c (prelude.h, storage.h, connect.h, errors.h) +type.c (prelude.h, storage.h, connect.h, errors.h, preds.c, kind.c, subst.c) +output.c (prelude.h, storage.h, connect.h, errors.h) +compiler.c (prelude.h, storage.h, connect.h, errors.h) diff --git a/src/goferite.h b/src/goferite.h new file mode 100644 index 0000000..fba63d8 --- /dev/null +++ b/src/goferite.h @@ -0,0 +1,33 @@ +/* __________ __________ __________ __________ ________ + * / _______/ / ____ / / _______/ / _______/ / ____ \ + * / / _____ / / / / / /______ / /______ / /___/ / + * / / /_ / / / / / / _______/ / _______/ / __ __/ + * / /___/ / / /___/ / / / / /______ / / \ \ + * /_________/ /_________/ /__/ /_________/ /__/ \__\ + * + * Functional programming environment, Version 2.30 + * + * Copyright Mark P Jones 1991-1994 + * + * CONDITIONS OF USE, DUPLICATION AND DISTRIBUTION + * ----------------------------------------------------------------------- + * Permission to use, copy, modify, and distribute this software and its + * documentation for any personal or educational use without fee is hereby + * granted, provided that: + * a) This copyright notice is retained in both source code and + * supporting documentation. + * b) Modified versions of this software are redistributed only if + * accompanied by a complete history (date, author, description) of + * modifications made; the intention here is to give appropriate + * credit to those involved, whilst simultaneously ensuring that any + * recipient can determine the origin of the software. + * c) The same conditions are also applied to any software system + * derived either in full or in part from Gofer. + * + * The name "Gofer" is not a trademark, registered or otherwise, and you + * are free to mention this name in published material, public and private + * correspondence, or other documents without restriction or obligation. + * + * Gofer is provided "as is" without express or implied warranty. + * ----------------------------------------------------------------------- + */ diff --git a/src/gofsplit.c b/src/gofsplit.c new file mode 100644 index 0000000..b4df18e --- /dev/null +++ b/src/gofsplit.c @@ -0,0 +1,91 @@ +/*----------------------------------------------------------------------------- + * gofsplit.c This program can be used to split the C code output produced + * by the Gofer compiler into a number of smaller C files, each + * of which can be compiled separately before linking to obtain + * the final executable program. + * + * Why bother? Some C compilers seem to die on really large + * input files, even if the function definitions themselves are + * reasonably sized. Perhaps they try to do some fancy global + * optimization/data flow analysis...? + * + * For example: gofc + project -- produces project.c as output + * gofsplit project.c part .c -- produces part00.c, part01.c,... + * cc -O -c part00.c ... -- compile individual files + * cc -o project part00.o ... -- link to produce executable + * program + *---------------------------------------------------------------------------*/ + +#include + +#define LONGLINE 1024 +char theLine[LONGLINE+1]; +int foundEof=0; + +FILE *newPart(prefix,partNo,suffix) +char *prefix; +int partNo; +char *suffix; { + static char outputFile[256]; + FILE *tmp; + sprintf(outputFile,"%s%02d%s",prefix,partNo,suffix); + tmp = fopen(outputFile,"w"); + if (!tmp) { + fprintf(stderr,"Can't write %s\n",outputFile); + exit(1); + } + printf("Writing %s\n",outputFile); + if (partNo>0) + fprintf(tmp,"#include \"gofc.h\"\n\n"); + return tmp; +} + +int readLine(fp) +FILE *fp; { + int c; + int i = 0; + if (!foundEof) { + while ((c=fgetc(fp))!=EOF && c!='\n') + theLine[i++] = c; + if (c==EOF) + foundEof = 1; + else + theLine[i++] = c; + theLine[i] = '\0'; + } + return foundEof; +} + +main(argc,argv) +int argc; +char *argv[]; { + if (argc!=4) + fprintf(stderr,"usage: gofsplit inputfile prefix suffix\n"); + else { + char *inputFile = argv[1]; + char *prefix = argv[2]; + char *suffix = argv[3]; + int partCount = 0; + FILE *ifile; + FILE *ofile; + + ifile = fopen(inputFile,"r"); + if (!ifile) + fprintf(stderr,"Can't read %s\n",inputFile); + else { + do { + FILE *ofile=newPart(prefix,partCount++,suffix); + int linecount=0; + do { + if (readLine(ifile)) + break; + linecount++; + fprintf(ofile,"%s",theLine); + } while (linecount<3000 || strcmp(theLine,"End\n")!=0); + fclose(ofile); + } while (!foundEof); + fclose(ifile); + } + } +} + diff --git a/src/input.c b/src/input.c new file mode 100644 index 0000000..b6071a5 --- /dev/null +++ b/src/input.c @@ -0,0 +1,1267 @@ +/* -------------------------------------------------------------------------- + * input.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Input functions, lexical analysis parsing etc... + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "command.h" +#include "errors.h" +#include + +/* -------------------------------------------------------------------------- + * Global data: + * ------------------------------------------------------------------------*/ + +List tyconDefns = NIL; /* type constructor definitions */ +List typeInDefns = NIL; /* type synonym restrictions */ +List valDefns = NIL; /* value definitions in script */ +List opDefns = NIL; /* operator defns in script */ +List classDefns = NIL; /* class defns in script */ +List instDefns = NIL; /* instance defns in script */ +List overDefns = NIL; /* overloaded implementation names */ +List primDefns = NIL; /* primitive definitions */ + +Cell inputExpr = NIL; /* input expression */ +Bool literateScripts = FALSE; /* TRUE => default to lit scripts */ +Bool literateErrors = TRUE; /* TRUE => report errs in lit scrs */ + +String repeatStr = 0; /* Repeat last expr */ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local fileInput Args((String,Long)); +static Bool local literateMode Args((String)); +static Void local skip Args((Void)); +static Void local thisLineIs Args((Int)); +static Void local newlineSkip Args((Void)); +static Void local closeAnyInput Args((Void)); + + Int yyparse Args((Void)); /* can't stop yacc making this */ + /* public, but don't advertise */ + /* it in a header file. */ + +static Void local endToken Args((Void)); +static Text local readOperator Args((Void)); +static Text local readIdent Args((Void)); +static Cell local readNumber Args((Void)); +static Cell local readChar Args((Void)); +static Cell local readString Args((Void)); +static Void local saveStrChr Args((Char)); +static Cell local readAChar Args((Bool)); + +static Bool local lazyReadMatches Args((String)); +static Cell local readEscapeChar Args((Bool)); +static Void local skipGap Args((Void)); +static Cell local readCtrlChar Args((Void)); +static Cell local readOctChar Args((Void)); +static Int local readOctDigit Args((Void)); +static Cell local readHexChar Args((Void)); +static Int local readHexDigit Args((Void)); +static Cell local readDecChar Args((Void)); + +static Void local goOffside Args((Int)); +static Void local unOffside Args((Void)); +static Bool local canUnOffside Args((Void)); + +static Void local skipWhitespace Args((Void)); +static Int local yylex Args((Void)); +static Int local repeatLast Args((Void)); + +static Void local parseInput Args((Int)); + +/* -------------------------------------------------------------------------- + * Text values for reserved words and special symbols: + * ------------------------------------------------------------------------*/ + +static Text textCase, textOfK, textData, textType, textIf; +static Text textThen, textElse, textWhere, textLet, textIn; +static Text textInfix, textInfixl, textInfixr, textPrim; + +static Text textCoco, textEq, textUpto, textAs, textLambda; +static Text textBar, textMinus, textFrom, textArrow, textLazy; + +static Text textClass, textImplies,textInstance; + +static Text textDefault, textDeriving, textHiding, textInterface; +static Text textImport, textModule, textTo, textRenaming; + +#if IO_MONAD +static Text textRunST; +#endif + +#if DO_COMPS +static Text textDo; +#endif + +static Cell varMinus; /* (-) */ +static Cell varNegate; /* negate */ +static Cell varFlip; /* flip */ +static Cell varFrom; /* [_..] */ +static Cell varFromTo; /* [_.._] */ +static Cell varFromThen; /* [_,_..] */ +static Cell varFromThenTo; /* [_,_.._] */ + +Text textPlus; /* (+) */ +Text textMult; /* (*) */ + +/* -------------------------------------------------------------------------- + * Single character input routines: + * + * At the lowest level of input, characters are read one at a time, with the + * current character held in c0 and the following (lookahead) character in + * c1. The corrdinates of c0 within the file are held in (column,row). + * The input stream is advanced by one character using the skip() function. + * ------------------------------------------------------------------------*/ + +#define TABSIZE 8 /* spacing between tabstops */ + +#define NOTHING 0 /* what kind of input is being read?*/ +#define KEYBOARD 1 /* - keyboard/console? */ +#define SCRIPTFILE 2 /* - script file */ +#define PROJFILE 3 /* - project file */ + +static Int reading = NOTHING; + +static Target readSoFar; +static Int row, column, startColumn; +static int c0, c1; +static FILE *inputStream; +static Bool thisLiterate; + +#if USE_READLINE /* for command line editors */ +static String currentLine; /* editline or GNU readline */ +static String nextChar; +#define nextConsoleChar() (*nextChar=='\0' ? '\n' : *nextChar++) +extern Void add_history Args((String)); +extern String readline Args((String)); + +#define PROMPTMAX 20 /* max chars in a sensible prompt */ +static String addSpace(str) /* add trailing space to prompt */ +String str; { + static char promptBuf[PROMPTMAX+2]; + if (strlen(str)>PROMPTMAX) + return str; + strcpy(promptBuf,str); + strcat(promptBuf," "); + return promptBuf; +} +#else +#define nextConsoleChar() getc(stdin) +#endif + +static Int litLines; /* count defn lines in lit script */ +#define DEFNCHAR '>' /* definition lines begin with this */ +static Int lastLine; /* records type of last line read: */ +#define STARTLINE 0 /* - at start of file, none read */ +#define BLANKLINE 1 /* - blank (may preceed definition) */ +#define TEXTLINE 2 /* - text comment */ +#define DEFNLINE 3 /* - line containing definition */ + +Void consoleInput(prompt) /* prepare to input characters from*/ +String prompt; { /* standard in (i.e. console/kbd) */ + reading = KEYBOARD; /* keyboard input is Line oriented,*/ + c0 = /* i.e. input terminated by '\n' */ + c1 = ' '; + column = (-1); + row = 0; + +#if USE_READLINE + if (currentLine) + free(currentLine); + currentLine = readline(addSpace(prompt)); + nextChar = currentLine; + if (currentLine) { + if (*currentLine) + add_history(currentLine); + } + else + c0 = c1 = EOF; +#else + printf("%s ",prompt); + fflush(stdout); +#endif +} + +Void projInput(nm) /* prepare to input characters from */ +String nm; { /* from named project file */ + if (inputStream = fopen(nm,"r")) { + reading = PROJFILE; + c0 = ' '; + c1 = '\n'; + column = 1; + row = 0; + } + else { + ERROR(0) "Unable to open project file \"%s\"", nm + EEND; + } +} + +static Void local fileInput(nm,len) /* prepare to input characters from*/ +String nm; /* named file (specified length is */ +Long len; { /* used to set target for reading) */ + if (inputStream = fopen(nm,"r")) { + reading = SCRIPTFILE; + c0 = ' '; + c1 = '\n'; + column = 1; + row = 0; + readSoFar = 0; + lastLine = STARTLINE; + litLines = 0; + thisLiterate = literateMode(nm); + setGoal("Parsing", (Target)len); + } + else { + ERROR(0) "Unable to open file" + EEND; + } +} + +static Bool local literateMode(nm) /* selecte literate mode for file */ +String nm; { + String dot = 0; + +#if !RISCOS + for (; *nm; ++nm) /* look for last dot in file name */ + if (*nm == '.') + dot = nm+1; + + if (dot) { + if (strcmp(dot,"hs")==0 || /* .hs, .gs, .has, .gof files are */ + strcmp(dot,"gs")==0 || /* never literate scripts */ + strcmp(dot,"gof")==0 || + strcmp(dot,"has")==0 || + strcmp(dot,"prelude")==0) /* special suffix for prelude files*/ + return FALSE; + + if (strcmp(dot,"lhs")==0 || /* .lhs, .lgs, .verb, .lit scripts */ + strcmp(dot,"lgs")==0 || /* are always literate scripts */ + strcmp(dot,"verb")==0 || + strcmp(dot,"lit")==0) + return TRUE; + } +#else + char *start = nm; + for (; *nm; ++nm) /* look for last dot in file name */ + if (*nm == '.') + dot = nm+1; + if (dot) { + char *prev = dot-1; + while (prev > start && *--prev != '.') + ; + if (*prev == '.') + ++prev; + if (namecmp(prev,"hs") || namecmp(prev,"gs") + || namecmp(prev,"gof") || namecmp(prev,"has") + || namecmp(prev,"prelude")) + return FALSE; + if (namecmp(prev,"lhs") || namecmp(prev,"lgs") + || namecmp(prev,"lit") || namecmp(prev,"verb")) + return TRUE; + } +#endif + return literateScripts; /* otherwise, use the default */ +} + +static Void local skip() { /* move forward one char in input */ + if (c0!=EOF) { /* stream, updating c0, c1, ... */ + if (c0=='\n') { /* Adjusting cursor coords as nec. */ + row++; + column=1; + if (reading==SCRIPTFILE) + soFar(readSoFar); + } + else if (c0=='\t') + column += TABSIZE - ((column-1)%TABSIZE); + else + column++; + + c0 = c1; + readSoFar++; + + if (c0==EOF) { + column = 0; + if (reading==SCRIPTFILE) + done(); + closeAnyInput(); + } + else if (reading==KEYBOARD) { + if (c0=='\n') + c1 = EOF; + else + c1 = nextConsoleChar(); + } + else + c1 = getc(inputStream); + } +} + +static Void local thisLineIs(kind) /* register kind of current line */ +Int kind; { /* & check for literate script errs*/ + if (literateErrors && ((kind==DEFNLINE && lastLine==TEXTLINE) || + (kind==TEXTLINE && lastLine==DEFNLINE))) { + ERROR(row) "Program line next to comment" + EEND; + } + lastLine = kind; +} + +static Void local newlineSkip() { /* skip `\n' (supports lit scripts) */ + if (reading==SCRIPTFILE && thisLiterate) { + do { + skip(); + if (c0==DEFNCHAR) { /* pass chars on definition lines */ + thisLineIs(DEFNLINE); /* to lexer (w/o leading DEFNCHAR) */ + skip(); + litLines++; + return; + } + while (c0==' ' || c0=='\t')/* maybe line is blank? */ + skip(); + if (c0=='\n' || c0==EOF) + thisLineIs(BLANKLINE); + else { + thisLineIs(TEXTLINE); /* otherwise it must be a comment */ + while (c0!='\n' && c0!=EOF) + skip(); + } /* by now, c0=='\n' or c0==EOF */ + } while (c0!=EOF); /* if new line, start again */ + + if (litLines==0 && literateErrors) { + ERROR(row) "Empty script - perhaps you forgot the `%c's?", + DEFNCHAR + EEND; + } + return; + } + skip(); +} + +static Void local closeAnyInput() { /* close input stream, if open */ + if (reading==SCRIPTFILE || reading==PROJFILE) + fclose(inputStream); + else if (reading==KEYBOARD) /* or skip to end of console line */ + while (c0!=EOF) + skip(); + reading=NOTHING; +} + +/* -------------------------------------------------------------------------- + * Parser: Uses table driven parser generated from parser.y using yacc + * ------------------------------------------------------------------------*/ + +#include "parser.c" + +/* -------------------------------------------------------------------------- + * Single token input routines: + * + * The following routines read the values of particular kinds of token given + * that the first character of the token has already been located in c0 on + * entry to the routine. + * ------------------------------------------------------------------------*/ + +#define MAX_TOKEN 250 +#define startToken() tokPos = 0 +#define saveTokenChar(c) if (tokPos?@\\^|-" /* For Haskell 1.1: `-' */ +#define PRESYMBOLS "~" /* should be a PRESYMBOL*/ + /* but including it here*/ + /* means we loose eg <- */ +#define isoneof(c,cs) (strchr(cs,c)!=(char *)0) +#define overflows(n,b,d,m) (n > ((m)-(d))/(b)) + +static char tokenStr[MAX_TOKEN+1]; /* token buffer */ +static Int tokPos; /* input position in buffer */ +static Int identType; /* identifier type: CONID / VARID */ +static Int opType; /* operator type : CONOP / VAROP */ + +static Void local endToken() { /* check for token overflow */ + if (tokPos>MAX_TOKEN) { + ERROR(row) "Maximum token length (%d) exceeded", MAX_TOKEN + EEND; + } + tokenStr[tokPos] = '\0'; +} + +static Text local readOperator() { /* read operator symbol */ + startToken(); + do { + saveTokenChar(c0); + skip(); + } while (c0!=EOF && isascii(c0) && isoneof(c0,SYMBOLS)); + opType = (tokenStr[0]==':' ? CONOP : VAROP); + endToken(); + return findText(tokenStr); +} + +static Text local readIdent() { /* read identifier */ + startToken(); + do { + saveTokenChar(c0); + skip(); + } while ((c0!=EOF && isascii(c0) && isalnum(c0)) || c0=='_' || c0=='\''); + endToken(); + identType = isupper(tokenStr[0]) ? CONID : VARID; + return findText(tokenStr); +} + +static Cell local readNumber() { /* read numeric constant */ + Int n = 0; + Bool intTooLarge = FALSE; + + startToken(); + do { + if (overflows(n,10,(c0-'0'),MAXPOSINT)) + intTooLarge = TRUE; + n = 10*n + (c0-'0'); + saveTokenChar(c0); + skip(); + } while (c0!=EOF && isascii(c0) && isdigit(c0)); + + if (c0!='.' || !isascii(c1) || !isdigit(c1)) { + endToken(); + if (!intTooLarge) + return mkInt(n); +#if 0 + if (intTooLarge) + return mkFloat(stringToFloat(tokenStr)); +#endif + ERROR(row) "Integer literal out of range" + EEND; + } + + saveTokenChar(c0); /* save decimal point */ + skip(); + do { /* process fractional part ... */ + saveTokenChar(c0); + skip(); + } while (c0!=EOF && isascii(c0) && isdigit(c0)); + + if (c0=='e' || c0=='E') { /* look for exponent part... */ + saveTokenChar('e'); + skip(); + if (c0=='-') { + saveTokenChar('-'); + skip(); + } + else if (c0=='+') + skip(); + + if (!isascii(c0) || !isdigit(c0)) { + ERROR(row) "Missing digits in exponent" + EEND; + } + else { + do { + saveTokenChar(c0); + skip(); + } while (c0!=EOF && isascii(c0) && isdigit(c0)); + } + } + + endToken(); +#if !HAS_FLOATS + ERROR(row) "No floating point numbers in this implementation" + EEND; +#endif + + return mkFloat(stringToFloat(tokenStr)); +} + +static Cell local readChar() { /* read character constant */ + Cell charRead; + + skip(/* '\'' */); + if (c0=='\'' || c0=='\n' || c0==EOF) { + ERROR(row) "Illegal character constant" + EEND; + } + + charRead = readAChar(FALSE); + + if (c0=='\'') + skip(/* '\'' */); + else { + ERROR(row) "Improperly terminated character constant" + EEND; + } + return charRead; +} + +static Cell local readString() { /* read string literal */ + Cell c; + + startToken(); + skip(/* '\"' */); + while (c0!='\"' && c0!='\n' && c0!=EOF) { + c = readAChar(TRUE); + if (nonNull(c)) + saveStrChr(charOf(c)); + } + + if (c0=='\"') + skip(/* '\"' */); + else { + ERROR(row) "improperly terminated string" + EEND; + } + endToken(); + return mkStr(findText(tokenStr)); +} + +static Void local saveStrChr(c) /* save character in string */ +Char c; { + if (c!='\0' && c!='\\') { /* save non null char as single char*/ + saveTokenChar(c); + } + else { /* save null char as TWO null chars */ + if (tokPos+1 enable use of \& and gaps*/ + Cell c = mkChar(c0); + + if (c0=='\\') /* escape character? */ + return readEscapeChar(allowEmpty); + if (!isprint(c0)) { + ERROR(row) "Non printable character '\\%d' in constant", ((int)c0) + EEND; + } + skip(); /* normal character? */ + return c; +} + +/* -------------------------------------------------------------------------- + * Character escape code sequences: + * ------------------------------------------------------------------------*/ + +static struct { /* table of special escape codes */ + char *codename; + int codenumber; +} escapes[] = { + {"a", 7}, {"b", 8}, {"f", 12}, {"n", 10}, /* common escapes */ + {"r", 13}, {"t", 9}, {"\\",'\\'}, {"\"",'\"'}, + {"\'",'\''}, {"v", 11}, + {"NUL", 0}, {"SOH", 1}, {"STX", 2}, {"ETX", 3}, /* ascii codenames */ + {"EOT", 4}, {"ENQ", 5}, {"ACK", 6}, {"BEL", 7}, + {"BS", 8}, {"HT", 9}, {"LF", 10}, {"VT", 11}, + {"FF", 12}, {"CR", 13}, {"SO", 14}, {"SI", 15}, + {"DLE", 16}, {"DC1", 17}, {"DC2", 18}, {"DC3", 19}, + {"DC4", 20}, {"NAK", 21}, {"SYN", 22}, {"ETB", 23}, + {"CAN", 24}, {"EM", 25}, {"SUB", 26}, {"ESC", 27}, + {"FS", 28}, {"GS", 29}, {"RS", 30}, {"US", 31}, + {"SP", 32}, {"DEL", 127}, + {0,0} +}; + +static Int alreadyMatched; /* Record portion of input stream */ +static char alreadyRead[10]; /* that has been read w/o a match */ + +static Bool local lazyReadMatches(s) /* compare input stream with string */ +String s; { /* possibly using characters that */ + int i; /* have already been read */ + + for (i=0; i=0); + + return mkChar(n); +} + +static Int local readOctDigit() { /* read single octal digit */ + if ('0'<=c0 && c0<='7') + return c0-'0'; + return -1; +} + +static Cell local readHexChar() { /* read hex character constant */ + Int n = 0; + Int d; + + skip(/* 'x' */); + if ((d = readHexDigit())<0) { + ERROR(row) "Empty hexadecimal character escape" + EEND; + } + do { + if (overflows(n,16,d,MAXCHARVAL)) { + ERROR(row) "Hexadecimal character escape out of range" + EEND; + } + n = 16*n + d; + skip(); + } while ((d = readHexDigit())>=0); + + return mkChar(n); +} + +static Int local readHexDigit() { /* read single hex digit */ + if ('0'<=c0 && c0<='9') + return c0-'0'; + if ('A'<=c0 && c0<='F') + return 10 + (c0-'A'); + if ('a'<=c0 && c0<='f') + return 10 + (c0-'a'); + return -1; +} + +static Cell local readDecChar() { /* read decimal character constant */ + Int n = 0; + + do { + if (overflows(n,10,(c0-'0'),MAXCHARVAL)) { + ERROR(row) "Decimal character escape out of range" + EEND; + } + n = 10*n + (c0-'0'); + skip(); + } while (c0!=EOF && isascii(c0) && isdigit(c0)); + + return mkChar(n); +} + +/* -------------------------------------------------------------------------- + * Produce printable representation of character: + * ------------------------------------------------------------------------*/ + +String unlexChar(c,quote) /* return string representation of */ +Char c; /* character... */ +Char quote; { /* protect quote character */ + static char buffer[12]; + + if (c<0) /* deal with sign extended chars.. */ + c += NUM_CHARS; + + if (isascii(c) && isprint(c)) { /* normal printable character */ + if (c==quote) { /* look for quote of approp. kind */ + buffer[0] = '\\'; + buffer[1] = c; + buffer[2] = '\0'; + } + else { + buffer[0] = c; + buffer[1] = '\0'; + } + } + else { /* look for escape code */ + Int escs; + for (escs=0; escapes[escs].codename; escs++) + if (escapes[escs].codenumber==c) { + sprintf(buffer,"\\%s",escapes[escs].codename); + return buffer; + } + sprintf(buffer,"\\%d",c); /* otherwise use numeric escape */ + } + return buffer; +} + +/* -------------------------------------------------------------------------- + * Handle special types of input for use in interpreter: + * ------------------------------------------------------------------------*/ + +Command readCommand(cmds,start,sys) /* read command at start of input */ +struct cmd *cmds; /* line in interpreter */ +Char start; /* characters introducing a cmd */ +Char sys; { /* character for shell escape */ + while (c0==' ' || c0 =='\t') + skip(); + + if (c0=='\n') /* look for blank command lines */ + return NOCMD; + if (c0==EOF) /* look for end of input stream */ + return QUIT; + if (c0==sys) { /* single character system escape */ + skip(); + return SYSTEM; + } + if (c0==start && c1==sys) { /* two character system escape */ + skip(); + skip(); + return SYSTEM; + } + + startToken(); /* All cmds start with start */ + if (c0==start) /* except default (usually EVAL) */ + do { /* which is empty */ + saveTokenChar(c0); + skip(); + } while (c0!=' ' && c0!='\t' && c0!='\n' && c0!=EOF); + endToken(); + + for (; cmds->cmdString; ++cmds) + if (strcmp((cmds->cmdString),tokenStr)==0 || + (tokenStr[0]==start && + tokenStr[1]==(cmds->cmdString)[1] && + tokenStr[2]=='\0')) + return (cmds->cmdCode); + return BADCMD; +} + +String readFilename() { /* Read filename from input (if any)*/ + if (reading==PROJFILE) + skipWhitespace(); + else + while (c0==' ' || c0=='\t') + skip(); + + if (c0=='\n' || c0==EOF) /* return null string at end of line*/ + return 0; + + startToken(); + while (c0!=' ' && c0!='\t' && c0!='\n' && c0!='\r' && c0!=EOF) { + saveTokenChar(c0); + skip(); + } + endToken(); + + return tokenStr; +} + +String readLine() { /* Read command line from input */ + while (c0==' ' || c0=='\t') /* skip leading whitespace */ + skip(); + + startToken(); + while (c0!='\n' && c0!=EOF) { + saveTokenChar(c0); + skip(); + } + endToken(); + + return tokenStr; +} + +/* -------------------------------------------------------------------------- + * This lexer supports the Haskell layout rule: + * + * - Layout area bounded by { ... }, with `;'s in between. + * - A `{' is a HARD indentation and can only be matched by a corresponding + * HARD '}' + * - Otherwise, if no `{' follows the keywords WHERE/LET or OF, a SOFT `{' + * is inserted with the column number of the first token after the + * WHERE/LET/OF keyword. + * - When a soft indentation is uppermost on the indetation stack with + * column col' we insert: + * `}' in front of token with column=MAXINDENT) { + ERROR(row) "Too many levels of program nesting" + EEND; + } + layout[++indentDepth] = col; +} + +static Void local unOffside() { /* leave layout rule area */ + indentDepth--; +} + +static Bool local canUnOffside() { /* Decide if unoffside permitted */ + return indentDepth>=0 && layout[indentDepth]!=HARD; +} + +/* -------------------------------------------------------------------------- + * Main tokeniser: + * ------------------------------------------------------------------------*/ + +static Void local skipWhitespace() { /* skip over whitespace/comments */ + +ws: while (c0==' ' || c0=='\t' || c0=='\r' || c0=='\f') + skip(); + + if (c0=='\n') { /* skip newline characters */ + newlineSkip(); + goto ws; + } + + if (c0=='{' && c1=='-') { /* (potentially) nested comment */ + Int nesting = 1; + Int origRow = row; /* save original row number */ + + skip(); + skip(); + while (nesting>0 && c0!=EOF) { + if (c0=='{' && c1=='-') { + skip(); + nesting++; + } + else if (c0=='-' && c1=='}') { + skip(); + nesting--; + } + + if (c0=='\n') + newlineSkip(); + else + skip(); + } + if (nesting>0) { + ERROR(origRow) "Unterminated nested comment {- ..." + EEND; + } + goto ws; + } + + if (c0=='-' && c1=='-') { /* one line comment */ + do + skip(); + while (c0!='\n' && c0!=EOF) + ; + if (c0=='\n') + newlineSkip(); + goto ws; + } +} + +static Bool firstToken; /* Set to TRUE for first token */ +static Int firstTokenIs; /* ... with token value stored here */ + +static Int local yylex() { /* Read next input token ... */ + static Bool insertOpen = FALSE; + static Bool insertedToken = FALSE; + static Text textRepeat; + +#define lookAhead(t) {skipWhitespace(); insertOpen = (c0!='{'); return t;} + + if (firstToken) { /* Special case for first token */ + indentDepth = (-1); + firstToken = FALSE; + insertOpen = FALSE; + insertedToken = FALSE; + if (reading==KEYBOARD) + textRepeat = findText(repeatStr); + return firstTokenIs; + } + + if (insertOpen) { /* insert `soft' opening brace */ + insertOpen = FALSE; + insertedToken = TRUE; + goOffside(column); + push(yylval = mkInt(row)); + return '{'; + } + + /* ---------------------------------------------------------------------- + * Skip white space, and insert tokens to support layout rules as reqd. + * --------------------------------------------------------------------*/ + + skipWhitespace(); + startColumn = column; + push(yylval = mkInt(row)); /* default token value is line no. */ + /* subsequent changes to yylval must also set top() to the same value */ + + if (indentDepth>=0) /* layout rule(s) active ? */ + if (insertedToken) /* avoid inserting multiple `;'s */ + insertedToken = FALSE; /* or putting `;' after `{' */ + else if (layout[indentDepth]!=HARD) + if (column"); + textLazy = findText("~"); + textClass = findText("class"); + textInstance = findText("instance"); + textImplies = findText("=>"); + textPlus = findText("+"); + textMult = findText("*"); + textDefault = findText("default"); + textDeriving = findText("deriving"); + textHiding = findText("hiding"); + textInterface = findText("interface"); + textImport = findText("import"); + textModule = findText("module"); + textTo = findText("to"); + textRenaming = findText("renaming"); +#if IO_MONAD + textRunST = findText("runST"); +#endif +#if DO_COMPS + textDo = findText("do"); +#endif + varMinus = mkVar(findText("-")); + varNegate = mkVar(findText("negate")); + varFlip = mkVar(findText("flip")); + varFrom = mkVar(findText("enumFrom")); + varFromTo = mkVar(findText("enumFromTo")); + varFromThen = mkVar(findText("enumFromThen")); + varFromThenTo = mkVar(findText("enumFromThenTo")); + break; + } +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/kind.c b/src/kind.c new file mode 100644 index 0000000..8aa1a2b --- /dev/null +++ b/src/kind.c @@ -0,0 +1,404 @@ +/* -------------------------------------------------------------------------- + * kind.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Part of type checker dealing with kind inference + * ------------------------------------------------------------------------*/ + +#define newKindvars(n) newTyvars(n) /* to highlight uses of type vars */ + /* as kind variables */ + +Bool kindExpert = FALSE; /* TRUE => display kind errors in */ + /* full detail */ + +/* -------------------------------------------------------------------------- + * Kind checking code: + * ------------------------------------------------------------------------*/ + +static Void local kindError(l,c,in,wh,k,o) +Int l; /* line number near constuctor exp */ +Constr c; /* constructor */ +Constr in; /* context (if any) */ +String wh; /* place in which error occurs */ +Kind k; /* expected kind (k,o) */ +Int o; { /* inferred kind (typeIs,typeOff) */ + clearMarks(); + + if (!kindExpert) { /* for those with a fear of kinds */ + ERROR(l) "Illegal type" ETHEN + if (nonNull(in)) { + ERRTEXT " \"" ETHEN ERRTYPE(in); + ERRTEXT "\"" ETHEN + } + ERRTEXT " in %s\n", wh + EEND; + } + + ERROR(l) "Kind error in %s", wh ETHEN + if (nonNull(in)) { + ERRTEXT "\n*** expression : " ETHEN ERRTYPE(in); + } + ERRTEXT "\n*** constructor : " ETHEN ERRTYPE(c); + ERRTEXT "\n*** kind : " ETHEN ERRKIND(copyType(typeIs,typeOff)); + ERRTEXT "\n*** does not match : " ETHEN ERRKIND(copyType(k,o)); + if (unifyFails) { + ERRTEXT "\n*** because : %s", unifyFails ETHEN + } + ERRTEXT "\n" + EEND; +} + +#define shouldKind(l,c,in,wh,k,o) if (!kunify(typeIs,typeOff,k,o)) \ + kindError(l,c,in,wh,k,o) +#define checkKind(l,c,in,wh,k,o) kindConstr(l,c); shouldKind(l,c,in,wh,k,o) +#define inferKind(k,o) typeIs=k; typeOff=o + +static Int locCVars; /* offset to local variable kinds */ +static List unkindTypes; /* types in need of kind annotation*/ + +static Void local kindConstr(l,c) /* Determine kind of constructor */ +Int l; +Cell c; { + Cell h = getHead(c); + Int n = argCount; + + if (isSynonym(h) && n ... => vn => w */ + shouldKind(l,h,c,app,k,beta); + + for (i=n; i>0; --i) { /* ci :: vi for each 1 <- 1..n */ + checkKind(l,arg(a),c,app,var,beta+i-1); + a = fun(a); + } + tyvarType(beta+n); /* inferred kind is w */ + } +} + +static Kind local kindAtom(c) /* Find kind of atomic constructor */ +Cell c; { + switch (whatIs(c)) { + case LIST : return simpleKind(1); /*[_]::* -> * */ + case UNIT : return STAR; /*() ::* */ + case TUPLE : return simpleKind(tupleOf(c)); /*(,)::* -> * -> * */ + case ARROW : return simpleKind(2); /* ->::* -> * -> * */ + case OFFSET : return mkInt(locCVars+offsetOf(c)); + case TYCON : return tycon(c).kind; + } + internal("kindAtom"); + return STAR;/* not reached */ +} + +static Void local kindPred(line,pred) /* Check kinds of arguments in pred*/ +Int line; +Cell pred; { + static String predicate = "class constraint"; + Class c = getHead(pred); /* get class name */ + List as = getArgs(pred); /* get arguments */ + Cell sig = class(c).sig; /* get kind signature to match */ + + while (nonNull(sig)) { + checkKind(line,hd(as),NIL,predicate,hd(sig),0); + sig = tl(sig); + as = tl(as); + } +} + +static Void local kindType(line,wh,type)/* check that (poss qualified) type*/ +Int line; /* is well-kinded */ +String wh; +Type type; { + locCVars = 0; + if (isPolyType(type)) { /* local constructor vars reqd? */ + locCVars = newKindvars(selectOf(polySigOf(type))); + unkindTypes = cons(pair(mkInt(locCVars),snd(type)),unkindTypes); + type = monoTypeOf(type); + } + if (whatIs(type)==QUAL) { /* examine context (if any) */ + map1Proc(kindPred,line,fst(snd(type))); + type = snd(snd(type)); + } + checkKind(line,type,NIL,wh,STAR,0); /* finally, check type part */ +} + +static Void local fixKinds() { /* add kind annotations to types */ + for (; nonNull(unkindTypes); unkindTypes=tl(unkindTypes)) { + Pair pr = hd(unkindTypes); + if (isSelect(fst(snd(pr)))) { /* just in case two refs point to a*/ + Int beta = intOf(fst(pr)); /* single type */ + Int n = selectOf(fst(snd(pr))); + Kind k = STAR; + while (n-- > 0) + k = ap(copyKindvar(beta+n),k); + fst(snd(pr)) = k; +#ifdef DEBUG_KINDS + printf("Type expression: "); + printType(stdout,snd(snd(pr))); + printf(" ::: "); + printKind(stdout,k); + printf("\n"); +#endif + } + } +} + +/* -------------------------------------------------------------------------- + * Kind checking of groups of type constructors and classes: + * ------------------------------------------------------------------------*/ + +Void kindTCGroup(tcs) /* find kinds for mutually rec. gp */ +List tcs; { /* of tycons and classes */ + typeChecker(RESET); + mapProc(initTCKind,tcs); + mapProc(kindTC,tcs); + mapProc(genTC,tcs); + fixKinds(); + typeChecker(RESET); +} + +static Void local initTCKind(c) /* build initial kind/arity for c */ +Cell c; { + if (isTycon(c)) { /* Initial kind of tycon is: */ + Int beta = newKindvars(1); /* v1 => ... => vn => vn */ + varKind(tycon(c).arity); /* where n is the arity of c. */ + bindTv(beta,typeIs,typeOff); /* For data definitions, vn == * */ + if (tycon(c).what == DATATYPE) + bindTv(typeOff+tycon(c).arity,STAR,0); + tycon(c).kind = mkInt(beta); + } + else { + Int n = class(c).arity; + Int beta = newKindvars(n); + class(c).sig = NIL; + do { + n--; + class(c).sig = pair(mkInt(beta+n),class(c).sig); + } while (n>0); + } +} + +static Void local kindTC(c) /* check each part of a tycon/class*/ +Cell c; { /* is well-kinded */ + if (isTycon(c)) { + static String data = "datatype definition"; + static String tsyn = "synonym definition"; + Int line = tycon(c).line; + + locCVars = tyvar(intOf(tycon(c).kind))->offs; + if (tycon(c).what == DATATYPE) {/* check conponents of constr fns */ + List cs = tycon(c).defn; + if (whatIs(cs)==QUAL) { + map1Proc(kindPred,line,fst(snd(cs))); + cs = snd(snd(cs)); + } + for (; nonNull(cs); cs=tl(cs)) { + Constr cn = hd(cs); + for (; isAp(cn); cn=fun(cn)) { + checkKind(line,arg(cn),NIL,data,STAR,0); + } + } + } + else { /* check synonym expansion */ + checkKind(line,tycon(c).defn,NIL,tsyn,var,locCVars+tycon(c).arity); + } + } + else { /* scan type exprs in class defn to*/ + List ms = class(c).members; /* determine the class signature */ + + locCVars = newKindvars(class(c).arity); + kindPred(class(c).line,class(c).head); + map1Proc(kindPred,class(c).line,class(c).supers); + for (; nonNull(ms); ms=tl(ms)) { + Int line = intOf(fst3(hd(ms))); + Type type = thd3(hd(ms)); + kindType(line,"member function type signature",type); + } + } +} + +static Void local genTC(c) /* generalise kind inferred for */ +Cell c; { /* given tycon/class */ + if (isTycon(c)) { + tycon(c).kind = copyKindvar(intOf(tycon(c).kind)); +#ifdef DEBUG_KINDS + printf("%s :: ",textToStr(tycon(c).text)); + printKind(stdout,tycon(c).kind); + putchar('\n'); +#endif + } + else { + Cell sig = class(c).sig; + for (; nonNull(sig); sig=tl(sig)) + hd(sig) = copyKindvar(intOf(hd(sig))); +#ifdef DEBUG_KINDS + printf("%s :: ",textToStr(class(c).text)); + printSig(stdout,class(c).sig); + putchar('\n'); +#endif + } +} + +static Kind local copyKindvar(vn) /* build kind attatched to variable*/ +Int vn; { + Tyvar *tyv = tyvar(vn); + if (tyv->bound) + return copyKind(tyv->bound,tyv->offs); + return STAR; /* any unbound variable defaults to*/ +} /* the kind of all types */ + +static Kind local copyKind(k,o) /* build kind expression from */ +Kind k; /* given skeleton */ +Int o; { + switch (whatIs(k)) { + case AP : { Kind l = copyKind(fst(k),o); /* ensure correct */ + Kind r = copyKind(snd(k),o); /* eval. order */ + return ap(l,r); + } + case OFFSET : return copyKindvar(o+offsetOf(k)); + case INTCELL : return copyKindvar(intOf(k)); + } + return k; +} + +/* -------------------------------------------------------------------------- + * Kind checking of instance declaration headers: + * ------------------------------------------------------------------------*/ + +Void kindInst(in,freedom) /* check predicates in instance */ +Inst in; +Int freedom; { + typeChecker(RESET); + locCVars = newKindvars(freedom); + kindPred(inst(in).line,inst(in).head); + map1Proc(kindPred,inst(in).line,inst(in).specifics); + inst(in).sig = NIL; + while (0 * */ + case UNIT : return STAR; /*() ::* */ + case TUPLE : return simpleKind(tupleOf(c)); /*(,)::* -> * -> * */ + case ARROW : return simpleKind(2); /*-> ::* -> * -> * */ + case OFFSET : return tyvar(o+offsetOf(c))->kind; + case INTCELL: return tyvar(intOf(c))->kind; + case TYCON : return tycon(c).kind; + } +#ifdef DEBUG_KINDS + printf("getKind c = %d, whatIs=%d\n",c,whatIs(c)); +#endif + internal("getKind"); + return STAR;/* not reached */ +} + +/* -------------------------------------------------------------------------- + * Two forms of kind expression are used quite frequently: + * * => * => ... => * => * for kinds of ->, [], ->, (,) etc... + * v1 => v2 => ... => vn => vn+1 skeletons for constructor kinds + * Expressions of these forms are produced by the following functions which + * use a cache to avoid repeated construction of commonly used values. + * A similar approach is used to store the types of tuple constructors in the + * main type checker. + * ------------------------------------------------------------------------*/ + +#define MAXKINDFUN 10 +static Kind simpleKindCache[MAXKINDFUN]; +static Kind varKindCache[MAXKINDFUN]; + +static Kind local makeSimpleKind(n) /* construct * => ... => * (n args)*/ +Int n; { + Kind k = STAR; + while (n-- > 0) + k = ap(STAR,k); + return k; +} + +static Kind local simpleKind(n) /* return (possibly cached) simple */ +Int n; { /* function kind */ + if (n>=MAXKINDFUN) + return makeSimpleKind(n); + else if (nonNull(simpleKindCache[n])) + return simpleKindCache[n]; + else if (n==0) + return simpleKindCache[0] = STAR; + else + return simpleKindCache[n] = ap(STAR,simpleKind(n-1)); +} + +static Kind local makeVarKind(n) /* construct v0 => .. => vn */ +Int n; { + Kind k = mkOffset(n); + while (n-- > 0) + k = ap(mkOffset(n),k); + return k; +} + +static Void local varKind(n) /* return (possibly cached) var */ +Int n; { /* function kind */ + typeOff = newKindvars(n+1); + if (n>=MAXKINDFUN) + typeIs = makeVarKind(n); + else if (nonNull(varKindCache[n])) + typeIs = varKindCache[n]; + else + typeIs = varKindCache[n] = makeVarKind(n); +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/machdep.c b/src/machdep.c new file mode 100644 index 0000000..216cab3 --- /dev/null +++ b/src/machdep.c @@ -0,0 +1,630 @@ +/* -------------------------------------------------------------------------- + * machdep.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Machine dependent code + * RISCOS specific code provided by Bryan Scatergood, JBS + * ------------------------------------------------------------------------*/ + +#if UNIX +#include +#include +#include +#include +#include +#endif + +#if (TURBOC | BCC) +#include +#include +#include +#include +#include +#include +#include +extern unsigned _stklen = 8000; /* Allocate an 8k stack segment */ +#endif + +#if (ZTC | WATCOM) +#include +#include +#include +#include +#include +#endif + +#if DJGPP +#include +#include +#include +#include +#include +#include +#include +#endif + +#if RISCOS +#include +#include +#include "swis.h" +#include "os.h" +#endif + +#if ATARI +#include +#include +#include +#include +#endif + +/* -------------------------------------------------------------------------- + * Machine dependent code is used in each of: + * - The gofer interpreter MACHDEP_GOFER + * - The gofer compiler MACHDEP_GOFC + * - The compiler runtime system MACHDEP_RUNTIME + * In many cases, the the same code is used in each part. The following + * sections of code are enclosed in suitable #if ... #endif directives to + * indicate which sections require particular parts of the code. Each of + * the three systems above defines one of the three symbols on the right + * above as 1 and then #includes this file. The following directives make + * sure that the other macros are set to the correct defaults. + * ------------------------------------------------------------------------*/ + +#ifndef MACHDEP_GOFER +#define MACHDEP_GOFER 0 +#endif +#ifndef MACHDEP_GOFC +#define MACHDEP_GOFC 0 +#endif +#ifndef MACHDEP_RUNTIME +#define MACHDEP_RUNTIME 0 +#endif + +/* -------------------------------------------------------------------------- + * Find information about a file: + * ------------------------------------------------------------------------*/ + +#if (MACHDEP_GOFER | MACHDEP_GOFC) +#if RISCOS +typedef struct { unsigned hi, lo; } Time; +#define timeChanged(now,thn) (now.hi!=thn.hi || now.lo!=thn.lo) +#define timeSet(var,tm) var.hi = tm.hi; var.lo = tm.lo +#else +typedef time_t Time; +#define timeChanged(now,thn) (now!=thn) +#define timeSet(var,tm) var = tm +#endif + +static Void local getFileInfo Args((String, Time *, Long *)); + +static Void local getFileInfo(s,tm,sz) /* find time stamp and size of file*/ +String s; +Time *tm; +Long *sz; { +#if RISCOS /* get file info for RISCOS -- JBS */ + os_regset r; /* RISCOS PRM p.850 and p.837 */ + r.r[0] = 17; /* Read catalogue, no path */ + r.r[1] = (int)s; + os_swi(OS_File, &r); + if(r.r[0] == 1 && (r.r[2] & 0xFFF00000) == 0xFFF00000) { + tm->hi = r.r[2] & 0xFF; /* Load address (high byte) */ + tm->lo = r.r[3]; /* Execution address (low 4 bytes) */ + } + else /* Not found, or not time-stamped */ + tm->hi = tm->lo = 0; + *sz = (Long)(r.r[0] == 1 ? r.r[4] : 0); +#else /* normally just use stat() */ + static struct stat scbuf; + stat(s,&scbuf); + *tm = scbuf.st_mtime; + *sz = (Long)(scbuf.st_size); +#endif +} +#endif + +#if RISCOS /* RISCOS needs access() */ +int access(char *s, int dummy) { /* Give 1 iff cannot access file s */ + os_regset r; /* RISCOS PRM p.850 -- JBS */ + assert(dummy == 0); + r.r[0] = 17; /* Read catalogue, no path */ + r.r[1] = (int)s; + os_swi(OS_File, &r); + return r.r[0] != 1; +} + +int namecmp(char *filename, char *spec){/* For filename extension hacks */ + while(*spec) + if (tolower(*filename) != *spec++) + return 0; + else + ++filename; + return *filename == '.'; +} +#endif + +/* -------------------------------------------------------------------------- + * Get time/date stamp for inclusion in compiled files: + * ------------------------------------------------------------------------*/ + +#if MACHDEP_GOFC +#include +String timeString() { /* return time&date string */ + time_t clock; /* must end with '\n' character */ + time(&clock); + return(ctime(&clock)); +} +#endif + +/* -------------------------------------------------------------------------- + * Garbage collection notification: + * ------------------------------------------------------------------------*/ + +#if (MACHDEP_GOFER | MACHDEP_GOFC) +Bool gcMessages = FALSE; /* TRUE => print GC messages */ + +Void gcStarted() { /* notify garbage collector start */ + if (gcMessages) { + printf("{{Gc"); + fflush(stdout); + } +} + +Void gcScanning() { /* notify garbage collector scans */ + if (gcMessages) { + putchar(':'); + fflush(stdout); + } +} + +Void gcRecovered(recovered) /* notify garbage collection done */ +Int recovered; { + if (gcMessages) { + printf("%d}}",recovered); + fflush(stdout); + } +} + +Cell *CStackBase; /* Retain start of C control stack */ + +#if RISCOS /* Stack traversal for RISCOS */ + +/* Warning: The following code is specific to the Acorn ARM under RISCOS + (and C4). We must explicitly walk back through the stack frames, since + the stack is extended from the heap. (see PRM pp. 1757). gcCStack must + not be modified, since the offset '5' assumes that only v1 is used inside + this function. Hence we do all the real work in gcARM. +*/ + +#define spreg 13 /* C3 has SP=R13 */ + +#define previousFrame(fp) ((int *)((fp)[-3])) +#define programCounter(fp) ((int *)((*(fp)-12) & ~0xFC000003)) +#define isSubSPSP(w) (((w)&dontCare) == doCare) +#define doCare (0xE24DD000) /* SUB r13,r13,#0 */ +#define dontCare (~0x00100FFF) /* S and # bits */ +#define immediateArg(x) ( ((x)&0xFF) << (((x)&0xF00)>>7) ) + +static void gcARM(int *fp) { + int si = *programCounter(fp); /* Save instruction indicates how */ + /* many registers in this frame */ + int *regs = fp - 4; + if (si & (1<<0)) markWithoutMove(*regs--); + if (si & (1<<1)) markWithoutMove(*regs--); + if (si & (1<<2)) markWithoutMove(*regs--); + if (si & (1<<3)) markWithoutMove(*regs--); + if (si & (1<<4)) markWithoutMove(*regs--); + if (si & (1<<5)) markWithoutMove(*regs--); + if (si & (1<<6)) markWithoutMove(*regs--); + if (si & (1<<7)) markWithoutMove(*regs--); + if (si & (1<<8)) markWithoutMove(*regs--); + if (si & (1<<9)) markWithoutMove(*regs--); + if (previousFrame(fp)) { + /* The non-register stack space is for the previous frame is above + this fp, and not below the previous fp, because of the way stack + extension works. It seems the only way of discovering its size is + finding the SUB sp, sp, #? instruction by walking through the code + following the entry point. + */ + int *oldpc = programCounter(previousFrame(fp)); + int fsize = 0, i; + for(i = 1; i < 6; ++i) + if(isSubSPSP(oldpc[i])) fsize += immediateArg(oldpc[i]) / 4; + for(i=1; i<=fsize; ++i) + markWithoutMove(fp[i]); + } +} + +void gcCStack() { + int dummy; + int *fp = 5 + &dummy; + while (fp) { + gcARM(fp); + fp = previousFrame(fp); + } +} + +#else /* Garbage collection for standard stack machines */ + +Void gcCStack() { /* Garbage collect elements off */ + Cell stackTop = NIL; /* C stack */ + Cell *ptr = &stackTop; +#if SMALL_GOFER + if (((long)(ptr) - (long)(CStackBase))&1) + fatal("gcCStack"); +#else + if (((long)(ptr) - (long)(CStackBase))&3) + fatal("gcCStack"); +#endif + +#define StackGrowsDown while (ptr<=CStackBase) markWithoutMove(*ptr++) +#define StackGrowsUp while (ptr>=CStackBase) markWithoutMove(*ptr--) +#define GuessDirection if (ptr>CStackBase) StackGrowsUp; else StackGrowsDown +#if HPUX + GuessDirection; +#else + StackGrowsDown; +#endif +#undef StackGrowsDown +#undef StackGrowsUp +#undef GuessDirection +} +#endif +#endif + +/* -------------------------------------------------------------------------- + * Terminal dependent stuff: + * ------------------------------------------------------------------------*/ + +#if (TERMIO_IO | SGTTY_IO | TERMIOS_IO) + +#if TERMIO_IO +#include +typedef struct termio TermParams; +#define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp) +#define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp) +#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \ + tp.c_cc[VMIN] = 1; \ + tp.c_cc[VTIME] = 0; +#endif + +#if SGTTY_IO +#include +typedef struct sgttyb TermParams; +#define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp) +#define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp) +#if HPUX +#define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO); +#else +#define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO); +#endif +#endif + +#if TERMIOS_IO +#include +typedef struct termios TermParams; +#define getTerminal(tp) tcgetattr(fileno(stdin), &tp) +#define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp) +#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \ + tp.c_cc[VMIN] = 1; \ + tp.c_cc[VTIME] = 0; +#endif + +static Bool messedWithTerminal = FALSE; +static TermParams originalSettings; + +Void normalTerminal() { /* restore terminal initial state */ + if (messedWithTerminal) + setTerminal(originalSettings); +} + +Void noechoTerminal() { /* set terminal into noecho mode */ + TermParams settings; + + if (!messedWithTerminal) { + getTerminal(originalSettings); + messedWithTerminal = TRUE; + } + getTerminal(settings); + noEcho(settings); + setTerminal(settings); +} + +#if (MACHDEP_GOFER | MACHDEP_GOFC) +Int getTerminalWidth() { /* determine width of terminal */ +#ifdef TIOCGWINSZ +#ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/ +#include /* Required by sys/ptem.h */ +#include /* Required to declare winsize */ +#endif + static struct winsize terminalSize; + ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize); + return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col; +#else + return 80; +#endif +} +#endif + +Int readTerminalChar() { /* read character from terminal */ + return getchar(); /* without echo, assuming that */ +} /* noechoTerminal() is active... */ +#endif + +#if DOS_IO +static Bool terminalEchoReqd = TRUE; + +#if (MACHDEP_GOFER | MACHDEP_GOFC) +Int getTerminalWidth() { /* PC screen is fixed 80 chars */ + return 80; +} +#endif + +Void normalTerminal() { /* restore terminal initial state */ + terminalEchoReqd = TRUE; +} + +Void noechoTerminal() { /* turn terminal echo on/off */ + terminalEchoReqd = FALSE; +} + +Int readTerminalChar() { /* read character from terminal */ + if (terminalEchoReqd) + return getchar(); + else { + Int c = getch(); + return c=='\r' ? '\n' : c; + } +} +#endif + +#if RISCOS +#if (MACHDEP_GOFER | MACHDEP_GOFC) +Int getTerminalWidth() { + int dummy, width; + (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width); + return width+1; +} +#endif + +Void normalTerminal() { /* restore terminal initial state */ +} /* (not yet implemented) */ + +Void noechoTerminal() { /* turn terminal echo on/off */ +} /* (not yet implemented) */ + +Int readTerminalChar() { /* read character from terminal */ + return getchar(); +} +#endif + +/* -------------------------------------------------------------------------- + * Interrupt handling: + * ------------------------------------------------------------------------*/ + +#if (MACHDEP_GOFER | MACHDEP_GOFC) /* runtime.c provides own version */ +static Bool broken = FALSE; +static Bool breakReqd = FALSE; +static sigProto(ignoreBreak); + +Bool breakOn(reqd) /* set break trapping on if reqd, */ +Bool reqd; { /* or off otherwise, returning old */ + Bool old = breakReqd; + + breakReqd = reqd; + if (reqd) { + if (broken) { /* repond to break signal received */ + broken = FALSE; /* whilst break trap disabled */ + sigRaise(breakHandler); + } + ctrlbrk(breakHandler); + } + else + ctrlbrk(ignoreBreak); + + return old; +} + +static sigHandler(ignoreBreak) { /* record but don't respond to break*/ + ctrlbrk(ignoreBreak); + broken = TRUE; + sigResume; +} +#endif + +/* -------------------------------------------------------------------------- + * Shell escapes: + * ------------------------------------------------------------------------*/ + +#if MACHDEP_GOFER +Int shellEsc(s) /* run a shell command (or shell) */ +String s; { +#if UNIX + if (s[0]=='\0') + s = fromEnv("SHELL","/bin/sh"); +#endif + return system(s); +} + +#if RISCOS /* RISCOS also needs a chdir() */ +int chdir(char *s) { /* RISCOS PRM p. 885 -- JBS */ + return os_swi2(OS_FSControl + XOS_Bit, 0, (int)s) != NULL; +} +#endif +#endif + +/* -------------------------------------------------------------------------- + * Floating point support: + * ------------------------------------------------------------------------*/ + +#if HAS_FLOATS +#if BREAK_FLOATS +static union { + Float flVal; + struct { + Cell flPart1,flPart2; + } clVal; +} fudgeCoerce; + +Cell part1Float(fl) +FloatPro fl; { + fudgeCoerce.flVal = fl; + return fudgeCoerce.clVal.flPart1; +} + +Cell part2Float(fl) +FloatPro fl; { + fudgeCoerce.flVal = fl; + return fudgeCoerce.clVal.flPart2; +} + +FloatPro floatFromParts(c1,c2) +Cell c1, c2; { + fudgeCoerce.clVal.flPart1 = c1; + fudgeCoerce.clVal.flPart2 = c2; + return fudgeCoerce.flVal; +} + +Cell mkFloat(fl) +FloatPro fl; { + Cell p1,p2; + fudgeCoerce.flVal = fl; + p1 = mkInt(fudgeCoerce.clVal.flPart1); + p2 = mkInt(fudgeCoerce.clVal.flPart2); + return pair(FLOATCELL,pair(p1,p2)); +} + +FloatPro floatOf(c) +Cell c; { + fudgeCoerce.clVal.flPart1 = intOf(fst(snd(c))); + fudgeCoerce.clVal.flPart2 = intOf(snd(snd(c))); + return fudgeCoerce.flVal; +} + +#if MACHDEP_RUNTIME & BREAK_FLOATS +Cell safeMkFloat(fl) +FloatPro fl; { + fudgeCoerce.flVal = fl; + needStack(2); + pushInt(fudgeCoerce.clVal.flPart2); + pushInt(fudgeCoerce.clVal.flPart1); + heap(2); + mkap(); + topfun(FLOATCELL); + return pop(); +} +#endif + +#else /* !BREAK_FLOATS */ +static union { + Float flVal; + Cell clVal; +} fudgeCoerce; + +Cell mkFloat(fl) +FloatPro fl; { + fudgeCoerce.flVal = fl; + return pair(FLOATCELL,fudgeCoerce.clVal); +} + +FloatPro floatOf(c) +Cell c; { + fudgeCoerce.clVal = snd(c); + return fudgeCoerce.flVal; +} +#endif + +String floatToString(fl) /* Make sure that floating */ +FloatPro fl; { /* point values print out in */ + static char buffer1[32]; /* a form in which they could*/ + static char buffer2[32]; /* also be entered as floats */ + Int i=0, j=0; + + sprintf(buffer1,FloatFMT,fl); + while (buffer1[i] && strchr("eE.",buffer1[i])==0) + buffer2[j++] = buffer1[i++]; + if (buffer1[i]!='.') { + buffer2[j++] = '.'; + buffer2[j++] = '0'; + } + while (buffer2[j++]=buffer1[i++]) + ; + return buffer2; +} + +FloatPro stringToFloat(s) +String s; { + return atof(s); +} +#else +Cell mkFloat(fl) +FloatPro fl; { + internal("mkFloat"); + return 0;/*NOTREACHED*/ +} + +FloatPro floatOf(c) +Cell c; { + internal("floatOf"); + return 0;/*NOTREACHED*/ +} + +String floatToString(fl) +FloatPro fl; { + internal("floatToString"); + return "";/*NOTREACHED*/ +} + +FloatPro stringToFloat(s) +String s; { + internal("stringToFloat"); + return 0; +} +#endif + +/* -------------------------------------------------------------------------- + * Machine dependent control: + * ------------------------------------------------------------------------*/ + +#if (MACHDEP_GOFER | MACHDEP_GOFC) +#if UNIX +static sigHandler(panic) { /* exit in a panic, on receipt of */ + everybody(EXIT); /* an unexpected signal */ + fprintf(stderr,"Unexpected signal\n"); + exit(1); + sigResume;/*NOTREACHED*/ +} +#endif + +Void machdep(what) /* Handle machine specific */ +Int what; { /* initialisation etc.. */ + switch (what) { + case MARK : break; +#if UNIX + case INSTALL : +#ifdef SIGHUP + signal(SIGHUP,panic); +#endif +#ifdef SIGQUIT + signal(SIGQUIT,panic); +#endif +#ifdef SIGTERM + signal(SIGTERM,panic); +#endif +#ifdef SIGSEGV + signal(SIGSEGV,panic); +#endif +#ifdef SIGBUS + signal(SIGBUS,panic); +#endif + break; +#endif + case RESET : + case BREAK : + case EXIT : normalTerminal(); + break; + } +} +#endif + +/*-------------------------------------------------------------------------*/ diff --git a/src/machine.c b/src/machine.c new file mode 100644 index 0000000..2018f24 --- /dev/null +++ b/src/machine.c @@ -0,0 +1,1284 @@ +/* -------------------------------------------------------------------------- + * machine.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Graph reduction engine, code generation and execution + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "errors.h" +#include + +/*#define DEBUG_CODE*/ +Bool andorOptimise = TRUE; /* TRUE => optimise uses of &&, || */ +Bool failOnError = TRUE; /* TRUE => abort as soon as error */ + /* occurs */ + +/* -------------------------------------------------------------------------- + * Data structures for machine memory (program storage): + * ------------------------------------------------------------------------*/ + +/* This list defines the sequence of all instructions that can be used in + * the abstract machine code for Gofer. The Ins() macro is used to + * ensure that the correct mapping of instructions to labels is used when + * compiling the GCC_THREADED version. + */ +#if NPLUSK +#define INSTRLIST Ins(iLOAD), Ins(iCELL), Ins(iCHAR), \ + Ins(iINT), Ins(iFLOAT), Ins(iSTRING), \ + Ins(iMKAP), Ins(iUPDATE), Ins(iUPDAP), \ + Ins(iEVAL), Ins(iRETURN), Ins(iINTGE), \ + Ins(iINTEQ), Ins(iINTDV), Ins(iTEST), \ + Ins(iGOTO), Ins(iSETSTK), Ins(iALLOC), \ + Ins(iSLIDE), Ins(iROOT), Ins(iDICT), \ + Ins(iFAIL) +#else +#define INSTRLIST Ins(iLOAD), Ins(iCELL), Ins(iCHAR), \ + Ins(iINT), Ins(iFLOAT), Ins(iSTRING), \ + Ins(iMKAP), Ins(iUPDATE), Ins(iUPDAP), \ + Ins(iEVAL), Ins(iRETURN), Ins(iINTEQ), \ + Ins(iTEST), Ins(iGOTO), Ins(iSETSTK), \ + Ins(iALLOC), Ins(iSLIDE), Ins(iROOT), \ + Ins(iDICT), Ins(iFAIL) +#endif + +#define Ins(x) x +typedef enum { INSTRLIST } Instr; +#undef Ins + +typedef Int Label; + +typedef union { + Int mint; +#if !BREAK_FLOATS + Float mfloat; +#endif + Cell cell; + Text text; + Addr addr; + Instr instr; + Label lab; +} MemCell; + +typedef MemCell far *Memory; +static Memory memory; +#define intAt(m) memory[m].mint +#if !BREAK_FLOATS +#define floatAt(m) memory[m].mfloat +#endif +#define cellAt(m) memory[m].cell +#define textAt(m) memory[m].text +#define addrAt(m) memory[m].addr +#define instrAt(m) memory[m].instr +#define labAt(m) memory[m].lab + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local instrNone Args((Instr)); +static Void local instrInt Args((Instr,Int)); +static Void local instrFloat Args((Instr,FloatPro)); +static Void local instrCell Args((Instr,Cell)); +static Void local instrText Args((Instr,Text)); +static Void local instrLab Args((Instr,Label)); +static Void local instrIntLab Args((Instr,Int,Label)); +static Void local instrCellLab Args((Instr,Cell,Label)); + +static Void local asSTART Args((Void)); +static Label local newLabel Args((Label)); +static Void local asEND Args((Void)); +static Void local asDICT Args((Int)); +static Void local asSLIDE Args((Int)); +static Void local asMKAP Args((Int)); +static Void local asUPDATE Args((Int)); +static Void local asGOTO Args((Label)); + +#ifdef DEBUG_CODE +static Void local dissassemble Args((Addr,Addr)); +static Void local printCell Args((Cell)); +static Addr local dissNone Args((Addr,String)); +static Addr local dissInt Args((Addr,String)); +static Addr local dissFloat Args((Addr,String)); +static Addr local dissCell Args((Addr,String)); +static Addr local dissText Args((Addr,String)); +static Addr local dissAddr Args((Addr,String)); +static Addr local dissIntAddr Args((Addr,String)); +static Addr local dissCellAddr Args((Addr,String)); +#endif + +static Void local build Args((Cell,Int)); +static Void local buildGuards Args((List,Int)); +static Int local buildLoc Args((List,Int)); + +static Void local make Args((Cell,Int,Label,Label)); +static Void local makeCond Args((Cell,Cell,Cell,Int,Label,Label)); +static Void local testGuard Args((Pair,Int,Label,Label,Label)); +static Void local testCase Args((Pair,Int,Label,Label,Label)); + +static Void local analyseAp Args((Cell)); +static Void local buildAp Args((Cell,Int,Label,Bool)); + +static Void local evalString Args((Cell)); +static Void local run Args((Addr,StackPtr)); + +/* -------------------------------------------------------------------------- + * Assembler: (Low level, instruction code storage) + * ------------------------------------------------------------------------*/ + +static Addr startInstr; /* first instruction after START */ +static Addr lastInstr; /* last instr written (for peephole*/ + /* optimisations etc.) */ +static Addr noMatch; /* address of a single FAIL instr */ +static Int srsp; /* simulated runtime stack pointer */ +static Int offsPosn[NUM_OFFSETS]; /* mapping from logical to physical*/ + /* offset positions */ + +static Void local instrNone(opc) /* Opcode with no operands */ +Instr opc; { + lastInstr = getMem(1); + instrAt(lastInstr) = opc; +} + +static Void local instrInt(opc,n) /* Opcode with integer operand */ +Instr opc; +Int n; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + intAt(lastInstr+1) = n; +} + +static Void local instrFloat(opc,fl) /* Opcode with Float operand */ +Instr opc; +FloatPro fl; { +#if BREAK_FLOATS + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = part1Float(fl); + cellAt(lastInstr+2) = part2Float(fl); +#else + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + floatAt(lastInstr+1) = fl; +#endif +} + +static Void local instrCell(opc,c) /* Opcode with Cell operand */ +Instr opc; +Cell c; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = c; +} + +static Void local instrText(opc,t) /* Opcode with Text operand */ +Instr opc; +Text t; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + textAt(lastInstr+1) = t; +} + +static Void local instrLab(opc,l) /* Opcode with label operand */ +Instr opc; +Label l; { + lastInstr = getMem(2); + instrAt(lastInstr) = opc; + labAt(lastInstr+1) = l; + if (l<0) + internal("bad Label"); +} + +static Void local instrIntLab(opc,n,l) /* Opcode with int, label operands */ +Instr opc; +Int n; +Label l; { + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + intAt(lastInstr+1) = n; + labAt(lastInstr+2) = l; + if (l<0) + internal("bad Label"); +} + +static Void local instrCellLab(opc,c,l) /* Opcode with cell, label operands*/ +Instr opc; +Cell c; +Label l; { + lastInstr = getMem(3); + instrAt(lastInstr) = opc; + cellAt(lastInstr+1) = c; + labAt(lastInstr+2) = l; + if (l<0) + internal("bad Label"); +} + +/* -------------------------------------------------------------------------- + * Main low level assembler control: (includes label assignment and fixup) + * + * Labels are used as a simple form of continuation during the code gen: + * RUNON => produce code which does not make jump at end of construction + * UPDRET => produce code which performs UPDATE 0, RETURN at end + * VALRET => produce code which performs RETURN at end + * other(d) => produce code which branches to label d at end + * ------------------------------------------------------------------------*/ + +static Label nextLab; /* next label number to allocate */ +#define SHOULDNTFAIL (-1) +#define RUNON (-2) +#define UPDRET (-3) +#define VALRET (-4) +static Addr fixups[NUM_FIXUPS]; /* fixup table maps Label -> Addr*/ +#define atLabel(n) fixups[n] = getMem(0) +#define endLabel(d,l) if (d==RUNON) atLabel(l) +#define fix(a) addrAt(a) = fixups[labAt(a)] + +static Void local asSTART() { /* initialise assembler */ + fixups[0] = noMatch; + nextLab = 1; + startInstr = getMem(0); + lastInstr = startInstr-1; + srsp = 0; + offsPosn[0] = 0; +} + +static Label local newLabel(d) /* allocate new label */ +Label d; { + if (d==RUNON) { + if (nextLab>=NUM_FIXUPS) { + ERROR(0) "Compiled code too complex" + EEND; + } + return nextLab++; + } + return d; +} + +static Void local asEND() { /* Fix addresses in assembled code */ + Addr pc = startInstr; + + while (pc<=lastInstr) + switch (instrAt(pc)) { + case iEVAL : /* opcodes taking no arguments */ + case iFAIL : + case iRETURN : pc++; + break; + + case iGOTO : fix(pc+1); /* opcodes taking one argument */ + case iSETSTK : + case iALLOC : + case iSLIDE : + case iROOT : + case iDICT : + case iLOAD : + case iCELL : + case iCHAR : + case iINT : +#if !BREAK_FLOATS + case iFLOAT : +#endif + case iSTRING : + case iMKAP : + case iUPDATE : + case iUPDAP : pc+=2; + break; +#if BREAK_FLOATS + case iFLOAT : pc+=3; + break; +#endif + + case iINTEQ : /* opcodes taking two arguments */ +#if NPLUSK + case iINTGE : + case iINTDV : +#endif + case iTEST : fix(pc+2); + pc+=3; + break; + + default : internal("fixAddrs"); + } +} + +/* -------------------------------------------------------------------------- + * Assembler Opcodes: (includes simple peephole optimisations) + * ------------------------------------------------------------------------*/ + +#define asINTEGER(n) instrInt(iINT,n); srsp++ +#define asFLOAT(fl) instrFloat(iFLOAT,fl); srsp++ +#define asSTRING(t) instrText(iSTRING,t); srsp++ +#define asCHAR(n) instrInt(iCHAR,n); srsp++ +#define asLOAD(n) instrInt(iLOAD,n); srsp++ +#define asALLOC(n) instrInt(iALLOC,n); srsp+=n +#define asROOT(n) instrInt(iROOT,n); srsp++ +#define asSETSTK(n) instrInt(iSETSTK,n); srsp=n +#define asEVAL() instrNone(iEVAL); srsp-- /* inaccurate srsp */ +#define asRETURN() instrNone(iRETURN) +#define asCELL(c) instrCell(iCELL,c); srsp++ +#define asTEST(c,l) instrCellLab(iTEST,c,l) /* inaccurate srsp */ +#define asINTEQ(n,l) instrIntLab(iINTEQ,n,l) +#if NPLUSK +#define asINTGE(n,l) instrIntLab(iINTGE,n,l) /* inaccurate srsp */ +#define asINTDV(n,l) instrIntLab(iINTDV,n,l) /* inaccurate srsp */ +#endif +#define asFAIL() instrNone(iFAIL) + +static Void local asDICT(n) /* pick element of dictionary */ +Int n; { +/* Sadly, the following optimisation cannot be used unless CELL references + * in compiled code are garbage collected (and possibly modified when cell + * indirections are found). + * + * if (instrAt(lastInstr)==iCELL) + * -- Peephole optimisation: CELL {dict m};DICT n ==> CELL dict(m+n) + * if (whatIs(cellAt(lastInstr+1))==DICTCELL) + * cellAt(lastInstr+1) = dict(dictOf(cellAt(lastInstr+1))+n); + * else + * internal("asDICT"); + * else ... + */ + if (n!=0) /* optimisation:DICT 0 has no use */ + instrInt(iDICT,n); /* for std dictionary construction */ +} + +static Void local asSLIDE(n) /* Slide results down stack */ +Int n; { + if (instrAt(lastInstr)==iSLIDE) /* Peephole optimisation: */ + intAt(lastInstr+1)+=n; /* SLIDE n;SLIDE m ===> SLIDE (n+m)*/ + else + instrInt(iSLIDE,n); + srsp -= n; +} + +static Void local asMKAP(n) /* Make application nodes ... */ +Int n; { + if (instrAt(lastInstr)==iMKAP) /* Peephole optimisation: */ + intAt(lastInstr+1)+=n; /* MKAP n; MKAP m ===> MKAP (n+m) */ + else + instrInt(iMKAP,n); + srsp -= n; +} + +static Void local asUPDATE(n) /* Update node ... */ +Int n; { + if (instrAt(lastInstr)==iMKAP) { /* Peephole optimisations: */ + if (intAt(lastInstr+1)>1) { /* MKAP (n+1); UPDATE p */ + intAt(lastInstr+1)--; /* ===> MKAP n; UPDAP p */ + instrInt(iUPDAP,n); + } + else { + instrAt(lastInstr) = iUPDAP; + intAt(lastInstr+1) = n; /* MKAP 1; UPDATE p ===> UPDAP p */ + } + } + else + instrInt(iUPDATE,n); + srsp--; +} + +static Void local asGOTO(l) /* End evaluation of expr in manner*/ +Label l; { /* indicated by label l */ + switch (l) { /* inaccurate srsp */ + case UPDRET : asUPDATE(0); + case VALRET : asRETURN(); + case RUNON : break; + default : instrLab(iGOTO,l); + break; + } +} + +/* -------------------------------------------------------------------------- + * Dissassembler: + * ------------------------------------------------------------------------*/ + +#ifdef DEBUG_CODE +#define printAddr(a) printf("0x%04X",a)/* printable representation of Addr */ + +static Void local dissassemble(pc,end) /* print dissassembly of code */ +Addr pc; +Addr end; { + while (pc<=end) { + printAddr(pc); + printf("\t"); + switch (instrAt(pc)) { + case iLOAD : pc = dissInt(pc,"LOAD"); break; + case iCELL : pc = dissCell(pc,"CELL"); break; + case iCHAR : pc = dissInt(pc,"CHAR"); break; + case iINT : pc = dissInt(pc,"INT"); break; + case iFLOAT : pc = dissFloat(pc,"FLOAT"); break; + case iSTRING : pc = dissText(pc,"STRING"); break; + case iMKAP : pc = dissInt(pc,"MKAP"); break; + case iUPDATE : pc = dissInt(pc,"UPDATE"); break; + case iUPDAP : pc = dissInt(pc,"UPDAP"); break; + case iEVAL : pc = dissNone(pc,"EVAL"); break; + case iRETURN : pc = dissNone(pc,"RETURN"); break; + case iINTEQ : pc = dissIntAddr(pc,"INTEQ"); break; +#if NPLUSK + case iINTGE : pc = dissIntAddr(pc,"INTGE"); break; + case iINTDV : pc = dissIntAddr(pc,"INTDV"); break; +#endif + case iTEST : pc = dissCellAddr(pc,"TEST"); break; + case iGOTO : pc = dissAddr(pc,"GOTO"); break; + case iSETSTK : pc = dissInt(pc,"SETSTK"); break; + case iALLOC : pc = dissInt(pc,"ALLOC"); break; + case iSLIDE : pc = dissInt(pc,"SLIDE"); break; + case iROOT : pc = dissInt(pc,"ROOT"); break; + case iDICT : pc = dissInt(pc,"DICT"); break; + case iFAIL : pc = dissNone(pc,"FAIL"); break; + default : internal("unknown instruction"); + } + } +} + +static Void local printCell(c) /* printable representation of Cell */ +Cell c; { + if (isName(c)) + printf("%s",textToStr(name(c).text)); + else + printf("$%d",c); +} + +static Addr local dissNone(pc,s) /* dissassemble instr no args */ +Addr pc; +String s; { + printf("%s\n",s); + return pc+1; +} + +static Addr local dissInt(pc,s) /* dissassemble instr with Int arg */ +Addr pc; +String s; { + printf("%s\t%d\n",s,intAt(pc+1)); + return pc+2; +} + +static Addr local dissFloat(pc,s) /* dissassemble instr with Float arg*/ +Addr pc; +String s; { +#if BREAK_FLOATS + printf("%s\t%s\n",s, + floatToString(floatFromParts(cellAt(pc+1),cellAt(pc+2)))); + return pc+3; +#else + printf("%s\t%s\n",s,floatToString((FloatPro)floatAt(pc+1))); + return pc+2; +#endif +} + +static Addr local dissCell(pc,s) /* dissassemble instr with Cell arg */ +Addr pc; +String s; { + printf("%s\t",s); + printCell(cellAt(pc+1)); + printf("\n"); + return pc+2; +} + +static Addr local dissText(pc,s) /* dissassemble instr with Text arg */ +Addr pc; +String s; { + printf("%s\t%s\n",s,textToStr(textAt(pc+1))); + return pc+2; +} + +static Addr local dissAddr(pc,s) /* dissassemble instr with Addr arg */ +Addr pc; +String s; { + printf("%s\t",s); + printAddr(addrAt(pc+1)); + printf("\n"); + return pc+2; +} + +static Addr local dissIntAddr(pc,s) /* dissassemble instr with Int/Addr */ +Addr pc; +String s; { + printf("%s\t%d\t",s,intAt(pc+1)); + printAddr(addrAt(pc+2)); + printf("\n"); + return pc+3; +} + +static Addr local dissCellAddr(pc,s) /* dissassemble instr with Cell/Addr*/ +Addr pc; +String s; { + printf("%s\t",s); + printCell(cellAt(pc+1)); + printf("\t"); + printAddr(addrAt(pc+2)); + printf("\n"); + return pc+3; +} +#endif + +/* -------------------------------------------------------------------------- + * Compile expression to code which will build expression without any + * evaluation. + * ------------------------------------------------------------------------*/ + +static Void local build(e,co) /* Generate code which will build */ +Cell e; /* instance of given expression but*/ +Int co; { /* perform no evaluation */ + Int n; + + switch (whatIs(e)) { + + case LETREC : n = buildLoc(fst(snd(e)),co); + build(snd(snd(e)),co+n); + asSLIDE(n); + break; + + case FATBAR : build(snd(snd(e)),co); + build(fst(snd(e)),co); + asCELL(nameFatbar); + asMKAP(2); + break; + + case COND : build(thd3(snd(e)),co); + build(snd3(snd(e)),co); + build(fst3(snd(e)),co); + asCELL(nameIf); + asMKAP(3); + break; + + case GUARDED : buildGuards(snd(e),co); + break; + + case AP : buildAp(e,co,SHOULDNTFAIL,FALSE); + break; + + case UNIT : + case TUPLE : + case NAME : asCELL(e); + break; + + case DICTCELL : asCELL(dict(dictOf(e))); /* see comments for*/ + break; /* DICTCELL in make*/ + /* function below */ + case INTCELL : asINTEGER(intOf(e)); + break; + + case FLOATCELL : asFLOAT(floatOf(e)); + break; + + case STRCELL : asSTRING(textOf(e)); + break; + + case CHARCELL : asCHAR(charOf(e)); + break; + + case OFFSET : asLOAD(offsPosn[offsetOf(e)]); + break; + + default : internal("build"); + } +} + +static Void local buildGuards(gs,co) /* Generate code to compile list */ +List gs; /* of guards to a conditional expr */ +Int co; { /* without evaluation */ + if (isNull(gs)) { + asCELL(nameFail); + } + else { + buildGuards(tl(gs),co); + build(snd(hd(gs)),co); + build(fst(hd(gs)),co); + asCELL(nameIf); + asMKAP(3); + } +} + +static Int local buildLoc(vs,co) /* Generate code to build local var*/ +List vs; /* bindings on stack, with no eval*/ +Int co; { + Int n = length(vs); + Int i; + + for (i=1; i<=n; i++) + offsPosn[co+i] = srsp+i; + asALLOC(n); + for (i=1; i<=n; i++) { + build(hd(vs),co+n); + asUPDATE(offsPosn[co+i]); + vs = tl(vs); + } + return n; +} + +/* -------------------------------------------------------------------------- + * Compile expression to code which will build expression evaluating guards + * and testing cases to avoid building complete graph. + * ------------------------------------------------------------------------*/ + +#define makeTests(ct,tests,co,f,d) { Label l1 = newLabel(d); \ + List xs = tests; \ + while (nonNull(tl(xs))) { \ + Label l2 = newLabel(RUNON);\ + Int savesp = srsp; \ + ct(hd(xs),co,f,l2,l1); \ + atLabel(l2); \ + srsp = savesp; \ + xs = tl(xs); \ + } \ + ct(hd(xs),co,f,f,d); \ + endLabel(d,l1); \ + } + +static Void local make(e,co,f,d) /* Construct code to build e, given */ +Cell e; /* current offset co, and branch */ +Int co; /* to f on failure, d on completion */ +Label f; +Label d; { + switch (whatIs(e)) { + + case LETREC : { Int n = buildLoc(fst(snd(e)),co); + make(snd(snd(e)),co+n,f,RUNON); + asSLIDE(n); + asGOTO(d); + } + break; + + case FATBAR : { Label l1 = newLabel(RUNON); + Label l2 = newLabel(d); + Int savesp = srsp; + + make(fst(snd(e)),co,l1,l2); + + atLabel(l1); + srsp = savesp; + asSETSTK(srsp); + make(snd(snd(e)),co,f,l2); + + endLabel(d,l2); + } + break; + + case COND : makeCond(fst3(snd(e)), + snd3(snd(e)), + thd3(snd(e)),co,f,d); + break; + + case CASE : make(fst(snd(e)),co,SHOULDNTFAIL,RUNON); + asEVAL(); + makeTests(testCase,snd(snd(e)),co,f,d); + break; + + case GUARDED : makeTests(testGuard,snd(e),co,f,d); + break; + + case AP : if (andorOptimise) { + Cell h = getHead(e); + if (h==nameAnd && argCount==2) { + /* x && y ==> if x then y else False */ + makeCond(arg(fun(e)),arg(e),nameFalse,co,f,d); + break; + } + else if (h==nameOr && argCount==2) { + /* x || y ==> if x then True else y */ + makeCond(arg(fun(e)),nameTrue,arg(e),co,f,d); + break; + } + } + buildAp(e,co,f,TRUE); + asGOTO(d); + break; + + case UNIT : + case TUPLE : + case NAME : asCELL(e); + asGOTO(d); + break; + + /* for dict cells, ensure that CELL referred to in the code is the */ + /* dictionary cell at the head of the dictionary; not just a copy */ + + case DICTCELL : asCELL(dict(dictOf(e))); + asGOTO(d); + break; + + case INTCELL : asINTEGER(intOf(e)); + asGOTO(d); + break; + + case FLOATCELL : asFLOAT(floatOf(e)); + asGOTO(d); + break; + + case STRCELL : asSTRING(textOf(e)); + asGOTO(d); + break; + + case CHARCELL : asCHAR(charOf(e)); + asGOTO(d); + break; + + case OFFSET : asLOAD(offsPosn[offsetOf(e)]); + asGOTO(d); + break; + + default : internal("make"); + } +} + +static Void local makeCond(i,t,e,co,f,d)/* Build code for conditional */ +Cell i,t,e; +Int co; +Label f; +Label d; { + Label l1 = newLabel(RUNON); + Label l2 = newLabel(d); + Int savesp; + + make(i,co,f,RUNON); + asEVAL(); + + savesp = srsp; + asTEST(nameTrue,l1); + make(t,co,f,l2); + + srsp = savesp; + atLabel(l1); + make(e,co,f,l2); + + endLabel(d,l2); +} + +static Void local testGuard(g,co,f,cf,d)/* Produce code for guard */ +Pair g; +Int co; +Label f; +Label cf; +Label d; { + make(fst(g),co,SHOULDNTFAIL,RUNON); + asEVAL(); + asTEST(nameTrue,cf); + make(snd(g),co,f,d); +} + +static Void local testCase(c,co,f,cf,d) /* Produce code for guard */ +Pair c; +Int co; /* labels determine where to go if:*/ +Label f; /* match succeeds, but rest fails */ +Label cf; /* this match fails */ +Label d; { + Int n = discrArity(fst(c)); + Int i; + switch (whatIs(fst(c))) { + case INTCELL : asINTEQ(intOf(fst(c)),cf); + break; +#if NPLUSK + case ADDPAT : asINTGE(intValOf(fst(c)),cf); + break; + case MULPAT : asINTDV(intValOf(fst(c)),cf); + break; +#endif + case UNIT : /* typing guarantees that tags will*/ + case TUPLE : break; /* match without further tests */ + default : asTEST(fst(c),cf); + break; + } + for (i=1; i<=n; i++) + offsPosn[co+i] = ++srsp; + make(snd(c),co+n,f,d); +} + +/* -------------------------------------------------------------------------- + * We frequently encounter functions which call themselves recursively with + * a number of initial arguments preserved: + * e.g. (map f) [] = [] + * (map f) (x:xs) = f x : (map f) xs + * Lambda lifting, in particular, is likely to introduce such functions. + * Rather than reconstructing a new instance of the recursive function and + * its arguments, we can extract the relevant portion of the root of the + * current redex. + * + * The following functions implement this optimisation. + * ------------------------------------------------------------------------*/ + +static Int nonRoots; /* #args which can't get from root */ +static Int rootPortion; /* portion of root used ... */ +static Name definingName; /* name of func being defined,if any*/ +static Int definingArity; /* arity of definingName */ + +static Void local analyseAp(e) /* Determine if any portion of an */ +Cell e; { /* application can be built using a */ + if (isAp(e)) { /* portion of the root */ + analyseAp(fun(e)); + if (nonRoots==0 && rootPortion>1 + && isOffset(arg(e)) + && offsetOf(arg(e))==rootPortion-1) + rootPortion--; + else + nonRoots++; + } + else if (e==definingName) + rootPortion = definingArity+1; + else + rootPortion = 0; +} + +static Void local buildAp(e,co,f,str) /* Build application, making use of*/ +Cell e; /* root optimisation if poss. */ +Int co; +Label f; +Bool str; { + Int nr, rp, i; + + nonRoots = 0; + analyseAp(e); + nr = nonRoots; + rp = rootPortion; + + for (i=0; i0) { + asDICT(selectOf(e)); + } + } + else { + if (isName(e) && name(e).defn==MFUN) { + asDICT(name(e).number); + nr--; /* AP node for member function need never be built */ + } + else { + if (00) { + asMKAP(nr); + } + } +} + +/* -------------------------------------------------------------------------- + * Code generator entry point: + * ------------------------------------------------------------------------*/ + +Addr codeGen(n,arity,e) /* Generate code for expression e, */ +Name n; /* treating return value of CAFs */ +Int arity; /* differently to functs with args */ +Cell e; { + definingName = n; + definingArity = arity; + asSTART(); + if (nonNull(n)) { + Int i; + for (i=1; i<=arity; i++) + offsPosn[i] = ++srsp; + make(e,arity,noMatch,(arity>0 ? UPDRET : VALRET)); + } + else { + build(e,0); + asRETURN(); + } + asEND(); +#ifdef DEBUG_CODE + if (nonNull(n)) + printf("name=%s\n",textToStr(name(n).text)); + dissassemble(startInstr,lastInstr); + printf("------------------\n"); +#endif + if (nonNull(n)) + name(n).defn = NIL; + return startInstr; +} + +Void externalPrim(n,s) /* Add name n as an external primitive; */ +Name n; /* This is not currently implemented in */ +String s; { /* the current version of the interpreter */ + ERROR(name(n).line) "Unknown primitive reference \"%s\"", s + EEND; +} + +/* -------------------------------------------------------------------------- + * Evaluator: + * ------------------------------------------------------------------------*/ + +Int whnfArgs; /* number of arguments of whnf term */ +Cell whnfHead; /* head cell of term in whnf */ +Int whnfInt; /* value of INTCELL (in whnf) */ +Float whnfFloat; /* value of FLOATCELL (in whnf) */ +Long numReductions; /* number of reductions counted */ + +static Cell errorRedex; /* irreducible error expression */ +static jmp_buf *evalError = 0; /* jump buffer for eval errors */ + +Void eval(n) /* Graph reduction evaluator */ +Cell n; { + StackPtr base = sp; + Int ar; + +unw:switch (whatIs(n)) { /* unwind spine of application */ + + case AP : push(n); + n = fun(n); + goto unw; + + case INDIRECT : n = arg(n); + allowBreak(); + goto unw; + + case NAME : ar = name(n).arity; + if (name(n).defn!=CFUN && sp-base>=ar) { + allowBreak(); + if (ar>0) { /* fn with args*/ + StackPtr root; + + push(NIL); /* rearrange */ + root = sp; + do { + stack(root) = arg(stack(root-1)); + --root; + } while (--ar>0); + + if (name(n).primDef) /* reduce */ + (*name(n).primDef)(root); + else + run(name(n).code,root); + + numReductions++; + + sp = root; /* continue... */ + n = pop(); + } + else { /* CAF */ + if (isNull(name(n).defn)) {/* build CAF */ + push(n); /* save CAF */ + + if (name(n).primDef) + (*name(n).primDef)(sp); + else + run(name(n).code,sp); + + numReductions++; + + name(n).defn = pop(); + drop(); /* drop CAF */ + } + n = name(n).defn; /*already built*/ + if (sp>base) + fun(top()) = n; + } + goto unw; + } + break; + + case INTCELL : whnfInt = intOf(n); + break; + + case FLOATCELL : whnfFloat = floatOf(n); + break; + + case STRCELL : evalString(n); + goto unw; + + case FILECELL : evalFile(n); + goto unw; + } + + whnfHead = n; /* rearrange components of term on */ + whnfArgs = sp - base; /* stack, now in whnf ... */ + for (ar=whnfArgs; ar>0; ar--) { + fun(stack(base+ar)) = n; + n = stack(base+ar); + stack(base+ar) = arg(n); + } +} + +Void unwind(n) /* unwind spine of application; */ +Cell n; { /* like eval except that we always */ + whnfArgs = 0; /* treat the expression n as if it */ + /* were already in whnf. */ +unw:switch (whatIs(n)) { + case AP : push(arg(n)); + whnfArgs++; + n = fun(n); + goto unw; + + case INDIRECT : n = arg(n); + allowBreak(); + goto unw; + + case INTCELL : whnfInt = intOf(n); + break; + + case FLOATCELL : whnfFloat = floatOf(n); + break; + + case STRCELL : evalString(n); + goto unw; + } + whnfHead = n; +} + +static Void local evalString(n) /* expand STRCELL at node n */ +Cell n; { + Text t = textOf(n); + Int c = textToStr(t)[0]; + if (c==0) { + fst(n) = INDIRECT; + snd(n) = nameNil; + return; + } + else if (c=='\\') { + c = textToStr(++t)[0]; + if (c!='\\') + c = 0; + } + fst(n) = consChar(c); + snd(n) = mkStr(++t); +} + +static Void local run(start,root) /* execute code beginning at given */ +Addr start; /* address with local stack starting*/ +StackPtr root; { /* at given root offset */ + register Memory pc = memory+start; + +#if GCC_THREADED +#define Ins(x) &&l##x +static void *labs[] = { INSTRLIST }; +#undef Ins +#define Case(x) l##x +#define Continue goto *labs[(pc++)->instr] +#define Dispatch Continue; +#define EndDispatch +#else +#define Dispatch for (;;) switch((pc++)->instr) { +#define Case(x) case x +#define Continue continue +#define EndDispatch default : internal("illegal instruction"); \ + break; \ + } +#endif + + Dispatch + + Case(iLOAD) : push(stack(root+pc->mint)); /* load from stack*/ + pc++; + Continue; + + Case(iCELL) : push(pc->cell); /* load const Cell*/ + pc++; + Continue; + + Case(iCHAR) : push(mkChar(pc->mint)); /* load char const*/ + pc++; + Continue; + + Case(iINT) : push(mkInt(pc->mint)); /* load int const */ + pc++; + Continue; + +#if BREAK_FLOATS + Case(iFLOAT) : push(mkFloat(floatFromParts /* load dbl const */ + (pc->cell,(pc+1)->cell))); + pc+=2; + Continue; +#else + Case(iFLOAT) : push(mkFloat(pc->mfloat)); /* load float cnst*/ + pc++; + Continue; +#endif + + Case(iSTRING) : push(mkStr(pc->text)); /* load str const */ + pc++; + Continue; + + Case(iMKAP) : { Cell t = pushed(0); /* make AP nodes */ + Int i = pc->text; + while (0mint); + fst(t) = INDIRECT; + snd(t) = pop(); + } + pc++; + Continue; + + Case(iUPDAP) : { Cell t = stack(root /* update AP node */ + + pc->mint); + fst(t) = pop(); + snd(t) = pop(); + } + pc++; + Continue; + + Case(iEVAL) : eval(pop()); /* evaluate top() */ + Continue; + + Case(iRETURN) : return; /* terminate */ + + Case(iINTEQ) : if (whnfInt==pc->mint) /* test integer ==*/ + pc += 2; + else + pc = memory + (pc+1)->addr; + Continue; + +#if NPLUSK + Case(iINTGE) : if (whnfInt>=pc->mint) { /* test integer >=*/ + push(mkInt(whnfInt-pc->mint)); + pc += 2; + } + else + pc = memory + (pc+1)->addr; + Continue; + + Case(iINTDV) : if (whnfInt>=0 && /* test for mult */ + (whnfInt%(pc->mint)==0)) { + push(mkInt(whnfInt/(pc->mint))); + pc += 2; + } + else + pc = memory + (pc+1)->addr; + Continue; +#endif + + Case(iTEST) : if (whnfHead==pc->cell) /* test for cell */ + pc += 2; + else + pc = memory + (pc+1)->addr; + Continue; + + Case(iGOTO) : pc = memory + pc->addr; /* goto label */ + Continue; + + Case(iSETSTK) : sp=root + pc->mint; /* set stack ptr */ + pc++; + Continue; + + Case(iALLOC) : { Int i = pc->mint; /* alloc loc vars */ + chkStack(i); + while (0mint); + pc++; /* dict lookup */ + Continue; + + Case(iROOT) : { Cell t = stack(root); /* partial root */ + Int i = pc->mint; + while (fst(t)==INDIRECT) { + allowBreak(); + t = arg(t); + } + while (0mint) = top(); /* remove loc vars*/ + sp -= pc->mint; + pc++; + Continue; + + Case(iFAIL) : evalFails(root); /* cannot reduce */ + return;/*NOT REACHED*/ + + EndDispatch + +#undef Dispatch +#undef Case +#undef Continue +#undef EndDispatch +} + +Cell evalWithNoError(e) /* Evaluate expression, returning */ +Cell e; { /* NIL if successful, irreducible */ + Cell badRedex; /* expression if not... */ + jmp_buf *oldCatch = evalError; + +#if JMPBUF_ARRAY + jmp_buf catch[1]; + evalError = catch; + if (setjmp(catch[0])==0) { + eval(e); + badRedex = NIL; + } + else + badRedex = errorRedex; +#else + jmp_buf catch; + evalError = &catch; + if (setjmp(catch)==0) { + eval(e); + badRedex = NIL; + } + else + badRedex = errorRedex; +#endif + + evalError = oldCatch; + return badRedex; +} + +Void evalFails(root) /* Eval of current redex fails */ +StackPtr root; { + errorRedex = stack(root); /* get error & bypass indirections */ + while (isPair(errorRedex) && fst(errorRedex)==INDIRECT) + errorRedex = snd(errorRedex); + + if (failOnError) + abandon("Program",errorRedex); + else if (evalError) + longjmp(*evalError,1); + else + internal("uncaught eval error"); +} + +Cell graphForExp() { /* Build graph for expression to be*/ + clearStack(); /* reduced... */ + run(inputCode,sp); + return pop(); +} + +/* -------------------------------------------------------------------------- + * Machine control: + * ------------------------------------------------------------------------*/ + +Void machine(what) +Int what; { + switch (what) { + case INSTALL : machine(RESET); + memory = (Memory)farCalloc(NUM_ADDRS,sizeof(MemCell)); + if (memory==0) + fatal("Cannot allocate program memory"); + instrNone(iFAIL); + noMatch = lastInstr; + break; + } +} + +/* ------------------------------------------------------------------------*/ diff --git a/src/markscan.c b/src/markscan.c new file mode 100644 index 0000000..c741fd7 --- /dev/null +++ b/src/markscan.c @@ -0,0 +1,223 @@ +/* -------------------------------------------------------------------------- + * markscan.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Mark scan garbage collector, optionally used for gofc runtime system. + * ------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Simple mark scan garbage collector based on the allocator and garbage + * collector used in the full interpreter. An important difference between + * the two systems is that the Gofer compiler (i.e. this program) does not + * use conservative garbage collection (there is no need to scan the C runtime + * stack). Obviously, this is a BIG improvement in terms of portability! + * Another advantage is that the garbage collector given here can be + * upgraded to use a more sophisticated algorithm (for example, some form + * of compacting collector, possibly stop/copy), thus avoiding the need + * for a free list and permitting extensions requiring variable length + * cells (arrays perhaps?). The basic reason for this flexibility is the + * fact that any cell may now be relocated during garbage collection. + * ------------------------------------------------------------------------*/ + +static Void heapInit Args((Void)); +static Void markPhase Args((Void)); +static Void scanPhase Args((Void)); +static Cell markCell Args((Cell)); +static Void markSnd Args((Cell)); + +Int heapSize = DEFAULTHEAP; /* number of cells in heap */ +#ifndef GLOBALfst +Heap heapTopFst; /* tops of heap arrays */ +#endif +#ifndef GLOBALsnd +Heap heapTopSnd; +#endif +static Heap heapFst, heapSnd; /* bases of each heap array */ +static Cell freeList; /* free list of unused cells */ +static Int *marks; /* `Mark set' used during GC to */ +static Int marksSize; /* flag visited (active) cells */ +#define mark(c) c=markCell(c) /* mark graph and save new pointer */ + +static Void heapInit() { /* initialise heap storage */ + Int i; + + heapFst = (Heap)(farCalloc(heapSize,sizeof(Cell))); + heapSnd = (Heap)(farCalloc(heapSize,sizeof(Cell))); + if (heapFst==(Heap)0 || heapSnd==(Heap)0) + abandon("Cannot allocate heap storage"); + heapTopFst = heapFst + heapSize; + heapTopSnd = heapSnd + heapSize; + for (i=1; i MAXBOXTAG) + markSnd(c); + + return c; +} + +static Void markSnd(c) /* Variant of markCell used to */ +Cell c; { /* update snd component of cell */ + Cell t; /* using tail recursion */ + +ma: t = snd(c); +mb: if (!isPair(t)) + return; + + if (fst(t)==INDIRECT) { + snd(c) = t = snd(t); + goto mb; + } + c = snd(c) = t; + + { register place = placeInSet(c); + register mask = maskInSet(c); + if (marks[place]&mask) + return; + else + marks[place] |= mask; + } + + if (isPair(fst(c))) { + fst(c) = markCell(fst(c)); + goto ma; + } + else if (fst(c) > MAXBOXTAG) + goto ma; + return; +} + +/* -------------------------------------------------------------------------- + * Arrays (implemented using linked lists of cells: + * ------------------------------------------------------------------------*/ + +#if HASKELL_ARRAYS +Void allocArray(n,bds,z) /* allocate array of cells */ +Int n; /* n = length of array (assume>=0) */ +Cell bds; /* bds = bounds */ +Cell z; { /* z = default value */ + onto(cfunNil); + while (n-- > 0) { + heap(1); + topfun(z); + } + heap(2); + topfun(bds); + topfun(ARRAY); +} + +Void dupArray(a) /* duplicate array */ +Cell a; { + for (onto(cfunNil); isPair(a); a=snd(a)) + topfun(fst(a)); + a = cfunNil; + while (isPair(top())) { + Cell tmp = snd(top()); + snd(top()) = a; + a = top(); + top() = tmp; + } + top() = a; +} +#endif + +/*-------------------------------------------------------------------------*/ diff --git a/src/output.c b/src/output.c new file mode 100644 index 0000000..b7bdfc9 --- /dev/null +++ b/src/output.c @@ -0,0 +1,1174 @@ +/* -------------------------------------------------------------------------- + * output.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Unparse expressions and types - for use in error messages, type checker + * and for debugging. + * ------------------------------------------------------------------------*/ + +#ifndef GOFC_OUTPUT +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "errors.h" +#include +#endif + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local putChr Args((Int)); +static Void local putStr Args((String)); +static Void local putInt Args((Int)); +static Void local indent Args((Int)); + +static Void local put Args((Int,Cell)); +static Void local putComp Args((Cell,List)); +static Void local putQual Args((Cell)); +static Bool local isDictVal Args((Cell)); +static Cell local maySkipDict Args((Cell)); +static Void local putAp Args((Int,Cell)); +static Void local putOverInfix Args((Int,Text,Syntax,Cell)); +static Void local putInfix Args((Int,Text,Syntax,Cell,Cell)); +static Void local putSimpleAp Args((Cell)); +static Void local putTuple Args((Int,Cell)); +static Int local unusedTups Args((Int,Cell)); +static Void local unlexVar Args((Text)); +static Void local unlexOp Args((Text)); +static Void local unlexCharConst Args((Cell)); +static Void local unlexStrConst Args((Text)); + +#ifdef GOFC_OUTPUT +static Void local pPut Args((Int,Cell,Int)); +static Void local pPutAp Args((Int,Cell,Int)); +static Void local pPutSimpleAp Args((Cell,Int)); +static Void local pPutTuple Args((Int,Cell,Int)); +static Int local punusedTups Args((Int,Cell,Int)); +static Void local pPutOffset Args((Int)); +static Int local pPutLocals Args((List,Int)); +static Void local pLiftedStart Args((Cell,Int,String)); +static Void local pLifted Args((Cell,Int,String)); +static Int local pDiscr Args((Cell,Int)); +#endif + +static Void local putSigType Args((Cell)); +static Void local putContext Args((List)); +static Void local putPred Args((Cell)); +static Void local putType Args((Cell,Int)); +static Void local putTyVar Args((Int)); +static Bool local putTupleType Args((Cell)); +static Void local putApType Args((Type)); + +static Void local putKind Args((Kind)); +static Void local putSig Args((Cell)); + +/* -------------------------------------------------------------------------- + * Basic output routines: + * ------------------------------------------------------------------------*/ + +static FILE *outputStream; /* current output stream */ +static Int outColumn = 0; /* current output column number */ +Bool showDicts = FALSE; /* TRUE => include dictionary vars */ + /* in output expressions */ + +#define OPEN(b) if (b) putChr('('); +#define CLOSE(b) if (b) putChr(')'); + +static Void local putChr(c) /* print single character */ +Int c; { + putc(c,outputStream); + outColumn++; +} + +static Void local putStr(s) /* print string */ +String s; { + for (; *s; s++) { + putc(*s,outputStream); + outColumn++; + } +} + +static Void local putInt(n) /* print integer */ +Int n; { + static char intBuf[16]; + sprintf(intBuf,"%d",n); + putStr(intBuf); +} + +static Void local indent(n) /* indent to particular position */ +Int n; { + outColumn = n; + while (0 in type exprs */ +#define COCO_PREC (MIN_PREC-1) /* :: is left assoc, low precedence */ +#define COND_PREC (MIN_PREC-2) /* conditional expressions */ +#define WHERE_PREC (MIN_PREC-3) /* where expressions */ +#define LAM_PREC (MIN_PREC-4) /* lambda abstraction */ +#define NEVER LAM_PREC /* Never use parentheses */ + + +/* -------------------------------------------------------------------------- + * Print an expression (used to display context of type errors): + * ------------------------------------------------------------------------*/ + +static Int putDepth = 0; /* limits depth of printing DBG */ + +static Void local put(d,e) /* print expression e in context of */ +Int d; /* operator of precedence d */ +Cell e; { + List xs; + + if (putDepth>10) { + putStr("..."); + return; + } + else + putDepth++; + + switch (whatIs(e)) { + case FINLIST : putChr('['); + xs = snd(e); + if (nonNull(xs)) { + put(NEVER,hd(xs)); + while (nonNull(xs=tl(xs))) { + putChr(','); + put(NEVER,hd(xs)); + } + } + putChr(']'); + break; + + case AP : putAp(d,e); + break; + + case NAME : unlexVar(name(e).text); + break; + + case VARIDCELL : + case VAROPCELL : + case DICTVAR : + case CONIDCELL : + case CONOPCELL : unlexVar(textOf(e)); + break; + + case DICTCELL : putStr("{dict"); + putInt(dictOf(e)); + putChr('}'); + break; + + case SELECT : putStr("#"); + putInt(selectOf(e)); + break; + + case UNIT : putStr("()"); + break; + + case TUPLE : putTuple(tupleOf(e),e); + break; + + case WILDCARD : putChr('_'); + break; + + case ASPAT : put(NEVER,fst(snd(e))); + putChr('@'); + put(ALWAYS,snd(snd(e))); + break; + + case LAZYPAT : putChr('~'); + put(ALWAYS,snd(e)); + break; + + case MONADCOMP : putComp(fst(snd(snd(e))),snd(snd(snd(e)))); + break; + +#if DO_COMPS + case DOCOMP : putStr("do {...}"); + break; +#endif + + case COMP : + case LISTCOMP : putComp(fst(snd(e)),snd(snd(e))); + break; + + case CHARCELL : unlexCharConst(charOf(e)); + break; + + case INTCELL : putInt(intOf(e)); + break; + + case FLOATCELL : putStr(floatToString(floatOf(e))); + break; + + case STRCELL : unlexStrConst(textOf(e)); + break; + + case LETREC : OPEN(d>WHERE_PREC); +#ifdef DEBUG_CODE + putStr("let {"); + put(NEVER,fst(snd(e))); + putStr("} in "); +#else + putStr("let {...} in "); +#endif + put(WHERE_PREC+1,snd(snd(e))); + CLOSE(d>WHERE_PREC); + break; + + case COND : OPEN(d>COND_PREC); + putStr("if "); + put(COND_PREC+1,fst3(snd(e))); + putStr(" then "); + put(COND_PREC+1,snd3(snd(e))); + putStr(" else "); + put(COND_PREC+1,thd3(snd(e))); + CLOSE(d>COND_PREC); + break; + +#if IO_MONAD + case RUNST : OPEN(d>=FUN_PREC); + putStr("runST "); + put(ALWAYS,snd(e)); + CLOSE(d>=FUN_PREC); + break; +#endif + + case LAMBDA : xs = fst(snd(e)); + if (!showDicts) { + while (nonNull(xs) && isDictVal(hd(xs))) + xs = tl(xs); + if (isNull(xs)) { + put(d,snd(snd(snd(e)))); + break; + } + } + OPEN(d>LAM_PREC); + putChr('\\'); + if (nonNull(xs)) { + put(ALWAYS,hd(xs)); + while (nonNull(xs=tl(xs))) { + putChr(' '); + put(ALWAYS,hd(xs)); + } + } + putStr(" -> "); + put(LAM_PREC,snd(snd(snd(e)))); + CLOSE(d>LAM_PREC); + break; + + case ESIGN : OPEN(d>COCO_PREC); + put(COCO_PREC,fst(snd(e))); + putStr(" :: "); + putSigType(snd(snd(e))); + CLOSE(d>COCO_PREC); + break; + + case CASE : putStr("case "); + put(NEVER,fst(snd(e))); +#ifdef DEBUG_CODE + putStr(" of {"); + put(NEVER,snd(snd(e))); + putChr('}'); +#else + putStr(" of {...}"); +#endif + break; + + case INDIRECT : putChr('^'); + put(ALWAYS,snd(e)); + break; + + default : /*internal("put");*/ + putChr('$'); + putInt(e); + break; + } + putDepth--; +} + +static Void local putComp(e,qs) /* print comprehension */ +Cell e; +List qs; { + putStr("[ "); + put(NEVER,e); + if (nonNull(qs)) { + putStr(" | "); + putQual(hd(qs)); + while (nonNull(qs=tl(qs))) { + putStr(", "); + putQual(hd(qs)); + } + } + putStr(" ]"); +} + +static Void local putQual(q) /* print list comp qualifier */ +Cell q; { + switch (whatIs(q)) { + case BOOLQUAL : put(NEVER,snd(q)); + return; + + case QWHERE : putStr("let {...}"); + return; + + case FROMQUAL : put(ALWAYS,fst(snd(q))); + putStr("<-"); + put(NEVER,snd(snd(q))); + return; + } +} + +static Bool local isDictVal(e) /* Look for dictionary value */ +Cell e; { + switch (whatIs(e)) { + case AP : return isSelect(fun(e)); + case DICTCELL : + case DICTVAR : return TRUE; + } + return FALSE; +} + +static Cell local maySkipDict(e) /* descend function application */ +Cell e; { /* possibly ignoring dict aps */ + if (!showDicts) + while (isAp(e) && isDictVal(arg(e))) + e = fun(e); + return e; +} + +static Void local putAp(d,e) /* print application (args>=1) */ +Int d; +Cell e; { + Bool anyDictArgs = FALSE; + Cell h; + Text t; + Syntax sy; + Int args = 0; + + for (h=e; isAp(h); h=fun(h)) /* find head of expression, looking*/ + if (isDictVal(arg(h))) { /* for dictionary arguments */ + anyDictArgs = TRUE; + if (showDicts) + args++; + } + else + args++; + + if (args==0) { /* Special case when *all* args */ + put(d,h); /* are dictionary values */ + return; + } + + switch (whatIs(h)) { +#if NPLUSK + case ADDPAT : if (args==1) + putInfix(d,textPlus,syntaxOf(textPlus), + arg(e),mkInt(intValOf(fun(e)))); + else + putStr("ADDPAT"); + return; + + case MULPAT : if (args==1) + putInfix(d,textMult,syntaxOf(textMult), + mkInt(intValOf(fun(e))),arg(e)); + else + putStr("MULPAT"); + return; +#endif + + case TUPLE : OPEN(args>tupleOf(h) && d>=FUN_PREC); + putTuple(tupleOf(h),e); + CLOSE(args>tupleOf(h) && d>=FUN_PREC); + return; + + case NAME : sy = syntaxOf(t = name(h).text); + break; + case VARIDCELL : + case VAROPCELL : + case DICTVAR : + case CONIDCELL : + case CONOPCELL : sy = syntaxOf(t = textOf(h)); + break; + + default : sy = APPLIC; + break; + } + + e = maySkipDict(e); + if (showDicts && anyDictArgs) /* expressions involving dicts */ + sy = APPLIC; /* are printed applicatively */ + + if (sy==APPLIC) { /* print simple application */ + OPEN(d>=FUN_PREC); + putSimpleAp(e); + CLOSE(d>=FUN_PREC); + return; + } + else if (args==1) { /* print section of the form (e+) */ + putChr('('); + put(FUN_PREC-1,arg(e)); + putChr(' '); + unlexOp(t); + putChr(')'); + } + else if (args==2) /* infix expr of the form e1 + e2 */ + putInfix(d,t,sy,arg(maySkipDict(fun(e))),arg(e)); + else { /* o/w (e1 + e2) e3 ... en (n>=3) */ + OPEN(d>=FUN_PREC); + putOverInfix(args,t,sy,e); + CLOSE(d>=FUN_PREC); + } +} + +static Void local putOverInfix(args,t,sy,e) +Int args; /* infix applied to >= 3 arguments */ +Text t; +Syntax sy; +Cell e; { + if (args>2) { + putOverInfix(args-1,t,sy,maySkipDict(fun(e))); + putChr(' '); + put(FUN_PREC,arg(e)); + } + else + putInfix(ALWAYS,t,sy,arg(maySkipDict(fun(e))),arg(e)); +} + +static Void local putInfix(d,t,sy,e,f) /* print infix expression */ +Int d; +Text t; /* Infix operator symbol */ +Syntax sy; /* with name t, syntax s */ +Cell e, f; { /* Left and right operands */ + Syntax a = assocOf(sy); + Int p = precOf(sy); + + OPEN(d>p); + put((a==LEFT_ASS ? p : 1+p), e); + putChr(' '); + unlexOp(t); + putChr(' '); + put((a==RIGHT_ASS ? p : 1+p), f); + CLOSE(d>p); +} + +static Void local putSimpleAp(e) /* print application e0 e1 ... en */ +Cell e; { + if (isAp(e)) { + putSimpleAp(maySkipDict(fun(e))); + putChr(' '); + put(FUN_PREC,arg(e)); + } + else + put(FUN_PREC,e); +} + +static Void local putTuple(ts,e) /* Print tuple expression, allowing*/ +Int ts; /* for possibility of either too */ +Cell e; { /* few or too many args to constr */ + Int i; + putChr('('); + if ((i=unusedTups(ts,e))>0) { + while (--i>0) + putChr(','); + putChr(')'); + } +} + +static Int local unusedTups(ts,e) /* print first part of tuple expr */ +Int ts; /* returning number of constructor */ +Cell e; { /* args not yet printed ... */ + if (isAp(e)) { + if ((ts=unusedTups(ts,fun(e))-1)>=0) { + put(NEVER,arg(e)); + putChr(ts>0?',':')'); + } + else { + putChr(' '); + put(FUN_PREC,arg(e)); + } + } + return ts; +} + +static Void local unlexVar(t) /* print text as a variable name */ +Text t; { /* operator symbols must be enclosed*/ + String s = textToStr(t); /* in parentheses... except [] ... */ + + if ((isascii(s[0]) && isalpha(s[0])) || s[0]=='_' || strcmp(s,"[]")==0) + putStr(s); + else { + putChr('('); + putStr(s); + putChr(')'); + } +} + +static Void local unlexOp(t) /* print text as operator name */ +Text t; { /* alpha numeric symbols must be */ + String s = textToStr(t); /* enclosed by backquotes */ + + if (isascii(s[0]) && isalpha(s[0])) { + putChr('`'); + putStr(s); + putChr('`'); + } + else + putStr(s); +} + +static Void local unlexCharConst(c) +Cell c; { + putChr('\''); + putStr(unlexChar(c,'\'')); + putChr('\''); +} + +static Void local unlexStrConst(t) +Text t; { + String s = textToStr(t); + static Char SO = 14; /* ASCII code for '\SO' */ + Bool lastWasSO = FALSE; + Bool lastWasDigit = FALSE; + Bool lastWasEsc = FALSE; + + putChr('\"'); + for (; *s; s++) { + String ch = unlexChar(*s,'\"'); + Char c = ' '; + + if ((lastWasSO && *ch=='H') || + (lastWasEsc && lastWasDigit && isascii(*ch) && isdigit(*ch))) + putStr("\\&"); + + lastWasEsc = (*ch=='\\'); + lastWasSO = (*s==SO); + for (; *ch; c = *ch++) + putChr(*ch); + lastWasDigit = (isascii(c) && isdigit(c)); + } + putChr('\"'); +} + +/* -------------------------------------------------------------------------- + * Pretty printer for supercombinator definitions: + * i.e. for lambda-lifter output, immediately prior to code generation. + * ------------------------------------------------------------------------*/ + +#ifdef GOFC_OUTPUT +static Void local pPut(d,e,co) /* pretty print expr in context of */ +Int d; /* operator of precedence d */ +Cell e; /* with current offset co */ +Int co; { + switch (whatIs(e)) { + case AP : if (fun(e)==mkSelect(0)) + pPut(d,arg(e),co); + else + pPutAp(d,e,co); + break; + + case OFFSET : pPutOffset(offsetOf(e)); + break; + + case NAME : unlexVar(name(e).text); + break; + + case DICTCELL : putStr("{dict"); + putInt(dictOf(e)); + putChr('}'); + break; + + case SELECT : putStr("#"); + putInt(selectOf(e)); + break; + + case UNIT : putStr("()"); + break; + + case TUPLE : pPutTuple(tupleOf(e),e,co); + break; + + case CHARCELL : unlexCharConst(charOf(e)); + break; + + case INTCELL : putInt(intOf(e)); + break; + + case FLOATCELL : putStr(floatToString(floatOf(e))); + break; + + case STRCELL : unlexStrConst(textOf(e)); + break; + + case LETREC : OPEN(d>WHERE_PREC); + co += pPutLocals(fst(snd(e)),co); + pPut(WHERE_PREC+1, snd(snd(e)), co); + CLOSE(d>WHERE_PREC); + break; + + case COND : OPEN(d>COND_PREC); + putStr("if "); + pPut(COND_PREC+1,fst3(snd(e)),co); + putStr(" then "); + pPut(COND_PREC+1,snd3(snd(e)),co); + putStr(" else "); + pPut(COND_PREC+1,thd3(snd(e)),co); + CLOSE(d>COND_PREC); + break; + + default : internal("pPut"); + } +} + +static Void local pPutAp(d,e,co) /* print application (args>=1) */ +Int d; +Cell e; +Int co; { + Bool anyDictArgs = FALSE; + Cell h; + Text t; + Syntax sy; + Int args = 0; + + for (h=e; isAp(h); h=fun(h)) { /* find head of expression, looking*/ + if (isDictVal(arg(h))) /* for dictionary arguments */ + anyDictArgs = TRUE; + args++; + } + + switch (whatIs(h)) { + case TUPLE : OPEN(args>tupleOf(h) && d>=FUN_PREC); + pPutTuple(tupleOf(h),e,co); + CLOSE(args>tupleOf(h) && d>=FUN_PREC); + return; + + case NAME : sy = syntaxOf(t = name(h).text); + break; + + default : sy = APPLIC; + break; + } + + if (anyDictArgs || args>2) /* print some exprs applicatively */ + sy = APPLIC; + + if (sy==APPLIC) { /* print simple application */ + OPEN(d>=FUN_PREC); + pPutSimpleAp(e,co); + CLOSE(d>=FUN_PREC); + return; + } + else if (args==1) { /* print section of the form (e+) */ + putChr('('); + pPut(FUN_PREC-1,arg(e),co); + putChr(' '); + unlexOp(t); + putChr(')'); + } + else { /* infix expr of the form e1 + e2 */ + Syntax a = assocOf(sy); + Int p = precOf(sy); + OPEN(d>p); + pPut((a==LEFT_ASS ? p : 1+p), arg(fun(e)), co); + putChr(' '); + unlexOp(t); + putChr(' '); + pPut((a==RIGHT_ASS ? p : 1+p), arg(e), co); + CLOSE(d>p); + } + +} + +static Void local pPutSimpleAp(e,co) /* print application e0 e1 ... en */ +Cell e; +Int co; { + if (isAp(e)) { + pPutSimpleAp(fun(e),co); + putChr(' '); + pPut(FUN_PREC,arg(e),co); + } + else + pPut(FUN_PREC,e,co); +} + +static Void local pPutTuple(ts,e,co) /* Print tuple expression, allowing*/ +Int ts; /* for possibility of either too */ +Cell e; /* few or too many args to constr */ +Int co; { + Int i; + putChr('('); + if ((i=punusedTups(ts,e,co))>0) { + while (--i>0) + putChr(','); + putChr(')'); + } +} + +static Int local punusedTups(ts,e,co) /* print first part of tuple expr */ +Int ts; /* returning number of constructor */ +Cell e; /* args not yet printed ... */ +Int co; { + if (isAp(e)) { + if ((ts=punusedTups(ts,fun(e),co)-1)>=0) { + pPut(NEVER,arg(e),co); + putChr(ts>0?',':')'); + } + else { + putChr(' '); + pPut(FUN_PREC,arg(e),co); + } + } + return ts; +} + +static Void local pPutOffset(n) /* pretty print offset number */ +Int n; { + putChr('o'); + putInt(n); +} + +static Int local pPutLocals(vs,co) /* pretty print locals */ +List vs; +Int co; { + Int left = outColumn; + Int n = length(vs); + Int i; + + putStr("let { "); + for (i=0; i"); + } + indent(left); + putStr("}\n"); + } + break; + + default : pPut(NEVER,e,co); + putStr(";\n"); + break; + } +} + +static Int local pDiscr(d,co) /* pretty print discriminator */ +Cell d; +Int co; { + Int arity = 0; + + switch (whatIs(d)) { + case INTCELL : putInt(intOf(d)); + break; + + case CHARCELL : unlexCharConst(charOf(d)); + break; + + case UNIT : putStr("()"); + break; + +#if NPLUSK + case ADDPAT : pPutOffset(co+1); + putChr('+'); + putInt(intValOf(d)); + arity = 1; + break; + + case MULPAT : putInt(intValOf(d)); + putChr('*'); + pPutOffset(co+1); + arity = 1; + break; +#endif + + case NAME : { Int i = 0; + arity = name(d).arity; + unlexVar(name(d).text); + for (; i "); + t = snd(snd(t)); + } + + putType(t,NEVER); /* Finally, print rest of type ... */ +} + +static Void local putContext(qs) /* print context list */ +List qs; { + if (isNull(qs)) + putStr("()"); + else { + Int nq = length(qs); + + if (nq!=1) putChr('('); + putPred(hd(qs)); + while (nonNull(qs=tl(qs))) { + putStr(", "); + putPred(hd(qs)); + } + if (nq!=1) putChr(')'); + } +} + +static Void local putPred(pi) /* Output predicate */ +Cell pi; { + if (isAp(pi)) { + putPred(fun(pi)); + putChr(' '); + putType(arg(pi),ALWAYS); + } + else if (isClass(pi)) + putStr(textToStr(class(pi).text)); + else if (isCon(pi)) + putStr(textToStr(textOf(pi))); + else + putStr(""); +} + +static Void local putType(t,prec) /* print nongeneric type expression*/ +Cell t; +Int prec; { + switch(whatIs(t)) { + case UNIT : putStr("()"); + break; + + case LIST : putStr("[]"); + break; + + case ARROW : putStr("(->)"); + break; + + case TYCON : putStr(textToStr(tycon(t).text)); + break; + + case TUPLE : { Int n = tupleOf(t); + putChr('('); + while (--n > 0) + putChr(','); + putChr(')'); + } + break; + + case OFFSET : putTyVar(offsetOf(t)); + break; + + case INTCELL : putChr('_'); + putInt(intOf(t)); + break; + + case AP : { Cell typeHead = getHead(t); + Bool brackets = (argCount!=0 && prec>=ALWAYS); + + switch (whatIs(typeHead)) { + case LIST : if (argCount==1) { + putChr('['); + putType(arg(t),NEVER); + putChr(']'); + return; + } + break; + + case ARROW : if (argCount==2) { + OPEN(prec>=ARROW_PREC); + putType(arg(fun(t)),ARROW_PREC); + putStr(" -> "); + putType(arg(t),NEVER); + CLOSE(prec>=ARROW_PREC); + return; + } + else if (argCount==1) { + putChr('('); + putType(arg(t),ARROW_PREC); + putStr("->)"); + return; + } + break; + + case TUPLE : if (argCount==tupleOf(typeHead)) { + putChr('('); + putTupleType(t); + putChr(')'); + return; + } + break; + + case TYCON : +#if IO_MONAD + if (typeHead==typeST && + argCount==1 && + snd(t)==typeWorld) + brackets = FALSE; +#endif + break; + } + OPEN(brackets); + putApType(t); + CLOSE(brackets); + } + break; + + default : putStr("(bad type)"); + } +} + +static Void local putTyVar(n) /* print type variable */ +Int n; { + static String alphabet /* for the benefit of EBCDIC :-) */ + ="abcdefghijklmnopqrstuvwxyz"; + putChr(alphabet[n%26]); + if (n /= 26) /* just in case there are > 26 vars*/ + putInt(n); +} + +static Bool local putTupleType(e) /* print tuple of types, returning */ +Cell e; { /* TRUE if something was printed, */ + if (isAp(e)) { /* FALSE otherwise; used to control*/ + if (putTupleType(fun(e))) /* printing of intermed. commas */ + putChr(','); + putType(arg(e),NEVER); + return TRUE; + } + return FALSE; +} + +static Void local putApType(t) /* print type application */ +Cell t; { + if (isAp(t)) { +#if IO_MONAD + if (fun(t)==typeST && arg(t)==typeWorld) + putType(typeIO,ALWAYS); + else +#endif + { + putApType(fun(t)); + putChr(' '); + putType(arg(t),ALWAYS); + } + } + else + putType(t,ALWAYS); +} + +/* -------------------------------------------------------------------------- + * Print kind expression: + * ------------------------------------------------------------------------*/ + +static Void local putKind(k) /* print kind expression */ +Kind k; { + switch (whatIs(k)) { + case AP : if (isAp(fst(k))) { + putChr('('); + putKind(fst(k)); + putChr(')'); + } + else + putKind(fst(k)); + putStr(" -> "); + putKind(snd(k)); + break; + + case STAR : putChr('*'); + break; + + case OFFSET : putTyVar(offsetOf(k)); + break; + + case INTCELL : putChr('_'); + putInt(intOf(k)); + break; + + default : putStr("(bad kind)"); + } +} + +static Void local putSig(sig) /* print class kind signature */ +Cell sig; { + putChr('('); + putKind(hd(sig)); + for (sig=tl(sig); nonNull(sig); sig=tl(sig)) { + putStr(", "); + putKind(hd(sig)); + } + putChr(')'); +} + +/* -------------------------------------------------------------------------- + * Main drivers: + * ------------------------------------------------------------------------*/ + +Void printExp(fp,e) /* print expr on specified stream */ +FILE *fp; +Cell e; { + outputStream = fp; + putDepth = 0; + put(NEVER,e); +} + +Void printType(fp,t) /* print type on specified stream */ +FILE *fp; +Cell t; { + outputStream = fp; + putSigType(t); +} + +Void printContext(fp,qs) /* print context on spec. stream */ +FILE *fp; +List qs; { + outputStream = fp; + putContext(qs); +} + +Void printPred(fp,pi) /* print predicate pi on stream */ +FILE *fp; +Cell pi; { + outputStream = fp; + putPred(pi); +} + +Void printKind(fp,k) /* print kind k on stream */ +FILE *fp; +Kind k; { + outputStream = fp; + putKind(k); +} + +Void printSig(fp,sig) /* print class kind signature */ +FILE *fp; +Cell sig; { + outputStream = fp; + putSig(sig); +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/parser.c b/src/parser.c new file mode 100644 index 0000000..bf5feaf --- /dev/null +++ b/src/parser.c @@ -0,0 +1,1555 @@ + +# line 19 "parser.y" +#ifndef lint +#define lint +#endif +#define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n +#define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t)) +#define grded(gs) ap(GUARDED,gs) +#define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) +#define yyerror(s) /* errors handled elsewhere */ +#define YYSTYPE Cell + +static Cell local gcShadow Args((Int,Cell)); +static Void local syntaxError Args((String)); +static String local unexpected Args((Void)); +static Cell local checkPrec Args((Cell)); +static Void local fixDefn Args((Syntax,Cell,Cell,List)); +static Void local setSyntax Args((Int,Syntax,Cell)); +static Cell local buildTuple Args((List)); +static Cell local checkClass Args((Cell)); +static List local checkContext Args((List)); +static Pair local checkDo Args((List)); +static Cell local checkTyLhs Args((Cell)); +static Cell local tidyInfix Args((Cell)); + +/* For the purposes of reasonably portable garbage collection, it is + * necessary to simulate the YACC stack on the Gofer stack to keep + * track of all intermediate constructs. The lexical analyser + * pushes a token onto the stack for each token that is found, with + * these elements being removed as reduce actions are performed, + * taking account of look-ahead tokens as described by gcShadow() + * below. + * + * Of the non-terminals used below, only start, topDecl & begin do not leave + * any values on the Gofer stack. The same is true for the terminals + * EVALEX and SCRIPT. At the end of a successful parse, there should only + * be one element left on the stack, containing the result of the parse. + */ + +#define gc0(e) gcShadow(0,e) +#define gc1(e) gcShadow(1,e) +#define gc2(e) gcShadow(2,e) +#define gc3(e) gcShadow(3,e) +#define gc4(e) gcShadow(4,e) +#define gc5(e) gcShadow(5,e) +#define gc6(e) gcShadow(6,e) +#define gc7(e) gcShadow(7,e) + +# define EVALEX 257 +# define SCRIPT 258 +# define COCO 259 +# define INFIXL 260 +# define INFIXR 261 +# define INFIX 262 +# define FUNARROW 263 +# define UPTO 264 +# define CASEXP 265 +# define OF 266 +# define IF 267 +# define THEN 268 +# define ELSE 269 +# define WHERE 270 +# define TYPE 271 +# define DATA 272 +# define FROM 273 +# define LET 274 +# define IN 275 +# define VAROP 276 +# define VARID 277 +# define NUMLIT 278 +# define CHARLIT 279 +# define STRINGLIT 280 +# define REPEAT 281 +# define CONOP 282 +# define CONID 283 +# define TCLASS 284 +# define IMPLIES 285 +# define TINSTANCE 286 +# define DO 287 +# define TRUNST 288 +# define PRIMITIVE 289 +# define DEFAULT 290 +# define DERIVING 291 +# define HIDING 292 +# define IMPORT 293 +# define INTERFACE 294 +# define MODULE 295 +# define RENAMING 296 +# define TO 297 +#define yyclearin yychar = -1 +#define yyerrok yyerrflag = 0 +extern int yychar; +extern short yyerrflag; +#ifndef YYMAXDEPTH +#define YYMAXDEPTH 150 +#endif +#ifndef YYSTYPE +#define YYSTYPE int +#endif +YYSTYPE yylval, yyval; +# define YYERRCODE 256 + +# line 488 "parser.y" + + +static Cell local gcShadow(n,e) /* keep parsed fragments on stack */ +Int n; +Cell e; { + /* If a look ahead token is held then the required stack transformation + * is: + * pushed: n 1 0 1 0 + * x1 | ... | xn | la ===> e | la + * top() top() + * + * Othwerwise, the transformation is: + * pushed: n-1 0 0 + * x1 | ... | xn ===> e + * top() top() + */ + if (yychar>=0) { + pushed(n-1) = top(); + pushed(n) = e; + } + else + pushed(n-1) = e; + sp -= (n-1); + return e; +} + +static Void local syntaxError(s) /* report on syntax error */ +String s; { + ERROR(row) "Syntax error in %s (unexpected %s)", s, unexpected() + EEND; +} + +static String local unexpected() { /* find name for unexpected token */ + static char buffer[100]; + static char *fmt = "%s \"%s\""; + static char *kwd = "keyword"; + static char *hkw = "(Haskell) keyword"; + + switch (yychar) { + case 0 : return "end of input"; + +#define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer; + case INFIXL : keyword("infixl"); + case INFIXR : keyword("infixr"); + case INFIX : keyword("infix"); + case TINSTANCE : keyword("instance"); + case TCLASS : keyword("class"); + case PRIMITIVE : keyword("primitive"); + case CASEXP : keyword("case"); + case OF : keyword("of"); + case IF : keyword("if"); + case DO : keyword("do"); + case TRUNST : keyword("runST"); + case THEN : keyword("then"); + case ELSE : keyword("else"); + case WHERE : keyword("where"); + case TYPE : keyword("type"); + case DATA : keyword("data"); + case LET : keyword("let"); + case IN : keyword("in"); +#undef keyword + +#define hasword(kw) sprintf(buffer,fmt,hkw,kw); return buffer; + case DEFAULT : hasword("default"); + case DERIVING : hasword("deriving"); + case HIDING : hasword("hiding"); + case IMPORT : hasword("import"); + case INTERFACE : hasword("interface"); + case MODULE : hasword("module"); + case RENAMING : hasword("renaming"); + case TO : hasword("to"); +#undef hasword + + case FUNARROW : return "`->'"; + case '=' : return "`='"; + case COCO : return "`::'"; + case '-' : return "`-'"; + case ',' : return "comma"; + case '@' : return "`@'"; + case '(' : return "`('"; + case ')' : return "`)'"; + case '|' : return "`|'"; + case ';' : return "`;'"; + case UPTO : return "`..'"; + case '[' : return "`['"; + case ']' : return "`]'"; + case FROM : return "`<-'"; + case '\\' : return "backslash (lambda)"; + case '~' : return "tilde"; + case '`' : return "backquote"; + case VAROP : + case VARID : + case CONOP : + case CONID : sprintf(buffer,"symbol \"%s\"", + textToStr(textOf(yylval))); + return buffer; + case NUMLIT : return "numeric literal"; + case CHARLIT : return "character literal"; + case STRINGLIT : return "string literal"; + case IMPLIES : return "`=>"; + default : return "token"; + } +} + +static Cell local checkPrec(p) /* Check for valid precedence value */ +Cell p; { + if (!isInt(p) || intOf(p)MAX_PREC) { + ERROR(row) "Precedence value must be an integer in the range [%d..%d]", + MIN_PREC, MAX_PREC + EEND; + } + return p; +} + +static Void local fixDefn(a,line,p,ops)/* Declare syntax of operators */ +Syntax a; +Cell line; +Cell p; +List ops; { + Int l = intOf(line); + a = mkSyntax(a,intOf(p)); + map2Proc(setSyntax,l,a,ops); +} + +static Void local setSyntax(line,sy,op)/* set syntax of individ. operator */ +Int line; +Syntax sy; +Cell op; { + addSyntax(line,textOf(op),sy); + opDefns = cons(op,opDefns); +} + +static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from list*/ +List tup; { /* [xn,...,x1] */ + Int n = 0; + Cell t = tup; + Cell x; + + do { /* . . */ + x = fst(t); /* / \ / \ */ + fst(t) = snd(t); /* xn . . xn */ + snd(t) = x; /* . ===> . */ + x = t; /* . . */ + t = fun(x); /* . . */ + n++; /* / \ / \ */ + } while (nonNull(t)); /* x1 NIL (n) x1 */ + fst(x) = mkTuple(n); + return tup; +} + +/* The yacc parser presented above is not sufficiently powerful to + * determine whether a tuple at the front of a sigType is part of a + * context: e.g. (Eq a, Num a) => a -> a -> a + * or a type: e.g. (Tree a, Tree a) -> Tree a + * + * Rather than complicate the grammar, both are parsed as tuples of types, + * using the following checks afterwards to ensure that the correct syntax + * is used in the case of a tupled context. + */ + +static List local checkContext(con) /* validate type class context */ +Type con; { + if (con==UNIT) /* allows empty context () */ + return NIL; + else if (whatIs(getHead(con))==TUPLE) { + List qs = NIL; + + while (isAp(con)) { /* undo work of buildTuple :-( */ + Cell temp = fun(con); + fun(con) = arg(con); + arg(con) = qs; + qs = con; + con = temp; + checkClass(hd(qs)); + } + return qs; + } + else /* single context expression */ + return singleton(checkClass(con)); +} + +static Cell local checkClass(c) /* check that type expr is a class */ +Cell c; { /* constrnt of the form C t1 .. tn */ + Cell cn = getHead(c); + + if (!isCon(cn)) + syntaxError("class expression"); + else if (argCount<1) { + ERROR(row) "Class \"%s\" must have at least one argument", + textToStr(textOf(cn)) + EEND; + } + return c; +} + +static Pair local checkDo(dqs) /* convert reversed list of dquals */ +List dqs; { /* to a (expr,quals) pair */ +#if DO_COMPS + if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { + ERROR(row) "Last generator in do {...} must be an expression" + EEND; + } + fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ + snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ +#endif + return dqs; +} + +static Cell local checkTyLhs(c) /* check that lhs is of the form */ +Cell c; { /* T a1 ... a */ + Cell tlhs = c; + while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) + tlhs = fun(tlhs); + if (whatIs(tlhs)!=CONIDCELL) { + ERROR(row) "Illegal left hand side in datatype definition" + EEND; + } + return c; +} + +/* expressions involving a sequence of two or more infix operator symbols + * are parsed as elements of type: + * InfixExpr ::= [Expr] + * | ap(ap(Operator,InfixExpr),Expr) + * + * thus x0 +1 x1 ... +n xn is parsed as: +n (....(+1 [x0] x1)....) xn + * + * Once the expression has been completely parsed, this parsed form is + * `tidied' according to the precedences and associativities declared for + * each operator symbol. + * + * The tidy process uses a `stack' of type: + * TidyStack ::= ap(ap(Operator,TidyStack),Expr) + * | NIL + * when the ith layer of an InfixExpr has been transferred to the stack, the + * stack is of the form: +i (....(+n NIL xn)....) xi + * + * The tidy function is based on a simple shift-reduce parser: + * + * tidy :: InfixExpr -> TidyStack -> Expr + * tidy [m] ss = foldl (\x f-> f x) m ss + * tidy (m*n) [] = tidy m [(*n)] + * tidy (m*n) ((+o):ss) + * | amb = error "Ambiguous" + * | shift = tidy m ((*n):(+o):ss) + * | reduce = tidy (m*(n+o)) ss + * where sye = syntaxOf (*) + * (ae,pe) = sye + * sys = syntaxOf (+) + * (as,ps) = sys + * amb = pe==ps && (ae/=as || ae==NON_ASS) + * shift = pe>ps || (ps==pe && ae==LEFT_ASS) + * reduce = otherwise + * + * N.B. the conditions amb, shift, reduce are NOT mutually exclusive and + * must be tested in that order. + * + * As a concession to efficiency, we lower the number of calls to syntaxOf + * by keeping track of the values of sye, sys throughout the process. The + * value APPLIC is used to indicate that the syntax value is unknown. + */ + +static Cell local tidyInfix(e) /* convert InfixExpr to Expr */ +Cell e; { /* :: InfixExpr */ + Cell s = NIL; /* :: TidyStack */ + Syntax sye = APPLIC; /* Syntax of op in e (init unknown) */ + Syntax sys = APPLIC; /* Syntax of op in s (init unknown) */ + Cell temp; + + while (nonNull(tl(e))) { + if (isNull(s)) { + s = e; + e = arg(fun(s)); + arg(fun(s)) = NIL; + sys = sye; + sye = APPLIC; + } + else { + if (sye==APPLIC) { /* calculate sye (if unknown) */ + sye = syntaxOf(textOf(fun(fun(e)))); + if (sye==APPLIC) sye=DEF_OPSYNTAX; + } + if (sys==APPLIC) { /* calculate sys (if unknown) */ + sys = syntaxOf(textOf(fun(fun(s)))); + if (sys==APPLIC) sys=DEF_OPSYNTAX; + } + + if (precOf(sye)==precOf(sys) && /* amb */ + (assocOf(sye)!=assocOf(sys) || assocOf(sye)==NON_ASS)) { + ERROR(row) "Ambiguous use of operator \"%s\" with \"%s\"", + textToStr(textOf(fun(fun(e)))), + textToStr(textOf(fun(fun(s)))) + EEND; + } + else if (precOf(sye)>precOf(sys) || /* shift */ + (precOf(sye)==precOf(sys) && assocOf(sye)==LEFT_ASS)) { + temp = arg(fun(e)); + arg(fun(e)) = s; + s = e; + e = temp; + sys = sye; + sye = APPLIC; + } + else { /* reduce */ + temp = arg(fun(s)); + arg(fun(s)) = arg(e); + arg(e) = s; + s = temp; + sys = APPLIC; + /* sye unchanged */ + } + } + } + + e = hd(e); + while (nonNull(s)) { + temp = arg(fun(s)); + arg(fun(s)) = e; + e = s; + s = temp; + } + + return e; +} + +/*-------------------------------------------------------------------------*/ +short yyexca[] ={ +-1, 1, + 0, -1, + -2, 0, +-1, 86, + 259, 143, + 44, 143, + -2, 169, +-1, 95, + 285, 75, + -2, 74, +-1, 151, + 285, 75, + -2, 118, +-1, 234, + 264, 19, + -2, 41, +-1, 270, + 96, 78, + 282, 78, + -2, 65, + }; +# define YYNPROD 216 +# define YYLAST 906 +short yyact[]={ + + 18, 130, 93, 319, 311, 348, 194, 21, 267, 5, + 342, 268, 231, 128, 369, 368, 260, 37, 34, 36, + 52, 53, 6, 110, 298, 202, 95, 218, 312, 62, + 84, 206, 101, 86, 68, 252, 333, 166, 104, 134, + 89, 137, 230, 388, 105, 315, 374, 379, 352, 105, + 364, 213, 86, 141, 316, 85, 72, 36, 148, 42, + 70, 249, 310, 91, 91, 333, 90, 90, 136, 38, + 228, 257, 220, 217, 85, 109, 250, 111, 112, 284, + 254, 147, 66, 102, 299, 177, 365, 263, 214, 371, + 148, 203, 39, 86, 101, 169, 71, 161, 175, 212, + 4, 2, 3, 138, 299, 281, 207, 43, 151, 151, + 153, 277, 275, 226, 181, 85, 180, 258, 184, 101, + 287, 185, 92, 183, 51, 186, 96, 187, 171, 176, + 86, 199, 191, 179, 196, 246, 214, 124, 56, 155, + 387, 125, 149, 280, 205, 102, 193, 101, 101, 232, + 370, 15, 85, 198, 386, 155, 222, 221, 45, 278, + 366, 94, 48, 367, 308, 233, 224, 22, 165, 227, + 102, 159, 10, 272, 255, 223, 162, 148, 120, 235, + 116, 363, 360, 86, 199, 22, 88, 307, 361, 345, + 145, 362, 308, 236, 237, 313, 115, 282, 102, 102, + 283, 114, 238, 233, 101, 85, 248, 190, 253, 148, + 48, 135, 189, 147, 273, 264, 297, 244, 27, 11, + 245, 126, 20, 296, 133, 152, 197, 285, 172, 305, + 266, 46, 269, 279, 162, 261, 27, 22, 139, 164, + 20, 192, 10, 150, 150, 276, 35, 295, 97, 209, + 210, 242, 131, 19, 243, 102, 289, 290, 225, 86, + 328, 300, 233, 302, 303, 291, 294, 286, 237, 99, + 204, 19, 288, 30, 264, 100, 86, 201, 86, 29, + 87, 85, 86, 256, 233, 324, 334, 325, 27, 11, + 29, 351, 20, 331, 199, 30, 22, 61, 85, 320, + 85, 58, 30, 338, 85, 72, 343, 204, 29, 233, + 97, 349, 336, 344, 211, 253, 332, 170, 340, 215, + 337, 346, 339, 19, 350, 354, 327, 30, 335, 314, + 358, 99, 355, 265, 304, 97, 357, 100, 44, 269, + 359, 353, 326, 269, 46, 22, 129, 27, 11, 306, + 10, 20, 45, 322, 154, 182, 99, 86, 199, 375, + 376, 127, 100, 97, 270, 293, 158, 215, 343, 382, + 378, 349, 380, 364, 385, 344, 384, 383, 381, 85, + 320, 22, 19, 132, 99, 99, 10, 77, 78, 79, + 100, 100, 14, 146, 13, 356, 27, 11, 75, 76, + 20, 12, 301, 274, 30, 23, 24, 25, 26, 101, + 29, 81, 131, 82, 30, 16, 80, 83, 271, 67, + 74, 131, 30, 23, 24, 25, 26, 241, 29, 140, + 131, 19, 27, 11, 98, 239, 20, 292, 240, 119, + 22, 99, 120, 251, 49, 10, 30, 100, 117, 91, + 9, 118, 234, 73, 63, 28, 8, 77, 78, 79, + 102, 131, 14, 208, 13, 22, 131, 19, 75, 76, + 10, 12, 40, 47, 30, 23, 24, 25, 26, 64, + 29, 81, 69, 82, 41, 16, 80, 83, 160, 157, + 74, 27, 11, 156, 22, 20, 318, 103, 219, 10, + 216, 144, 174, 131, 106, 173, 373, 65, 142, 143, + 372, 347, 7, 22, 309, 330, 27, 11, 10, 329, + 20, 14, 341, 13, 262, 229, 19, 259, 121, 200, + 12, 168, 59, 30, 23, 24, 25, 26, 60, 29, + 163, 33, 32, 132, 16, 27, 11, 31, 1, 20, + 22, 19, 132, 0, 0, 10, 0, 0, 0, 0, + 0, 377, 0, 0, 27, 11, 0, 178, 20, 0, + 14, 0, 13, 0, 0, 0, 22, 188, 103, 12, + 19, 10, 30, 23, 24, 25, 26, 0, 29, 22, + 114, 0, 132, 16, 0, 0, 0, 132, 0, 19, + 0, 27, 11, 22, 0, 20, 14, 168, 13, 0, + 0, 0, 0, 0, 0, 12, 0, 0, 30, 23, + 24, 25, 26, 0, 29, 0, 0, 27, 11, 16, + 0, 20, 167, 0, 132, 247, 19, 0, 0, 0, + 27, 0, 0, 0, 20, 0, 99, 0, 0, 0, + 0, 0, 100, 0, 27, 0, 7, 0, 20, 0, + 22, 0, 19, 0, 0, 14, 0, 13, 0, 0, + 0, 0, 0, 0, 12, 19, 0, 30, 23, 24, + 25, 26, 0, 29, 0, 0, 0, 0, 16, 19, + 14, 0, 13, 0, 0, 0, 0, 0, 0, 12, + 0, 0, 30, 23, 24, 25, 26, 0, 29, 0, + 7, 27, 0, 16, 0, 20, 0, 0, 0, 14, + 0, 323, 0, 0, 0, 0, 0, 0, 12, 321, + 0, 30, 23, 24, 25, 26, 317, 29, 14, 0, + 13, 0, 16, 0, 0, 0, 19, 12, 0, 0, + 30, 23, 24, 25, 26, 0, 29, 0, 0, 0, + 0, 16, 0, 0, 0, 0, 7, 0, 0, 0, + 0, 0, 0, 0, 0, 14, 0, 13, 0, 0, + 0, 0, 0, 0, 195, 0, 0, 30, 23, 24, + 25, 26, 0, 29, 0, 0, 0, 0, 16, 0, + 0, 14, 0, 13, 0, 0, 0, 0, 0, 0, + 12, 0, 0, 30, 23, 24, 25, 26, 0, 29, + 0, 0, 0, 0, 16, 0, 30, 23, 24, 25, + 26, 0, 29, 0, 0, 0, 0, 16, 17, 0, + 30, 23, 24, 25, 26, 0, 29, 0, 0, 0, + 50, 16, 0, 0, 54, 55, 0, 0, 57, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 107, 0, 0, 0, 54, 108, 0, + 0, 0, 0, 0, 0, 113, 0, 30, 23, 24, + 25, 26, 0, 29, 122, 123 }; +short yypact[]={ + +-156,-1000, 400,-238,-1000,-201,-167,-1000, 62, 62, + 563, 145, 1, 400, 400, 145, 145,-1000, 74, 145, +-1000,-1000, 256,-1000,-1000,-1000,-1000, 400,-1000,-1000, +-1000,-1000, 197,-276,-1000,-1000,-216,-1000, -1, 107, + 425,-1000,-1000,-1000,-1000,-239,-1000, 425, 145, 620, +-1000, 425,-191,-188,-1000,-1000, 145,-1000, 549, 155, + 139,-1000, 407, 398, 62, 145, 145, 44, 97, 134, + 287,-1000,-1000,-1000,-217,-215, 107,-225,-225,-225, + 137, 107, 107, 107, 95, 110, 74,-1000, 199,-1000, +-1000,-1000, 425,-1000,-248,-1000, 369,-1000,-1000,-1000, +-1000, 54, -8, 62, 37, 20,-1000, 400,-1000, 296, +-1000, 400, -2,-1000,-1000,-1000,-1000,-1000, 400,-1000, + 400, 536, 171, 166,-1000, 400, 510, 400,-1000, 127, +-1000,-1000,-1000, -15,-1000, 30,-1000,-1000, 83,-254, + 62,-1000, 62, 62, 55,-1000,-1000,-229, 43,-197, +-258,-1000,-198,-1000, 107, 18,-1000,-201,-1000, 400, + 52,-1000, 400,-200, 169, 296, 107, 107,-1000,-1000, + 161, 394, 164, 210, 176,-1000, 42,-1000, 425,-1000, +-1000,-1000, 341,-214,-193, 425,-1000,-1000,-1000,-1000, +-1000,-184, 130,-1000, 10, -6,-1000,-1000,-1000,-1000, +-280, 195, 50, 107,-1000, 108,-215, 129,-1000, 129, + 129, 107, 18,-1000, 160, 155,-1000, -11, 107,-1000, + -12,-1000,-1000,-1000, 115,-1000, 400, 82, -18, 156, +-1000,-1000,-185,-1000, 187,-1000,-1000,-1000,-1000,-1000, + 107, 79,-1000,-1000,-1000, 107,-1000,-1000,-1000, 400, + 400, 378,-1000, -40, 400, 510, 400, 400, 425,-1000, + 189, 50, 146, 120,-1000, 187,-213, -96,-1000, -51, +-1000, -7, 62,-1000,-1000, 473,-1000, 425, 454, 115, + 400, 197,-1000, 169,-1000, -4,-1000,-1000,-1000,-1000, +-1000,-1000, 341,-1000,-201, -20, 400,-1000,-1000, 425, +-1000,-1000,-1000,-1000, 296, 25, 148,-1000, 50,-1000, + 18,-1000, 108, 8, 107,-234, 108,-1000, 336,-1000, +-1000,-1000, 296, 400,-1000,-1000, 287,-1000, 141, 147, + 140,-1000, 111, 91,-1000,-1000,-1000,-1000,-1000,-177, +-214, 119,-1000,-282,-283,-1000,-1000, 106,-1000,-170, +-1000,-1000,-237,-1000, -96,-1000, 305,-1000,-191,-1000, +-1000,-1000, 7,-1000, 139, 400,-1000, 25, 18, 7, + 18, 107, 113, 96,-1000,-1000,-1000,-1000,-1000,-232, +-1000,-1000,-1000,-1000,-1000,-1000,-1000,-240,-1000 }; +short yypgo[]={ + + 0, 548, 6, 17, 547, 542, 60, 13, 541, 96, + 23, 246, 149, 540, 529, 527, 525, 42, 12, 87, + 524, 522, 10, 0, 7, 519, 515, 30, 211, 26, + 514, 8, 4, 161, 511, 5, 2, 11, 59, 510, + 506, 126, 434, 505, 502, 429, 106, 463, 484, 501, + 190, 142, 500, 498, 496, 75, 3, 22, 493, 489, + 488, 97, 455, 456, 450, 151, 444, 443, 838, 454, + 419, 35, 365, 266, 247, 24, 241, 146, 1 }; +short yyr1[]={ + + 0, 1, 1, 1, 1, 4, 4, 5, 6, 6, + 6, 6, 6, 8, 8, 11, 11, 9, 9, 12, + 12, 13, 13, 16, 16, 17, 17, 14, 14, 14, + 20, 20, 19, 19, 15, 15, 21, 21, 22, 22, + 18, 18, 18, 18, 18, 25, 25, 26, 26, 9, + 9, 9, 28, 28, 28, 30, 30, 34, 34, 35, + 35, 31, 31, 37, 37, 37, 32, 32, 32, 39, + 39, 40, 40, 36, 36, 33, 29, 29, 29, 41, + 41, 42, 42, 42, 42, 42, 42, 42, 42, 42, + 42, 43, 43, 44, 44, 9, 9, 9, 45, 45, + 46, 46, 47, 47, 47, 48, 48, 38, 38, 9, + 49, 49, 49, 50, 9, 9, 9, 51, 51, 52, + 52, 53, 53, 54, 54, 56, 56, 10, 10, 55, + 55, 58, 58, 58, 59, 59, 3, 60, 60, 61, + 61, 61, 27, 27, 23, 23, 62, 62, 24, 24, + 2, 2, 2, 57, 57, 57, 64, 64, 63, 63, + 63, 63, 63, 63, 66, 66, 65, 65, 65, 68, + 68, 68, 68, 68, 68, 68, 68, 68, 68, 68, + 68, 68, 68, 68, 68, 69, 69, 67, 67, 71, + 72, 72, 73, 73, 73, 74, 74, 75, 70, 70, + 70, 70, 70, 70, 70, 70, 76, 76, 77, 77, + 77, 77, 7, 7, 78, 78 }; +short yyr2[]={ + + 0, 2, 3, 2, 1, 3, 1, 1, 3, 3, + 1, 1, 1, 2, 1, 7, 2, 4, 2, 1, + 1, 0, 3, 3, 1, 1, 2, 0, 4, 3, + 0, 1, 3, 1, 0, 4, 3, 1, 3, 3, + 1, 1, 4, 4, 4, 3, 1, 0, 1, 5, + 5, 7, 2, 1, 1, 2, 0, 3, 1, 3, + 1, 3, 1, 3, 1, 1, 0, 2, 4, 0, + 1, 3, 1, 3, 1, 1, 1, 3, 1, 2, + 1, 1, 1, 2, 3, 3, 4, 3, 3, 3, + 2, 2, 1, 3, 3, 3, 3, 3, 1, 0, + 3, 1, 1, 1, 1, 1, 3, 1, 3, 4, + 3, 1, 1, 2, 3, 3, 2, 3, 1, 4, + 0, 4, 0, 3, 1, 1, 1, 3, 2, 3, + 1, 2, 1, 1, 2, 1, 4, 2, 1, 4, + 5, 4, 3, 1, 1, 3, 1, 3, 1, 3, + 3, 1, 1, 1, 3, 1, 3, 5, 2, 4, + 6, 6, 6, 1, 2, 1, 2, 2, 1, 1, + 3, 2, 1, 1, 2, 1, 1, 1, 1, 3, + 3, 3, 4, 4, 4, 3, 3, 3, 1, 2, + 2, 1, 1, 2, 1, 2, 1, 4, 0, 1, + 1, 3, 3, 4, 2, 5, 3, 1, 3, 3, + 1, 4, 2, 1, 1, 1 }; +short yychk[]={ + +-1000, -1, 257, 258, 256, -2, -57, 256, -63, -64, + 45, 92, 274, 267, 265, -65, 288, -68, -23, 126, + 95, -24, 40, 278, 279, 280, 281, 91, -62, 283, + 277, -4, -5, -8, 256, -11, 295, -3, 270, 259, + -47, -48, -38, 45, 276, 96, 282, -47, -65, -66, + -68, 123, -2, -2, -68, -68, 64, -68, 45, 276, + 282, 41, -2, -69, -63, -48, -38, -70, -2, -69, + -6, -9, -10, 256, 293, 271, 272, 260, 261, 262, + 289, 284, 286, 290, -27, -57, -23, -11, -12, 256, + 283, 280, 123, -36, -33, -29, -41, 256, -42, 277, + 283, 40, 91, -63, 277, 283, -63, 263, -68, -55, + -10, 268, 266, -68, 41, 41, 41, 41, 44, 41, + 44, -47, -68, -68, 93, 44, 124, 264, -7, 59, + -78, 125, 256, -12, 256, -28, 283, 256, -29, -33, + -45, 278, -45, -45, -49, -50, 256, -23, 40, -51, + -33, -29, -51, -29, 259, 44, -58, -59, 256, 61, + -60, -61, 124, -13, 40, -55, 285, 263, -42, 41, + 263, -29, -41, -43, -44, 44, -29, 93, -47, 96, + 96, -2, 59, -7, -2, 123, -2, -2, 41, 41, + 41, -2, -76, -77, -2, 274, -2, -9, -10, -78, + -14, 292, 40, 61, 277, 61, 285, -46, -47, -46, + -46, 259, 44, 280, 45, 276, -52, 270, 285, -53, + 270, -36, -23, -3, -2, -61, 61, -2, 270, -16, + -17, -18, -12, -23, 283, -7, -29, -29, 41, 41, + 44, 263, 41, 44, 41, 44, 93, -63, -10, 275, + 269, -67, -71, -57, 264, 44, 273, 61, 123, -15, + 296, 40, -20, -19, -18, 283, -29, -31, -37, -29, + 256, -28, 44, -36, -50, 123, -29, 123, 44, -2, + 61, 123, 41, 44, 264, 40, -29, 41, -29, -2, + -2, -7, 59, -72, -73, -74, 263, 256, -75, 124, + -2, -77, -2, -2, -55, 40, -19, 41, 44, -30, + 275, -32, 124, 291, -38, 96, 61, -47, -54, -56, + -10, 256, -55, 267, -2, -2, -6, -17, 264, -25, + -26, -24, -27, 40, -23, -71, -3, -75, -2, -57, + -7, -21, -22, -23, -24, 41, -18, -34, -35, -23, + -37, 283, 40, -29, -31, -7, 59, -7, -2, -7, + 41, 41, 44, 41, 282, 263, 41, 44, 297, 297, + 44, 259, -39, -40, 283, -32, -56, 256, -24, 40, + -2, -22, -23, -24, -35, -36, 41, 44, 283 }; +short yydef[]={ + + 0, -2, 0, 0, 4, 1, 151, 152, 153, 155, + 0, 0, 0, 0, 0, 163, 0, 168, 169, 0, + 172, 173, 0, 175, 176, 177, 178, 198, 144, 148, + 146, 3, 0, 6, 7, 14, 0, 2, 0, 0, + 0, 102, 103, 104, 105, 0, 107, 0, 158, 0, + 165, 0, 0, 0, 166, 167, 0, 171, 0, 105, + 107, 174, 0, 0, 153, 0, 0, 0, 199, 200, + 0, 10, 11, 12, 0, 0, 0, 99, 99, 99, + 0, 0, 0, 0, 0, 0, -2, 13, 21, 16, + 19, 20, 0, 150, 0, -2, 76, 78, 80, 81, + 82, 0, 0, 154, 0, 0, 156, 0, 164, 0, + 130, 0, 0, 170, 145, 147, 149, 179, 0, 180, + 0, 0, 0, 0, 181, 0, 0, 204, 5, 0, + 213, 214, 215, 27, 18, 0, 53, 54, 75, 0, + 0, 98, 0, 0, 0, 111, 112, 0, 0, 120, + 0, -2, 122, 116, 0, 0, 128, 132, 133, 0, + 135, 138, 0, 0, 0, 0, 0, 0, 79, 83, + 0, 0, 76, 0, 0, 92, 0, 90, 0, 106, + 108, 159, 0, 0, 0, 0, 186, 185, 182, 183, + 184, 186, 201, 207, 210, 0, 202, 8, 9, 212, + 34, 0, 30, 0, 52, 0, 0, 95, 101, 96, + 97, 0, 0, 113, 0, 0, 114, 0, 0, 115, + 0, 127, 142, 131, 134, 137, 0, 0, 0, 0, + 24, 25, 0, 40, -2, 136, 73, 77, 84, 85, + 0, 0, 87, 91, 88, 0, 89, 157, 129, 0, + 0, 0, 188, 0, 203, 0, 0, 0, 0, 17, + 0, 0, 0, 31, 33, 41, 56, 66, 62, 64, + -2, 0, 0, 109, 110, 0, 117, 0, 0, 0, + 0, 0, 22, 0, 26, 47, 94, 86, 93, 160, + 161, 162, 0, 189, 191, 192, 0, 194, 196, 0, + 205, 206, 208, 209, 0, 0, 0, 29, 0, 49, + 0, 50, 0, 0, 0, 0, 0, 100, 0, 124, + 125, 126, 0, 0, 141, 139, 0, 23, 0, 0, + 0, 46, 48, 0, 143, 187, 190, 195, 193, 0, + 211, 0, 37, 0, 0, 28, 32, 55, 58, 60, + 61, 67, 69, 63, 66, 119, 0, 121, 140, 15, + 42, 43, 0, 44, 0, 0, 35, 0, 0, 0, + 0, 0, 0, 70, 72, 51, 123, 126, 45, 0, + 197, 36, 38, 39, 57, 59, 68, 0, 71 }; +# line 1 "/usr/lib/yaccpar" +#ifndef lint +static char yaccpar_sccsid[] = "@(#)yaccpar 4.1 (Berkeley) 2/11/83"; +#endif not lint + +# define YYFLAG -1000 +# define YYERROR goto yyerrlab +# define YYACCEPT return(0) +# define YYABORT return(1) + +/* parser for yacc output */ + +#ifdef YYDEBUG +int yydebug = 0; /* 1 for debugging */ +#endif +YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +int yychar = -1; /* current input token number */ +int yynerrs = 0; /* number of errors */ +short yyerrflag = 0; /* error recovery flag */ + +yyparse() { + + short yys[YYMAXDEPTH]; + short yyj, yym; + register YYSTYPE *yypvt; + register short yystate, *yyps, yyn; + register YYSTYPE *yypv; + register short *yyxi; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerrflag = 0; + yyps= &yys[-1]; + yypv= &yyv[-1]; + + yystack: /* put a state and value onto the stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); +#endif + if( ++yyps>= &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); } + *yyps = yystate; + ++yypv; + *yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG ) goto yydefault; /* simple state */ + + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; + if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerrflag > 0 ) --yyerrflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) { + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; + /* look through exception table */ + + for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ + + while( *(yyxi+=2) >= 0 ){ + if( *yyxi == yychar ) break; + } + if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerrflag ){ + + case 0: /* brand new error */ + + yyerror( "syntax error" ); + yyerrlab: + ++yynerrs; + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerrflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + YYERRCODE; + if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); +#endif + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + yyabort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery discards char %d\n", yychar ); +#endif + + if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + +#ifdef YYDEBUG + if( yydebug ) printf("reduce %d\n",yyn); +#endif + yyps -= yyr2[yyn]; + yypvt = yypv; + yypv -= yyr2[yyn]; + yyval = yypv[1]; + yym=yyn; + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; + switch(yym){ + +case 1: +# line 86 "parser.y" +{inputExpr = yypvt[-0]; sp-=1;} break; +case 2: +# line 87 "parser.y" +{inputExpr = letrec(yypvt[-0],yypvt[-1]); sp-=2;} break; +case 3: +# line 88 "parser.y" +{valDefns = yypvt[-0]; sp-=1;} break; +case 4: +# line 89 "parser.y" +{syntaxError("input");} break; +case 5: +# line 102 "parser.y" +{yyval = gc2(yypvt[-1]);} break; +case 6: +# line 103 "parser.y" +{yyval = yypvt[-0];} break; +case 7: +# line 105 "parser.y" +{yyerrok; goOffside(startColumn);} break; +case 8: +# line 107 "parser.y" +{yyval = gc2(yypvt[-2]);} break; +case 9: +# line 108 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 10: +# line 109 "parser.y" +{yyval = gc0(NIL);} break; +case 11: +# line 110 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 12: +# line 111 "parser.y" +{syntaxError("definition");} break; +case 13: +# line 113 "parser.y" +{yyval = gc2(appendOnto(yypvt[-0],yypvt[-1]));} break; +case 14: +# line 114 "parser.y" +{yyval = yypvt[-0];} break; +case 15: +# line 117 "parser.y" +{yyval = gc7(yypvt[-1]);} break; +case 16: +# line 118 "parser.y" +{syntaxError("module definition");} break; +case 17: +# line 120 "parser.y" +{sp-=4;} break; +case 18: +# line 121 "parser.y" +{syntaxError("import declaration");} break; +case 19: +# line 123 "parser.y" +{yyval = yypvt[-0];} break; +case 20: +# line 124 "parser.y" +{yyval = yypvt[-0];} break; +case 21: +# line 126 "parser.y" +{yyval = gc0(NIL);} break; +case 22: +# line 127 "parser.y" +{yyval = gc3(NIL);} break; +case 23: +# line 129 "parser.y" +{yyval = gc3(NIL);} break; +case 24: +# line 130 "parser.y" +{yyval = yypvt[-0];} break; +case 25: +# line 132 "parser.y" +{yyval = yypvt[-0];} break; +case 26: +# line 133 "parser.y" +{yyval = gc2(NIL);} break; +case 27: +# line 135 "parser.y" +{yyval = gc0(NIL);} break; +case 28: +# line 136 "parser.y" +{yyval = gc4(NIL);} break; +case 29: +# line 137 "parser.y" +{yyval = gc3(NIL);} break; +case 30: +# line 139 "parser.y" +{yyval = gc0(NIL);} break; +case 31: +# line 140 "parser.y" +{yyval = yypvt[-0];} break; +case 32: +# line 142 "parser.y" +{yyval = gc3(NIL);} break; +case 33: +# line 143 "parser.y" +{yyval = yypvt[-0];} break; +case 34: +# line 145 "parser.y" +{yyval = gc0(NIL);} break; +case 35: +# line 146 "parser.y" +{yyval = gc4(NIL);} break; +case 36: +# line 148 "parser.y" +{yyval = gc3(NIL);} break; +case 37: +# line 149 "parser.y" +{yyval = yypvt[-0];} break; +case 38: +# line 151 "parser.y" +{yyval = gc3(NIL);} break; +case 39: +# line 152 "parser.y" +{yyval = gc3(NIL);} break; +case 40: +# line 154 "parser.y" +{yyval = yypvt[-0];} break; +case 41: +# line 155 "parser.y" +{yyval = yypvt[-0];} break; +case 42: +# line 156 "parser.y" +{yyval = gc4(NIL);} break; +case 43: +# line 157 "parser.y" +{yyval = gc4(NIL);} break; +case 44: +# line 158 "parser.y" +{yyval = gc4(NIL);} break; +case 45: +# line 160 "parser.y" +{yyval = gc3(NIL);} break; +case 46: +# line 161 "parser.y" +{yyval = yypvt[-0];} break; +case 47: +# line 163 "parser.y" +{yyval = gc0(NIL);} break; +case 48: +# line 164 "parser.y" +{yyval = yypvt[-0];} break; +case 49: +# line 169 "parser.y" +{defTycon(5,yypvt[-2],yypvt[-3],yypvt[-1],yypvt[-0]);} break; +case 50: +# line 171 "parser.y" +{defTycon(5,yypvt[-2],checkTyLhs(yypvt[-3]), + rev(yypvt[-1]),DATATYPE);} break; +case 51: +# line 174 "parser.y" +{defTycon(7,yypvt[-2],yypvt[-3], + ap(QUAL,pair(yypvt[-5],rev(yypvt[-1]))), + DATATYPE);} break; +case 52: +# line 178 "parser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 53: +# line 179 "parser.y" +{yyval = yypvt[-0];} break; +case 54: +# line 180 "parser.y" +{syntaxError("type defn lhs");} break; +case 55: +# line 182 "parser.y" +{yyval = gc2(yypvt[-0]);} break; +case 56: +# line 183 "parser.y" +{yyval = gc0(SYNONYM);} break; +case 57: +# line 185 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 58: +# line 186 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 59: +# line 188 "parser.y" +{yyval = gc3(sigdecl(yypvt[-1],singleton(yypvt[-2]), + yypvt[-0]));} break; +case 60: +# line 190 "parser.y" +{yyval = yypvt[-0];} break; +case 61: +# line 192 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 62: +# line 193 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 63: +# line 195 "parser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 64: +# line 196 "parser.y" +{if (!isCon(getHead(yypvt[-0]))) + syntaxError("data constructor"); + yyval = yypvt[-0];} break; +case 65: +# line 199 "parser.y" +{syntaxError("data type definition");} break; +case 66: +# line 201 "parser.y" +{yyval = gc0(NIL);} break; +case 67: +# line 202 "parser.y" +{yyval = gc2(singleton(yypvt[-0]));} break; +case 68: +# line 203 "parser.y" +{yyval = gc4(yypvt[-1]);} break; +case 69: +# line 205 "parser.y" +{yyval = gc0(NIL);} break; +case 70: +# line 206 "parser.y" +{yyval = yypvt[-0];} break; +case 71: +# line 208 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 72: +# line 209 "parser.y" +{yyval = gc1(singleton(yypvt[-0]));} break; +case 73: +# line 220 "parser.y" +{yyval = gc3(ap(QUAL,pair(yypvt[-2],yypvt[-0])));} break; +case 74: +# line 221 "parser.y" +{yyval = yypvt[-0];} break; +case 75: +# line 223 "parser.y" +{yyval = gc1(checkContext(yypvt[-0]));} break; +case 76: +# line 225 "parser.y" +{yyval = yypvt[-0];} break; +case 77: +# line 226 "parser.y" +{yyval = gc3(ap(ap(ARROW,yypvt[-2]),yypvt[-0]));} break; +case 78: +# line 227 "parser.y" +{syntaxError("type expression");} break; +case 79: +# line 229 "parser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 80: +# line 230 "parser.y" +{yyval = yypvt[-0];} break; +case 81: +# line 232 "parser.y" +{yyval = yypvt[-0];} break; +case 82: +# line 233 "parser.y" +{yyval = yypvt[-0];} break; +case 83: +# line 234 "parser.y" +{yyval = gc2(UNIT);} break; +case 84: +# line 235 "parser.y" +{yyval = gc3(ARROW);} break; +case 85: +# line 236 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 86: +# line 237 "parser.y" +{yyval = gc4(ap(ARROW,yypvt[-2]));} break; +case 87: +# line 238 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 88: +# line 239 "parser.y" +{yyval = gc3(buildTuple(yypvt[-1]));} break; +case 89: +# line 240 "parser.y" +{yyval = gc3(ap(LIST,yypvt[-1]));} break; +case 90: +# line 241 "parser.y" +{yyval = gc2(LIST);} break; +case 91: +# line 243 "parser.y" +{yyval = gc3(mkTuple(tupleOf(yypvt[-1])+1));} break; +case 92: +# line 244 "parser.y" +{yyval = gc1(mkTuple(2));} break; +case 93: +# line 246 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 94: +# line 247 "parser.y" +{yyval = gc3(cons(yypvt[-0],cons(yypvt[-2],NIL)));} break; +case 95: +# line 252 "parser.y" +{fixDefn(LEFT_ASS,yypvt[-2],yypvt[-1],yypvt[-0]); sp-=3;} break; +case 96: +# line 253 "parser.y" +{fixDefn(RIGHT_ASS,yypvt[-2],yypvt[-1],yypvt[-0]);sp-=3;} break; +case 97: +# line 254 "parser.y" +{fixDefn(NON_ASS,yypvt[-2],yypvt[-1],yypvt[-0]); sp-=3;} break; +case 98: +# line 256 "parser.y" +{yyval = gc1(checkPrec(yypvt[-0]));} break; +case 99: +# line 257 "parser.y" +{yyval = gc0(mkInt(DEF_PREC));} break; +case 100: +# line 259 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 101: +# line 260 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 102: +# line 262 "parser.y" +{yyval = yypvt[-0];} break; +case 103: +# line 263 "parser.y" +{yyval = yypvt[-0];} break; +case 104: +# line 264 "parser.y" +{yyval = gc1(varMinus);} break; +case 105: +# line 266 "parser.y" +{yyval = yypvt[-0];} break; +case 106: +# line 267 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 107: +# line 269 "parser.y" +{yyval = yypvt[-0];} break; +case 108: +# line 270 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 109: +# line 275 "parser.y" +{primDefn(yypvt[-3],yypvt[-2],yypvt[-0]); sp-=4;} break; +case 110: +# line 277 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 111: +# line 278 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 112: +# line 279 "parser.y" +{syntaxError("primitive defn");} break; +case 113: +# line 281 "parser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 114: +# line 286 "parser.y" +{classDefn(intOf(yypvt[-2]),yypvt[-1],yypvt[-0]); sp-=3;} break; +case 115: +# line 287 "parser.y" +{instDefn(intOf(yypvt[-2]),yypvt[-1],yypvt[-0]); sp-=3;} break; +case 116: +# line 288 "parser.y" +{sp-=2;} break; +case 117: +# line 290 "parser.y" +{yyval = gc3(pair(yypvt[-2],checkClass(yypvt[-0])));} break; +case 118: +# line 291 "parser.y" +{yyval = gc1(pair(NIL,checkClass(yypvt[-0])));} break; +case 119: +# line 293 "parser.y" +{yyval = gc4(yypvt[-1]);} break; +case 120: +# line 294 "parser.y" +{yyval = gc0(NIL);} break; +case 121: +# line 296 "parser.y" +{yyval = gc4(yypvt[-1]);} break; +case 122: +# line 297 "parser.y" +{yyval = gc0(NIL);} break; +case 123: +# line 299 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 124: +# line 300 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 125: +# line 302 "parser.y" +{yyval = gc1(yypvt[-0]);} break; +case 126: +# line 303 "parser.y" +{syntaxError("class body");} break; +case 127: +# line 308 "parser.y" +{yyval = gc3(sigdecl(yypvt[-1],yypvt[-2],yypvt[-0]));} break; +case 128: +# line 309 "parser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 129: +# line 311 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 130: +# line 312 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 131: +# line 314 "parser.y" +{yyval = gc2(letrec(yypvt[-0],yypvt[-1]));} break; +case 132: +# line 315 "parser.y" +{yyval = yypvt[-0];} break; +case 133: +# line 316 "parser.y" +{syntaxError("declaration");} break; +case 134: +# line 318 "parser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 135: +# line 319 "parser.y" +{yyval = gc1(grded(rev(yypvt[-0])));} break; +case 136: +# line 321 "parser.y" +{yyval = gc4(yypvt[-1]);} break; +case 137: +# line 323 "parser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 138: +# line 324 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 139: +# line 326 "parser.y" +{yyval = gc4(pair(yypvt[-1],pair(yypvt[-2],yypvt[-0])));} break; +case 140: +# line 333 "parser.y" +{yyval = gc5(pair(yypvt[-4],pair(yypvt[-0],yypvt[-3])));} break; +case 141: +# line 334 "parser.y" +{yyval = gc4(pair(yypvt[-3],pair(yypvt[-0],yypvt[-2])));} break; +case 142: +# line 336 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 143: +# line 337 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 144: +# line 339 "parser.y" +{yyval = yypvt[-0];} break; +case 145: +# line 340 "parser.y" +{yyval = gc3(varMinus);} break; +case 146: +# line 342 "parser.y" +{yyval = yypvt[-0];} break; +case 147: +# line 343 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 148: +# line 345 "parser.y" +{yyval = yypvt[-0];} break; +case 149: +# line 346 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 150: +# line 351 "parser.y" +{yyval = gc3(ap(ESIGN,pair(yypvt[-2],yypvt[-0])));} break; +case 151: +# line 352 "parser.y" +{yyval = yypvt[-0];} break; +case 152: +# line 353 "parser.y" +{syntaxError("expression");} break; +case 153: +# line 355 "parser.y" +{yyval = yypvt[-0];} break; +case 154: +# line 356 "parser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 155: +# line 357 "parser.y" +{yyval = gc1(tidyInfix(yypvt[-0]));} break; +case 156: +# line 359 "parser.y" +{yyval = gc3(ap(ap(yypvt[-1],yypvt[-2]),yypvt[-0]));} break; +case 157: +# line 360 "parser.y" +{yyval = gc5(ap(ap(yypvt[-1], + ap(ap(yypvt[-3],singleton(yypvt[-4])), + yypvt[-2])),yypvt[-0]));} break; +case 158: +# line 364 "parser.y" +{if (isInt(yypvt[-0])) + yyval = gc2(mkInt(-intOf(yypvt[-0]))); + else + yyval = gc2(ap(varNegate,yypvt[-0])); + } break; +case 159: +# line 369 "parser.y" +{yyval = gc4(ap(LAMBDA, + pair(rev(yypvt[-2]), + pair(yypvt[-1],yypvt[-0]))));} break; +case 160: +# line 372 "parser.y" +{yyval = gc6(letrec(yypvt[-3],yypvt[-0]));} break; +case 161: +# line 373 "parser.y" +{yyval = gc6(ap(COND,triple(yypvt[-4],yypvt[-2],yypvt[-0])));} break; +case 162: +# line 374 "parser.y" +{yyval = gc6(ap(CASE,pair(yypvt[-4],rev(yypvt[-1]))));} break; +case 163: +# line 375 "parser.y" +{yyval = yypvt[-0];} break; +case 164: +# line 377 "parser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 165: +# line 378 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 166: +# line 380 "parser.y" +{yyval = gc2(ap(yypvt[-1],yypvt[-0]));} break; +case 167: +# line 381 "parser.y" +{yyval = gc2(ap(RUNST,yypvt[-0]));} break; +case 168: +# line 382 "parser.y" +{yyval = yypvt[-0];} break; +case 169: +# line 384 "parser.y" +{yyval = yypvt[-0];} break; +case 170: +# line 385 "parser.y" +{yyval = gc3(ap(ASPAT,pair(yypvt[-2],yypvt[-0])));} break; +case 171: +# line 386 "parser.y" +{yyval = gc2(ap(LAZYPAT,yypvt[-0]));} break; +case 172: +# line 387 "parser.y" +{yyval = gc1(WILDCARD);} break; +case 173: +# line 388 "parser.y" +{yyval = yypvt[-0];} break; +case 174: +# line 389 "parser.y" +{yyval = gc2(UNIT);} break; +case 175: +# line 390 "parser.y" +{yyval = yypvt[-0];} break; +case 176: +# line 391 "parser.y" +{yyval = yypvt[-0];} break; +case 177: +# line 392 "parser.y" +{yyval = yypvt[-0];} break; +case 178: +# line 393 "parser.y" +{yyval = yypvt[-0];} break; +case 179: +# line 394 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 180: +# line 395 "parser.y" +{yyval = gc3(buildTuple(yypvt[-1]));} break; +case 181: +# line 396 "parser.y" +{yyval = gc3(yypvt[-1]);} break; +case 182: +# line 397 "parser.y" +{yyval = gc4(ap(yypvt[-1],yypvt[-2]));} break; +case 183: +# line 398 "parser.y" +{yyval = gc4(ap(ap(varFlip,yypvt[-2]),yypvt[-1]));} break; +case 184: +# line 399 "parser.y" +{yyval = gc4(ap(ap(varFlip,yypvt[-2]),yypvt[-1]));} break; +case 185: +# line 401 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 186: +# line 402 "parser.y" +{yyval = gc3(cons(yypvt[-0],cons(yypvt[-2],NIL)));} break; +case 187: +# line 404 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 188: +# line 405 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 189: +# line 407 "parser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 190: +# line 409 "parser.y" +{yyval = gc2(letrec(yypvt[-0],yypvt[-1]));} break; +case 191: +# line 410 "parser.y" +{yyval = yypvt[-0];} break; +case 192: +# line 412 "parser.y" +{yyval = gc1(grded(rev(yypvt[-0])));} break; +case 193: +# line 413 "parser.y" +{yyval = gc2(pair(yypvt[-1],yypvt[-0]));} break; +case 194: +# line 414 "parser.y" +{syntaxError("case expression");} break; +case 195: +# line 416 "parser.y" +{yyval = gc2(cons(yypvt[-0],yypvt[-1]));} break; +case 196: +# line 417 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 197: +# line 419 "parser.y" +{yyval = gc4(pair(yypvt[-1],pair(yypvt[-2],yypvt[-0])));} break; +case 198: +# line 424 "parser.y" +{yyval = gc0(nameNil);} break; +case 199: +# line 425 "parser.y" +{yyval = gc1(ap(FINLIST,cons(yypvt[-0],NIL)));} break; +case 200: +# line 426 "parser.y" +{yyval = gc1(ap(FINLIST,rev(yypvt[-0])));} break; +case 201: +# line 427 "parser.y" +{yyval = gc3(ap(COMP,pair(yypvt[-2],rev(yypvt[-0]))));} break; +case 202: +# line 428 "parser.y" +{yyval = gc3(ap(ap(varFromTo,yypvt[-2]),yypvt[-0]));} break; +case 203: +# line 429 "parser.y" +{yyval = gc4(ap(ap(varFromThen,yypvt[-3]),yypvt[-1]));} break; +case 204: +# line 430 "parser.y" +{yyval = gc2(ap(varFrom,yypvt[-1]));} break; +case 205: +# line 431 "parser.y" +{yyval = gc5(ap(ap(ap(varFromThenTo, + yypvt[-4]),yypvt[-2]),yypvt[-0]));} break; +case 206: +# line 434 "parser.y" +{yyval = gc3(cons(yypvt[-0],yypvt[-2]));} break; +case 207: +# line 435 "parser.y" +{yyval = gc1(cons(yypvt[-0],NIL));} break; +case 208: +# line 437 "parser.y" +{yyval = gc3(ap(FROMQUAL,pair(yypvt[-2],yypvt[-0])));} break; +case 209: +# line 438 "parser.y" +{yyval = gc3(ap(QWHERE, + singleton( + pair(yypvt[-2],pair(yypvt[-1], + yypvt[-0])))));} break; +case 210: +# line 442 "parser.y" +{yyval = gc1(ap(BOOLQUAL,yypvt[-0]));} break; +case 211: +# line 443 "parser.y" +{yyval = gc4(ap(QWHERE,yypvt[-1]));} break; +case 212: +# line 469 "parser.y" +{yyval = gc2(yypvt[-0]);} break; +case 213: +# line 470 "parser.y" +{yyval = yypvt[-0];} break; +case 214: +# line 472 "parser.y" +{yyval = yypvt[-0];} break; +case 215: +# line 473 "parser.y" +{yyerrok; + if (canUnOffside()) { + unOffside(); + /* insert extra token on stack*/ + push(NIL); + pushed(0) = pushed(1); + pushed(1) = mkInt(column); + } + else + syntaxError("definition"); + } break; +# line 148 "/usr/lib/yaccpar" + + } + goto yystack; /* stack new state and value */ + + } diff --git a/src/parser.y b/src/parser.y new file mode 100644 index 0000000..f99a4ec --- /dev/null +++ b/src/parser.y @@ -0,0 +1,813 @@ +/* -------------------------------------------------------------------------- + * parser.y: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * You should expect 14 shift/reduce conflicts when passing + * this grammar through yacc. Don't worry, they will all be + * resolved correctly as shifts. + * + * There will also be 8 reduce/reduce conflicts. These are + * more worrying although they will still be resolved correctly + * as long as you keep the two grammar rules concerned (see the + * y.output file for details) in the same order as used here. + * + * Gofer parser (included as part of input.c) + * ------------------------------------------------------------------------*/ + +%{ +#ifndef lint +#define lint +#endif +#define defTycon(n,l,lhs,rhs,w) tyconDefn(intOf(l),lhs,rhs,w); sp-=n +#define sigdecl(l,vs,t) ap(SIGDECL,triple(l,vs,t)) +#define grded(gs) ap(GUARDED,gs) +#define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) +#define yyerror(s) /* errors handled elsewhere */ +#define YYSTYPE Cell + +static Cell local gcShadow Args((Int,Cell)); +static Void local syntaxError Args((String)); +static String local unexpected Args((Void)); +static Cell local checkPrec Args((Cell)); +static Void local fixDefn Args((Syntax,Cell,Cell,List)); +static Void local setSyntax Args((Int,Syntax,Cell)); +static Cell local buildTuple Args((List)); +static Cell local checkClass Args((Cell)); +static List local checkContext Args((List)); +static Pair local checkDo Args((List)); +static Cell local checkTyLhs Args((Cell)); +static Cell local tidyInfix Args((Cell)); + +/* For the purposes of reasonably portable garbage collection, it is + * necessary to simulate the YACC stack on the Gofer stack to keep + * track of all intermediate constructs. The lexical analyser + * pushes a token onto the stack for each token that is found, with + * these elements being removed as reduce actions are performed, + * taking account of look-ahead tokens as described by gcShadow() + * below. + * + * Of the non-terminals used below, only start, topDecl & begin do not leave + * any values on the Gofer stack. The same is true for the terminals + * EVALEX and SCRIPT. At the end of a successful parse, there should only + * be one element left on the stack, containing the result of the parse. + */ + +#define gc0(e) gcShadow(0,e) +#define gc1(e) gcShadow(1,e) +#define gc2(e) gcShadow(2,e) +#define gc3(e) gcShadow(3,e) +#define gc4(e) gcShadow(4,e) +#define gc5(e) gcShadow(5,e) +#define gc6(e) gcShadow(6,e) +#define gc7(e) gcShadow(7,e) + +%} + +%token EVALEX SCRIPT +%token '=' COCO INFIXL INFIXR INFIX FUNARROW +%token '-' ',' '@' '(' ')' '|' +%token ';' UPTO '[' ']' CASEXP OF +%token IF THEN ELSE WHERE TYPE DATA +%token FROM '\\' '~' LET IN '`' +%token VAROP VARID NUMLIT CHARLIT STRINGLIT REPEAT +%token CONOP CONID +%token TCLASS IMPLIES TINSTANCE +%token DO TRUNST + +%token PRIMITIVE + /* Haskell keywords, for compatibility */ +%token DEFAULT DERIVING HIDING IMPORT INTERFACE MODULE +%token RENAMING TO + +%% +/*- Top level script/module structure -------------------------------------*/ + +start : EVALEX exp {inputExpr = $2; sp-=1;} + | EVALEX exp wherePart {inputExpr = letrec($3,$2); sp-=2;} + | SCRIPT topModule {valDefns = $2; sp-=1;} + | error {syntaxError("input");} + ; + +/*- Haskell module header/import parsing: ---------------------------------*/ +/* Syntax for Haskell modules (module headers and imports) is parsed but */ +/* is otherwise ignored by Gofer. This is for the benefit of those who */ +/* use Gofer to develop code which will ultimately be fed into a full */ +/* Haskell system. (default and deriving are treated in a similar way.) */ +/* */ +/* Note that we do not make any attempt to provide actions that store */ +/* the parsed structures in any way for later use. */ +/*-------------------------------------------------------------------------*/ + +topModule : begin topDecls close {$$ = gc2($2);} + | modules {$$ = $1;} + ; +begin : error {yyerrok; goOffside(startColumn);} + ; +topDecls : topDecls ';' topDecl {$$ = gc2($1);} + | topDecls ';' decl {$$ = gc3(cons($3,$1));} + | topDecl {$$ = gc0(NIL);} + | decl {$$ = gc1(cons($1,NIL));} + | error {syntaxError("definition");} + ; +modules : modules module {$$ = gc2(appendOnto($2,$1));} + | module {$$ = $1;} + ; +module : MODULE modid expspec WHERE '{' topDecls close + {$$ = gc7($6);} + | MODULE error {syntaxError("module definition");} + ; +topDecl : IMPORT modid impspec rename {sp-=4;} + | IMPORT error {syntaxError("import declaration");} + ; +modid : CONID {$$ = $1;} + | STRINGLIT {$$ = $1;} + ; +expspec : /* empty */ {$$ = gc0(NIL);} + | '(' exports ')' {$$ = gc3(NIL);} + ; +exports : exports ',' export {$$ = gc3(NIL);} + | export {$$ = $1;} + ; +export : entity {$$ = $1;} + | modid UPTO {$$ = gc2(NIL);} + ; +impspec : /* empty */ {$$ = gc0(NIL);} + | HIDING '(' imports ')' {$$ = gc4(NIL);} + | '(' imports0 ')' {$$ = gc3(NIL);} + ; +imports0 : /* empty */ {$$ = gc0(NIL);} + | imports {$$ = $1;} + ; +imports : imports ',' entity {$$ = gc3(NIL);} + | entity {$$ = $1;} + ; +rename : /* empty */ {$$ = gc0(NIL);} + | RENAMING '(' renamings ')' {$$ = gc4(NIL);} + ; +renamings : renamings ',' renaming {$$ = gc3(NIL);} + | renaming {$$ = $1;} + ; +renaming : var TO var {$$ = gc3(NIL);} + | conid TO conid {$$ = gc3(NIL);} + ; +entity : var {$$ = $1;} + | CONID {$$ = $1;} + | CONID '(' UPTO ')' {$$ = gc4(NIL);} + | CONID '(' conids ')' {$$ = gc4(NIL);} + | CONID '(' vars0 ')' {$$ = gc4(NIL);} + ; +conids : conids ',' conid {$$ = gc3(NIL);} + | conid {$$ = $1;} + ; +vars0 : /* empty */ {$$ = gc0(NIL);} + | vars {$$ = $1;} + ; + +/*- Type declarations: ----------------------------------------------------*/ + +topDecl : TYPE tyLhs '=' type invars {defTycon(5,$3,$2,$4,$5);} + | DATA type '=' constrs deriving /* deriving is IGNORED */ + {defTycon(5,$3,checkTyLhs($2), + rev($4),DATATYPE);} + | DATA context IMPLIES tyLhs '=' constrs deriving + {defTycon(7,$5,$4, + ap(QUAL,pair($2,rev($6))), + DATATYPE);} + ; +tyLhs : tyLhs VARID {$$ = gc2(ap($1,$2));} + | CONID {$$ = $1;} + | error {syntaxError("type defn lhs");} + ; +invars : IN rsvars {$$ = gc2($2);} + | /* empty */ {$$ = gc0(SYNONYM);} + ; +rsvars : rsvars ',' rsvar {$$ = gc3(cons($3,$1));} + | rsvar {$$ = gc1(cons($1,NIL));} + ; +rsvar : var COCO sigType {$$ = gc3(sigdecl($2,singleton($1), + $3));} + | var {$$ = $1;} + ; +constrs : constrs '|' constr {$$ = gc3(cons($3,$1));} + | constr {$$ = gc1(cons($1,NIL));} + ; +constr : type conop type {$$ = gc3(ap(ap($2,$1),$3));} + | type {if (!isCon(getHead($1))) + syntaxError("data constructor"); + $$ = $1;} + | error {syntaxError("data type definition");} + ; +deriving : /* empty */ {$$ = gc0(NIL);} + | DERIVING CONID {$$ = gc2(singleton($2));} + | DERIVING '(' derivs0 ')' {$$ = gc4($3);} + ; +derivs0 : /* empty */ {$$ = gc0(NIL);} + | derivs {$$ = $1;} + ; +derivs : derivs ',' CONID {$$ = gc3(cons($3,$1));} + | CONID {$$ = gc1(singleton($1));} + ; + +/*- Type expressions: -----------------------------------------------------*/ +/* Parser is not sufficently powerful to distinguish between a predicate + * such as "Dual a b" and a type "Sum a b", or between a tuple type and + * a context (e.g. (Alpha a, Beta b) is a tuple or context?). For this + * reason, individual predicates and contexts are parsed as types, with + * additional code to check for well formed context/classes. + */ + +sigType : context IMPLIES type {$$ = gc3(ap(QUAL,pair($1,$3)));} + | type {$$ = $1;} + ; +context : type {$$ = gc1(checkContext($1));} + ; +type : ctype {$$ = $1;} + | ctype FUNARROW type {$$ = gc3(ap(ap(ARROW,$1),$3));} + | error {syntaxError("type expression");} + ; +ctype : ctype atype {$$ = gc2(ap($1,$2));} + | atype {$$ = $1;} + ; +atype : VARID {$$ = $1;} + | CONID {$$ = $1;} + | '(' ')' {$$ = gc2(UNIT);} + | '(' FUNARROW ')' {$$ = gc3(ARROW);} + | '(' type ')' {$$ = gc3($2);} + | '(' ctype FUNARROW ')' {$$ = gc4(ap(ARROW,$2));} + | '(' tupCommas ')' {$$ = gc3($2);} + | '(' typeTuple ')' {$$ = gc3(buildTuple($2));} + | '[' type ']' {$$ = gc3(ap(LIST,$2));} + | '[' ']' {$$ = gc2(LIST);} + ; +tupCommas : tupCommas ',' {$$ = gc2(mkTuple(tupleOf($1)+1));} + | ',' {$$ = gc1(mkTuple(2));} + ; +typeTuple : typeTuple ',' type {$$ = gc3(cons($3,$1));} + | type ',' type {$$ = gc3(cons($3,cons($1,NIL)));} + ; + +/*- Fixity declarations: --------------------------------------------------*/ + +topDecl : INFIXL optdigit ops {fixDefn(LEFT_ASS,$1,$2,$3); sp-=3;} + | INFIXR optdigit ops {fixDefn(RIGHT_ASS,$1,$2,$3);sp-=3;} + | INFIX optdigit ops {fixDefn(NON_ASS,$1,$2,$3); sp-=3;} + ; +optdigit : NUMLIT {$$ = gc1(checkPrec($1));} + | /* empty */ {$$ = gc0(mkInt(DEF_PREC));} + ; +ops : ops ',' op {$$ = gc3(cons($3,$1));} + | op {$$ = gc1(cons($1,NIL));} + ; +op : varop {$$ = $1;} + | conop {$$ = $1;} + | '-' {$$ = gc1(varMinus);} + ; +varop : VAROP {$$ = $1;} + | '`' VARID '`' {$$ = gc3($2);} + ; +conop : CONOP {$$ = $1;} + | '`' CONID '`' {$$ = gc3($2);} + ; + +/*- Processing definitions of primitives ----------------------------------*/ + +topDecl : PRIMITIVE prims COCO sigType{primDefn($1,$2,$4); sp-=4;} + ; +prims : prims ',' prim {$$ = gc3(cons($3,$1));} + | prim {$$ = gc1(cons($1,NIL));} + | error {syntaxError("primitive defn");} + ; +prim : var STRINGLIT {$$ = gc2(pair($1,$2));} + ; + +/*- Class declarations: ---------------------------------------------------*/ + +topDecl : TCLASS classHead classBody {classDefn(intOf($1),$2,$3); sp-=3;} + | TINSTANCE classHead instBody{instDefn(intOf($1),$2,$3); sp-=3;} + | DEFAULT type {sp-=2;} /* default is IGNORED */ + ; +classHead : context IMPLIES type {$$ = gc3(pair($1,checkClass($3)));} + | type {$$ = gc1(pair(NIL,checkClass($1)));} + ; +classBody : WHERE '{' csigdecls close {$$ = gc4($3);} + | /* empty */ {$$ = gc0(NIL);} + ; +instBody : WHERE '{' decls close {$$ = gc4($3);} + | /* empty */ {$$ = gc0(NIL);} + ; +csigdecls : csigdecls ';' csigdecl {$$ = gc3(cons($3,$1));} + | csigdecl {$$ = gc1(cons($1,NIL));} + ; +csigdecl : decl {$$ = gc1($1);} + | error {syntaxError("class body");} + ; + +/*- Value declarations: ---------------------------------------------------*/ + +decl : vars COCO sigType {$$ = gc3(sigdecl($2,$1,$3));} + | opExp rhs {$$ = gc2(pair($1,$2));} + ; +decls : decls ';' decl {$$ = gc3(cons($3,$1));} + | decl {$$ = gc1(cons($1,NIL));} + ; +rhs : rhs1 wherePart {$$ = gc2(letrec($2,$1));} + | rhs1 {$$ = $1;} + | error {syntaxError("declaration");} + ; +rhs1 : '=' exp {$$ = gc2(pair($1,$2));} + | gdefs {$$ = gc1(grded(rev($1)));} + ; +wherePart : WHERE '{' decls close {$$ = gc4($3);} + ; +gdefs : gdefs gdef {$$ = gc2(cons($2,$1));} + | gdef {$$ = gc1(cons($1,NIL));} + ; +gdef : '|' exp '=' exp {$$ = gc4(pair($3,pair($2,$4)));} + /* Experimental, undocumented syntax for Orwell style guards */ + /* The corresponding forms for case definitions are NOT supported*/ + /* because that would require a change to the original syntax for*/ + /* Gofer, rather than a simple extension as is the case here. */ + /* Perhaps a slight reworking of the grammar might eliminate this*/ + /* problem... */ + | '=' exp ',' IF exp {$$ = gc5(pair($1,pair($5,$2)));} + | '=' exp ',' exp {$$ = gc4(pair($1,pair($4,$2)));} + ; +vars : vars ',' var {$$ = gc3(cons($3,$1));} + | var {$$ = gc1(cons($1,NIL));} + ; +var : varid {$$ = $1;} + | '(' '-' ')' {$$ = gc3(varMinus);} + ; +varid : VARID {$$ = $1;} + | '(' VAROP ')' {$$ = gc3($2);} + ; +conid : CONID {$$ = $1;} + | '(' CONOP ')' {$$ = gc3($2);} + ; + +/*- Expressions: ----------------------------------------------------------*/ + +exp : opExp COCO sigType {$$ = gc3(ap(ESIGN,pair($1,$3)));} + | opExp {$$ = $1;} + | error {syntaxError("expression");} + ; +opExp : pfxExp {$$ = $1;} + | pfxExp op pfxExp {$$ = gc3(ap(ap($2,$1),$3));} + | opExp0 {$$ = gc1(tidyInfix($1));} + ; +opExp0 : opExp0 op pfxExp {$$ = gc3(ap(ap($2,$1),$3));} + | pfxExp op pfxExp op pfxExp {$$ = gc5(ap(ap($4, + ap(ap($2,singleton($1)), + $3)),$5));} + ; +pfxExp : '-' appExp {if (isInt($2)) + $$ = gc2(mkInt(-intOf($2))); + else + $$ = gc2(ap(varNegate,$2)); + } + | '\\' pats FUNARROW exp {$$ = gc4(ap(LAMBDA, + pair(rev($2), + pair($3,$4))));} + | LET '{' decls close IN exp {$$ = gc6(letrec($3,$6));} + | IF exp THEN exp ELSE exp {$$ = gc6(ap(COND,triple($2,$4,$6)));} + | CASEXP exp OF '{' alts close{$$ = gc6(ap(CASE,pair($2,rev($5))));} + | appExp {$$ = $1;} + ; +pats : pats atomic {$$ = gc2(cons($2,$1));} + | atomic {$$ = gc1(cons($1,NIL));} + ; +appExp : appExp atomic {$$ = gc2(ap($1,$2));} + | TRUNST atomic {$$ = gc2(ap(RUNST,$2));} + | atomic {$$ = $1;} + ; +atomic : var {$$ = $1;} + | var '@' atomic {$$ = gc3(ap(ASPAT,pair($1,$3)));} + | '~' atomic {$$ = gc2(ap(LAZYPAT,$2));} + | '_' {$$ = gc1(WILDCARD);} + | conid {$$ = $1;} + | '(' ')' {$$ = gc2(UNIT);} + | NUMLIT {$$ = $1;} + | CHARLIT {$$ = $1;} + | STRINGLIT {$$ = $1;} + | REPEAT {$$ = $1;} + | '(' exp ')' {$$ = gc3($2);} + | '(' exps2 ')' {$$ = gc3(buildTuple($2));} + | '[' list ']' {$$ = gc3($2);} + | '(' pfxExp op ')' {$$ = gc4(ap($3,$2));} + | '(' varop atomic ')' {$$ = gc4(ap(ap(varFlip,$2),$3));} + | '(' conop atomic ')' {$$ = gc4(ap(ap(varFlip,$2),$3));} + ; +exps2 : exps2 ',' exp {$$ = gc3(cons($3,$1));} + | exp ',' exp {$$ = gc3(cons($3,cons($1,NIL)));} + ; +alts : alts ';' alt {$$ = gc3(cons($3,$1));} + | alt {$$ = gc1(cons($1,NIL));} + ; +alt : opExp altRhs {$$ = gc2(pair($1,$2));} + ; +altRhs : altRhs1 wherePart {$$ = gc2(letrec($2,$1));} + | altRhs1 {$$ = $1;} + ; +altRhs1 : guardAlts {$$ = gc1(grded(rev($1)));} + | FUNARROW exp {$$ = gc2(pair($1,$2));} + | error {syntaxError("case expression");} + ; +guardAlts : guardAlts guardAlt {$$ = gc2(cons($2,$1));} + | guardAlt {$$ = gc1(cons($1,NIL));} + ; +guardAlt : '|' opExp FUNARROW exp {$$ = gc4(pair($3,pair($2,$4)));} + ; + +/*- List Expressions: -------------------------------------------------------*/ + +list : /* empty */ {$$ = gc0(nameNil);} + | exp {$$ = gc1(ap(FINLIST,cons($1,NIL)));} + | exps2 {$$ = gc1(ap(FINLIST,rev($1)));} + | exp '|' quals {$$ = gc3(ap(COMP,pair($1,rev($3))));} + | exp UPTO exp {$$ = gc3(ap(ap(varFromTo,$1),$3));} + | exp ',' exp UPTO {$$ = gc4(ap(ap(varFromThen,$1),$3));} + | exp UPTO {$$ = gc2(ap(varFrom,$1));} + | exp ',' exp UPTO exp {$$ = gc5(ap(ap(ap(varFromThenTo, + $1),$3),$5));} + ; +quals : quals ',' qual {$$ = gc3(cons($3,$1));} + | qual {$$ = gc1(cons($1,NIL));} + ; +qual : exp FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));} + | exp '=' exp {$$ = gc3(ap(QWHERE, + singleton( + pair($1,pair($2, + $3)))));} + | exp {$$ = gc1(ap(BOOLQUAL,$1));} + | LET '{' decls close {$$ = gc4(ap(QWHERE,$3));} + ; + +/*- Do notation for monad comprehensions ----------------------------------*/ +/* To experiment with the do notation for monad comprehensions, uncomment */ +/* the following productions, set the DO_COMPS flag to 1 in prelude.h and */ +/* recompile. Note that this makes `do' a keyword, so any programs that */ +/* use this word as an identifier will need to be changed. */ + +/* DO_COMPS + +pfxExp : DO '{' dquals close1 {$$ = gc4(ap(DOCOMP,checkDo($3)));} + ; +dqual : exp FROM exp {$$ = gc3(ap(FROMQUAL,pair($1,$3)));} + | LET '{' decls close {$$ = gc4(ap(QWHERE,$3));} + | IF exp {$$ = gc2(ap(BOOLQUAL,$2));} + | exp {$$ = gc1(ap(DOQUAL,$1));} + ; +dquals : dquals ';' dqual {$$ = gc3(cons($3,$1));} + | dqual {$$ = gc1(cons($1,NIL));} + ; +*/ + +/*- Find closing brace ----------------------------------------------------*/ + + /* deal with trailing semicolon */ +close : ';' close1 {$$ = gc2($2);} + | close1 {$$ = $1;} + ; +close1 : '}' {$$ = $1;} + | error {yyerrok; + if (canUnOffside()) { + unOffside(); + /* insert extra token on stack*/ + push(NIL); + pushed(0) = pushed(1); + pushed(1) = mkInt(column); + } + else + syntaxError("definition"); + } + ; + +/*-------------------------------------------------------------------------*/ + +%% + +static Cell local gcShadow(n,e) /* keep parsed fragments on stack */ +Int n; +Cell e; { + /* If a look ahead token is held then the required stack transformation + * is: + * pushed: n 1 0 1 0 + * x1 | ... | xn | la ===> e | la + * top() top() + * + * Othwerwise, the transformation is: + * pushed: n-1 0 0 + * x1 | ... | xn ===> e + * top() top() + */ + if (yychar>=0) { + pushed(n-1) = top(); + pushed(n) = e; + } + else + pushed(n-1) = e; + sp -= (n-1); + return e; +} + +static Void local syntaxError(s) /* report on syntax error */ +String s; { + ERROR(row) "Syntax error in %s (unexpected %s)", s, unexpected() + EEND; +} + +static String local unexpected() { /* find name for unexpected token */ + static char buffer[100]; + static char *fmt = "%s \"%s\""; + static char *kwd = "keyword"; + static char *hkw = "(Haskell) keyword"; + + switch (yychar) { + case 0 : return "end of input"; + +#define keyword(kw) sprintf(buffer,fmt,kwd,kw); return buffer; + case INFIXL : keyword("infixl"); + case INFIXR : keyword("infixr"); + case INFIX : keyword("infix"); + case TINSTANCE : keyword("instance"); + case TCLASS : keyword("class"); + case PRIMITIVE : keyword("primitive"); + case CASEXP : keyword("case"); + case OF : keyword("of"); + case IF : keyword("if"); + case DO : keyword("do"); + case TRUNST : keyword("runST"); + case THEN : keyword("then"); + case ELSE : keyword("else"); + case WHERE : keyword("where"); + case TYPE : keyword("type"); + case DATA : keyword("data"); + case LET : keyword("let"); + case IN : keyword("in"); +#undef keyword + +#define hasword(kw) sprintf(buffer,fmt,hkw,kw); return buffer; + case DEFAULT : hasword("default"); + case DERIVING : hasword("deriving"); + case HIDING : hasword("hiding"); + case IMPORT : hasword("import"); + case INTERFACE : hasword("interface"); + case MODULE : hasword("module"); + case RENAMING : hasword("renaming"); + case TO : hasword("to"); +#undef hasword + + case FUNARROW : return "`->'"; + case '=' : return "`='"; + case COCO : return "`::'"; + case '-' : return "`-'"; + case ',' : return "comma"; + case '@' : return "`@'"; + case '(' : return "`('"; + case ')' : return "`)'"; + case '|' : return "`|'"; + case ';' : return "`;'"; + case UPTO : return "`..'"; + case '[' : return "`['"; + case ']' : return "`]'"; + case FROM : return "`<-'"; + case '\\' : return "backslash (lambda)"; + case '~' : return "tilde"; + case '`' : return "backquote"; + case VAROP : + case VARID : + case CONOP : + case CONID : sprintf(buffer,"symbol \"%s\"", + textToStr(textOf(yylval))); + return buffer; + case NUMLIT : return "numeric literal"; + case CHARLIT : return "character literal"; + case STRINGLIT : return "string literal"; + case IMPLIES : return "`=>"; + default : return "token"; + } +} + +static Cell local checkPrec(p) /* Check for valid precedence value */ +Cell p; { + if (!isInt(p) || intOf(p)MAX_PREC) { + ERROR(row) "Precedence value must be an integer in the range [%d..%d]", + MIN_PREC, MAX_PREC + EEND; + } + return p; +} + +static Void local fixDefn(a,line,p,ops)/* Declare syntax of operators */ +Syntax a; +Cell line; +Cell p; +List ops; { + Int l = intOf(line); + a = mkSyntax(a,intOf(p)); + map2Proc(setSyntax,l,a,ops); +} + +static Void local setSyntax(line,sy,op)/* set syntax of individ. operator */ +Int line; +Syntax sy; +Cell op; { + addSyntax(line,textOf(op),sy); + opDefns = cons(op,opDefns); +} + +static Cell local buildTuple(tup) /* build tuple (x1,...,xn) from list*/ +List tup; { /* [xn,...,x1] */ + Int n = 0; + Cell t = tup; + Cell x; + + do { /* . . */ + x = fst(t); /* / \ / \ */ + fst(t) = snd(t); /* xn . . xn */ + snd(t) = x; /* . ===> . */ + x = t; /* . . */ + t = fun(x); /* . . */ + n++; /* / \ / \ */ + } while (nonNull(t)); /* x1 NIL (n) x1 */ + fst(x) = mkTuple(n); + return tup; +} + +/* The yacc parser presented above is not sufficiently powerful to + * determine whether a tuple at the front of a sigType is part of a + * context: e.g. (Eq a, Num a) => a -> a -> a + * or a type: e.g. (Tree a, Tree a) -> Tree a + * + * Rather than complicate the grammar, both are parsed as tuples of types, + * using the following checks afterwards to ensure that the correct syntax + * is used in the case of a tupled context. + */ + +static List local checkContext(con) /* validate type class context */ +Type con; { + if (con==UNIT) /* allows empty context () */ + return NIL; + else if (whatIs(getHead(con))==TUPLE) { + List qs = NIL; + + while (isAp(con)) { /* undo work of buildTuple :-( */ + Cell temp = fun(con); + fun(con) = arg(con); + arg(con) = qs; + qs = con; + con = temp; + checkClass(hd(qs)); + } + return qs; + } + else /* single context expression */ + return singleton(checkClass(con)); +} + +static Cell local checkClass(c) /* check that type expr is a class */ +Cell c; { /* constrnt of the form C t1 .. tn */ + Cell cn = getHead(c); + + if (!isCon(cn)) + syntaxError("class expression"); + else if (argCount<1) { + ERROR(row) "Class \"%s\" must have at least one argument", + textToStr(textOf(cn)) + EEND; + } + return c; +} + +static Pair local checkDo(dqs) /* convert reversed list of dquals */ +List dqs; { /* to a (expr,quals) pair */ +#if DO_COMPS + if (isNull(dqs) || whatIs(hd(dqs))!=DOQUAL) { + ERROR(row) "Last generator in do {...} must be an expression" + EEND; + } + fst(dqs) = snd(fst(dqs)); /* put expression in fst of pair */ + snd(dqs) = rev(snd(dqs)); /* & reversed list of quals in snd */ +#endif + return dqs; +} + +static Cell local checkTyLhs(c) /* check that lhs is of the form */ +Cell c; { /* T a1 ... a */ + Cell tlhs = c; + while (isAp(tlhs) && whatIs(arg(tlhs))==VARIDCELL) + tlhs = fun(tlhs); + if (whatIs(tlhs)!=CONIDCELL) { + ERROR(row) "Illegal left hand side in datatype definition" + EEND; + } + return c; +} + +/* expressions involving a sequence of two or more infix operator symbols + * are parsed as elements of type: + * InfixExpr ::= [Expr] + * | ap(ap(Operator,InfixExpr),Expr) + * + * thus x0 +1 x1 ... +n xn is parsed as: +n (....(+1 [x0] x1)....) xn + * + * Once the expression has been completely parsed, this parsed form is + * `tidied' according to the precedences and associativities declared for + * each operator symbol. + * + * The tidy process uses a `stack' of type: + * TidyStack ::= ap(ap(Operator,TidyStack),Expr) + * | NIL + * when the ith layer of an InfixExpr has been transferred to the stack, the + * stack is of the form: +i (....(+n NIL xn)....) xi + * + * The tidy function is based on a simple shift-reduce parser: + * + * tidy :: InfixExpr -> TidyStack -> Expr + * tidy [m] ss = foldl (\x f-> f x) m ss + * tidy (m*n) [] = tidy m [(*n)] + * tidy (m*n) ((+o):ss) + * | amb = error "Ambiguous" + * | shift = tidy m ((*n):(+o):ss) + * | reduce = tidy (m*(n+o)) ss + * where sye = syntaxOf (*) + * (ae,pe) = sye + * sys = syntaxOf (+) + * (as,ps) = sys + * amb = pe==ps && (ae/=as || ae==NON_ASS) + * shift = pe>ps || (ps==pe && ae==LEFT_ASS) + * reduce = otherwise + * + * N.B. the conditions amb, shift, reduce are NOT mutually exclusive and + * must be tested in that order. + * + * As a concession to efficiency, we lower the number of calls to syntaxOf + * by keeping track of the values of sye, sys throughout the process. The + * value APPLIC is used to indicate that the syntax value is unknown. + */ + +static Cell local tidyInfix(e) /* convert InfixExpr to Expr */ +Cell e; { /* :: InfixExpr */ + Cell s = NIL; /* :: TidyStack */ + Syntax sye = APPLIC; /* Syntax of op in e (init unknown) */ + Syntax sys = APPLIC; /* Syntax of op in s (init unknown) */ + Cell temp; + + while (nonNull(tl(e))) { + if (isNull(s)) { + s = e; + e = arg(fun(s)); + arg(fun(s)) = NIL; + sys = sye; + sye = APPLIC; + } + else { + if (sye==APPLIC) { /* calculate sye (if unknown) */ + sye = syntaxOf(textOf(fun(fun(e)))); + if (sye==APPLIC) sye=DEF_OPSYNTAX; + } + if (sys==APPLIC) { /* calculate sys (if unknown) */ + sys = syntaxOf(textOf(fun(fun(s)))); + if (sys==APPLIC) sys=DEF_OPSYNTAX; + } + + if (precOf(sye)==precOf(sys) && /* amb */ + (assocOf(sye)!=assocOf(sys) || assocOf(sye)==NON_ASS)) { + ERROR(row) "Ambiguous use of operator \"%s\" with \"%s\"", + textToStr(textOf(fun(fun(e)))), + textToStr(textOf(fun(fun(s)))) + EEND; + } + else if (precOf(sye)>precOf(sys) || /* shift */ + (precOf(sye)==precOf(sys) && assocOf(sye)==LEFT_ASS)) { + temp = arg(fun(e)); + arg(fun(e)) = s; + s = e; + e = temp; + sys = sye; + sye = APPLIC; + } + else { /* reduce */ + temp = arg(fun(s)); + arg(fun(s)) = arg(e); + arg(e) = s; + s = temp; + sys = APPLIC; + /* sye unchanged */ + } + } + } + + e = hd(e); + while (nonNull(s)) { + temp = arg(fun(s)); + arg(fun(s)) = e; + e = s; + s = temp; + } + + return e; +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/preds.c b/src/preds.c new file mode 100644 index 0000000..135d092 --- /dev/null +++ b/src/preds.c @@ -0,0 +1,775 @@ +/* -------------------------------------------------------------------------- + * preds.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Part of type checker dealing with predicates and entailment. + * ------------------------------------------------------------------------*/ + +Bool anyEvidence = TRUE; /* no need to search for `best' */ + /* evidence - any will do. */ +Int maxEvidLevel = 8; /* maximum no. of dict selects */ +Bool silentEvFail = TRUE; /* TRUE => fail silently if */ + /* maxEvidLevel exceeded */ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Cell local assumeEvid Args((Cell,Int)); +static List local makeEvidArgs Args((List,Int)); +static Void local markPred Args((Cell)); +static List local copyPreds Args((List)); +static Cell local copyPred Args((Cell,Int)); +static Void local qualify Args((List,Cell)); +static Void local qualifyBinding Args((List,Cell)); + +static Cell local instsOverlap Args((Inst,Inst)); +static Bool local instsCompare Args((Inst,Inst)); + +static Bool local oneWayMatches Args((Cell,Int,Cell,Int)); +static Bool local oneWayTypeMatches Args((Type,Int,Type,Int)); + +static Cell local proveFrom Args((List,Cell,Int)); +static List local evidFrom Args((Cell,Int)); +static Void local explicitProve Args((Int,String,Cell,List,List)); +static Cell local addEvidArgs Args((Int,String,Cell,List,List,Cell)); +static Void local cantProve Args((Int,String,List,Cell,Cell)); +static List local simplify Args((List)); +static Void local overEvid Args((Cell,Cell)); + +static List local elimConstPreds Args((Int,String,Cell,List)); +static Bool local scanPred Args((Cell,Int)); +static Bool local scanTyvar Args((Int)); +static Bool local scanType Args((Type,Int)); + +static Cell local makeInst Args((Int,String,Cell,Cell,Int)); +static Cell local makeDict Args((Cell,Int)); + +static Void local indexPred Args((Class,Cell,Int)); +static Void local indexType Args((Type,Int)); +static Void local indexLeaf Args((Cell)); + +/* -------------------------------------------------------------------------- + * Predicate sets: + * + * A predicate set is represented by a list of triples (pi, o, used) + * where o is the offset for types in pi, with evidence required at the + * node pointed to by used (which is taken as a dictionary parameter if + * no other evidence is available). Note that the used node will be + * overwritten at a later stage if evidence for that predicate is found + * subsequently. + * ------------------------------------------------------------------------*/ + +static List preds; /* current predicate list */ + +static Cell local assumeEvid(pi,o) /* add predicate pi (offset o) to */ +Cell pi; /* preds with new dictionary var and*/ +Int o; { /* return that dictionary variable */ + Cell nd = inventDictVar(); + preds = cons(triple(pi,mkInt(o),nd),preds); + return nd; +} + +static List local makeEvidArgs(qs,o) /* make list of predicate assumps. */ +List qs; /* from qs (offset o), with new dict*/ +Int o; { /* vars for each predicate */ + List result; + for (result=NIL; nonNull(qs); qs=tl(qs)) + result = cons(triple(hd(qs),mkInt(o),inventDictVar()),result); + return rev(result); +} + +static Void local markPred(pi) /* marked fixed type variables in pi*/ +Cell pi; { + Cell cl = fst3(pi); + Int o = intOf(snd3(pi)); + + for (; isAp(cl); cl=fun(cl)) + markType(arg(cl),o); +} + +static List local copyPreds(qs) /* copy list of predicates */ +List qs; { + List result; + for (result=NIL; nonNull(qs); qs=tl(qs)) { + Cell pi = hd(qs); + result = cons(copyPred(fst3(pi),intOf(snd3(pi))),result); + } + return rev(result); +} + +static Cell local copyPred(pi,o) /* copy single predicate (or part */ +Cell pi; /* thereof) ... */ +Int o; { + if (isAp(pi)) { + Cell temp = copyPred(fun(pi),o);/* to ensure correct order of eval.*/ + return ap(temp,copyType(arg(pi),o)); + } + else + return pi; +} + +static Void local qualify(qs,alt) /* Add extra dictionary args to */ +List qs; /* qualify alt by predicates in qs */ +Cell alt; { /* :: ([Pat],Rhs) */ + List ds; + for (ds=NIL; nonNull(qs); qs=tl(qs)) + ds = cons(thd3(hd(qs)),ds); + fst(alt) = revOnto(ds,fst(alt)); +} + +static Void local qualifyBinding(qs,b) /* Add extra dict args to each */ +List qs; /* alternative in function binding */ +Cell b ; { + if (!isVar(fst(b))) /* check for function binding */ + internal("qualifyBinding"); + map1Proc(qualify,qs,snd(snd(b))); +} + +/* -------------------------------------------------------------------------- + * Check for overlapping instances of class: + * ------------------------------------------------------------------------*/ + +static Cell local instsOverlap(ia,ib) /* see if heads of instances can be*/ +Inst ia, ib; { /* unified */ + Int alpha, beta; + Cell pa, pb; + + emptySubstitution(); + matchMode = FALSE; + alpha = newKindedVars(inst(ia).sig); + pa = inst(ia).head; + beta = newKindedVars(inst(ib).sig); + pb = inst(ib).head; + while (isAp(pa) && isAp(pb)) { + if (!unify(arg(pa),alpha,arg(pb),beta)) + return NIL; + pa = fun(pa); + pb = fun(pb); + } + return copyPred(inst(ia).head,alpha); +} + +static Bool local instsCompare(ia,ib) /* see if ib is an instance of ia */ +Inst ia, ib; { + Int alpha, beta; + Cell pa, pb; + + emptySubstitution(); + alpha = newKindedVars(inst(ia).sig); + pa = inst(ia).head; + beta = newKindedVars(inst(ib).sig); + pb = inst(ib).head; + return oneWayMatches(pa,alpha,pb,beta); +} + +Void insertInst(line,cl,in) /* insert instance into class */ +Int line; +Class cl; +Inst in; { + List done = NIL; + List ins = class(cl).instances; + + while (nonNull(ins)) { + Cell tmp = tl(ins); + Cell pi = instsOverlap(in,hd(ins)); + if (nonNull(pi)) { + Bool bef = instsCompare(hd(ins),in); + Bool aft = instsCompare(in,hd(ins)); + if (bef==aft) { + class(cl).instances = revOnto(done,ins); + ERROR(line) "Overlapping instances for class \"%s\"", + textToStr(class(inst(in).cl).text) + ETHEN + ERRTEXT "\n*** This instance : " ETHEN ERRPRED(inst(in).head); + ERRTEXT "\n*** Overlaps with : " ETHEN + ERRPRED(inst(hd(ins)).head); + ERRTEXT "\n*** Common instance : " ETHEN + ERRPRED(pi); + ERRTEXT "\n" + EEND; + } + if (bef) + break; + } + tl(ins) = done; + done = ins; + ins = tmp; + } + class(cl).instances = revOnto(done,cons(in,ins)); +} + +/* -------------------------------------------------------------------------- + * One way matching of instance headers with predicates: + * ------------------------------------------------------------------------*/ + +static Bool local oneWayMatches(p1,o1,p2,o2) +Cell p1, p2; /* determine if S(p1,o1) = (p2,o2) */ +Int o1, o2; { /* for some substitution S */ + while (isAp(p1) && isAp(p2)) { + if (!oneWayTypeMatches(arg(p1),o1,arg(p2),o2)) + return FALSE; + p1 = fun(p1); + p2 = fun(p2); + } + return TRUE; +} + +static Bool local oneWayTypeMatches(t1,o1,t2,o2) +Type t1, t2; /* determine if S(t1,o1) = (t2,o2) */ +Int o1, o2; { /* for some substitution S */ + Tyvar *tyv; + Cell h1,h2; /* heads of (t1,o1) and (t2,o2) */ + Int a1,a2; /* #args of (t1,o1) and (t2,o2) */ + + while (h1=getDerefHead(t1,o1), /* eliminate synonym at hd (t1,o1) */ + a1=argCount, + (isSynonym(h1) && tycon(h1).arity<=a1)) { + expandSyn(h1,a1,&t1,&o1); + if (isOffset(t1)) { + tyv = tyvar (o1 + offsetOf(t1)); + t1 = tyv -> bound; + o1 = tyv -> offs; + } + } + + deRef(tyv,t2,o2); /* eliminate synonym at hd (t2,o2) */ + while (h2=getDerefHead(t2,o2), + a2=argCount, + (isSynonym(h2) && tycon(h2).arity<=a2)) { + expandSyn(h2,a2,&t2,&o2); + deRef(tyv,t2,o2); + } + + /* there are certain conditions under which there is no way to match */ + /* the type (t1,o1) with (t2,o2): */ + /* - if (t1,o1) has more arguments than (t2,o2) */ + /* - if (t1,o1) has fewer arguments than (t2,o2) and h1 not a variable */ + /* - if h1 not a variable and h2!=h1 */ + + if (a1>a2 || (!isOffset(h1) && (a1bound) + return sameType(tyv->bound,tyv->offs,t2,o2); + if (!eqKind(tyv->kind,getKind(t2,o2))) + return FALSE; + tyv->bound = t2; + tyv->offs = o2; + } + return TRUE; +} + +Bool typeInstOf(type,pt) /* test if type is instance of poly*/ +Type type, pt; { /* type pt (not-overloaded) */ + Bool result; + Int alpha = 0, beta = 0; + typeChecker(RESET); + + instantiate(pt); /* instantiate given polytype */ + alpha = typeOff; + pt = typeIs; + if (predsAre) + internal("typeInstOf"); + + instantiate(type); /* and type against which it will */ + beta = typeOff; /* be compared */ + type = typeIs; + if (predsAre) + internal("typeInstOf"); + + result = oneWayTypeMatches(pt,alpha,type,beta); + typeChecker(RESET); + return result; +} + +/* -------------------------------------------------------------------------- + * Predicate entailment: + * ------------------------------------------------------------------------*/ + +static Cell classProve; +static Cell predProve; +static Int offsetProve; +static Int evDepth; +static Int evidLevel; + +static Cell local proveFrom(qs,pi,o) /* Construct evidence for predicate*/ +List qs; /* pi, offset o from predicates qs,*/ +Cell pi; /* returning NIL if qs ||- (pi,o) */ +Int o; { /* does not hold. */ + List bestEvid = NIL; + Int bestDepth = (-1); + + classProve = getHead(pi); + predProve = pi; + offsetProve = o; + evidLevel = 0; + + for (; nonNull(qs); qs=tl(qs)) { + Cell qpi = hd(qs); + List dSels = evidFrom(fst3(qpi),intOf(snd3(qpi))); + + if (evDepth>=0 && (isNull(bestEvid) || evDepth= maxEvidLevel) { /* crude attempt to catch loops */ + if (silentEvFail) + goto end; + + ERROR(0) "Possible loop for instance " ETHEN + ERRPRED(copyPred(predProve,offsetProve)); + ERRTEXT "\n" + EEND; + } + + if (classProve==cpi) { /* preds match? */ + Cell pi1 = pi; + Cell pi2 = predProve; + do { + if (!sameType(arg(pi1),o,arg(pi2),offsetProve)) + break; + pi1 = fun(pi1); + pi2 = fun(pi2); + } while (isAp(pi1) && isAp(pi2)); + + if (!isAp(pi1) && !isAp(pi2)) { + evDepth = 0; + return NIL; + } + } + + doffs = 1 + class(cpi).numMembers; /* 1st superclass */ + + beta = newKindedVars(class(cpi).sig); /* match predicate */ + if (!oneWayMatches(class(cpi).head,beta,pi,o)) /* against class */ + internal("evidFrom"); /* header */ + + for (cs=class(cpi).supers; nonNull(cs); cs=tl(cs)) {/* scan supers... */ + List dSels = evidFrom(hd(cs),beta); + if (evDepth>=0 && (isNull(bestYet) || evDepth+1=0 && (isNull(bestYet) || evDepth+10) { /* only fixed vars */ + tl(preds) = ps; + ps = preds; + } + else /* constant types */ + overwrite(thd3(pi),makeInst(l,wh,e,fst3(pi),intOf(snd3(pi)))); + + preds = nx; + } + preds = qs; + return ps; +} + +static Bool local scanPred(pi,o) /* scan pred (pi,o) to determine if*/ +Cell pi; /* it is constant or locally-const */ +Int o; { /* by counting fixed & generic vars*/ + for (; isAp(pi); pi=fun(pi)) + if (scanType(arg(pi),o)) + return TRUE; + return FALSE; +} + +static Bool local scanTyvar(vn) /* return TRUE if type var contains*/ +Int vn; { /* a generic variable, counting the*/ + Tyvar *tyv = tyvar(vn); /* number of fixed variables */ + + if (tyv->bound) + return scanType(tyv->bound, tyv->offs); + else if (tyv->offs == FIXED_TYVAR) { + numFixedVars++; + return FALSE; + } + return TRUE; +} + +static Bool local scanType(t,o) /* Return TRUE if (t,o) contains */ +Type t; /* a generic variable */ +Int o; { + switch (whatIs(t)) { + case AP : return scanType(fst(t),o) || scanType(snd(t),o); + case OFFSET : return scanTyvar(o+offsetOf(t)); + case INTCELL : return scanTyvar(intOf(t)); + } + return FALSE; +} + +/* ----------------------------------------------------------------------- + * Dictionary construction: + * + * 0 | class(c).numMembers | class(c).numSupers | inst(in).numSpecifics | + * ----------------------------------------------------------------------- */ + +static Cell instPred; +static Int instOffs; +static Int instDepth; +static Cell instExpr; +static String instWhere; +static Int instLine; + +static Cell local makeInst(l,wh,e,pi,o) /* Build instance, keeping track of*/ +Int l; /* top-level required instance for */ +String wh; /* benefit of error reporting... */ +Cell e; +Cell pi; +Int o; { + Cell result; + + instPred = pi; + instOffs = o; + instDepth = 0; + instExpr = e; + instWhere = wh; + instLine = l; + result = makeDict(pi,o); + instPred = NIL; + instExpr = NIL; + return result; +} + +static Idx lastIdx, currIdx; /* used to describe position in idx*/ + +static Cell local makeDict(pi,o) /* Build dictionary for predicate */ +Cell pi; +Int o; { + Class c = getHead(pi); + List xs, is, ds; + Int alpha, beta, doffs; + Dict dc; + Inst in; + + indexPred(c,pi,o); /* dict has already*/ + if (currIdx!=NODICT) /* been built? */ + return dict(currIdx); + + for (xs=class(c).instances; nonNull(xs); xs=tl(xs)){/* No; then try and*/ + in = hd(xs); /* find a matching */ + beta = newKindedVars(inst(in).sig); /* instance to use */ + if (oneWayMatches(inst(in).head,beta,pi,o)) /* to construct the*/ + break; /* required dict */ + else + freeTypeVars(beta); + } + + if (isNull(xs)) { /* No suitable inst*/ + clearMarks(); + ERROR(instLine) "Cannot derive instance in %s", instWhere ETHEN + ERRTEXT "\n*** Expression : " ETHEN + ERREXPR(instExpr); + ERRTEXT "\n*** Required instance : " ETHEN + ERRPRED(copyPred(instPred,instOffs)); + if (instDepth>0) { + ERRTEXT "\n*** No subdictionary : " ETHEN + ERRPRED(copyPred(pi,o)); + } + ERRTEXT "\n" + EEND; + } + + alpha = newKindedVars(class(c).sig); /* match against */ + if (!oneWayMatches(class(c).head,alpha,pi,o)) /* class header */ + internal("makeDict"); + + instDepth++; + + dc = idx(lastIdx).match /* alloc new dict */ + = newDict(1 + class(c).numMembers /* and add to index*/ + + class(c).numSupers + + inst(in).numSpecifics); + dict(dc) = mkDict(dc); /* self reference */ + doffs = 1 + class(c).numMembers; + for (xs=class(c).supers; nonNull(xs); xs=tl(xs)) /* super classes */ + dict(dc+doffs++) = makeDict(hd(xs),alpha); + for (xs=inst(in).specifics; nonNull(xs); xs=tl(xs)) /* specifics */ + dict(dc+doffs++) = makeDict(hd(xs),beta); + + xs = class(c).members; /* member function */ + ds = class(c).defaults; /* implementations */ + is = inst(in).implements; + for (doffs=1; nonNull(xs); xs=tl(xs)) { + if (nonNull(is) && nonNull(hd(is))) + dict(dc+doffs++) = ap(hd(is),dict(dc)); + else if (nonNull(ds) && nonNull(hd(ds))) + dict(dc+doffs++) = ap(hd(ds),dict(dc)); + else + dict(dc+doffs++) = ap(nameUndefMem,hd(xs)); + + if (nonNull(is)) is=tl(is); + if (nonNull(ds)) ds=tl(ds); + } + +#ifdef DEBUG_CODE +printf("Just made dictionary {dict%d}@%d for ",dc,dict(dc)); +printPred(stdout,copyPred(pi,o)); +putchar('\n'); +printf("breakdown = 1+%d+%d+%d\n",class(c).numMembers, + class(c).numSupers, + inst(in).numSpecifics); +{ + int i; + int size = 1+class(c).numMembers+class(c).numSupers+inst(in).numSpecifics; + for (i=0; i=tycon(temp).arity) + expandSyn(temp,argCount,&t,&o); + else + break; + } + + /* now we've `evaluated (t,o) to whnf': Con t1 t2 ... tn, we output the*/ + /* constructor Con as a leaf and then go thru' tn, ..., t2, t1 in turn.*/ + /* Admittedly, this gives a less than intuitive mapping of monopreds to*/ + /* strings of type constructors, but it is sufficient for the moment. */ + + indexLeaf(temp); + while (isAp(t)) { + indexType(arg(t),o); + t = fun(t); + deRef(tyv,t,o); + } +} + +static Void local indexLeaf(lf) /* adjust pointers into current idx*/ +Cell lf; { /* having detected type constructor*/ + if (currIdx==NOIDX) { /* lf whilst indexing over a type */ + if (lastIdx==NOIDX) + lastIdx = firstIdx = newIdx(lf); + else + lastIdx = idx(lastIdx).match = newIdx(lf); + currIdx = NOIDX; + } + else { + while (idx(currIdx).test!=lf) { + if (idx(currIdx).fail==NOIDX) { + lastIdx = idx(currIdx).fail = newIdx(lf); + currIdx = NOIDX; + return; + } + else + currIdx = idx(currIdx).fail; + } + lastIdx = currIdx; + currIdx = idx(currIdx).match; + } +} + +Dict listMonadDict() { /* look for a dict for Monad [ ] */ + if (nonNull(classMonad)) { + currIdx = class(classMonad).dictIndex; + while (currIdx!=NOIDX && idx(currIdx).test!=LIST) + currIdx = idx(currIdx).fail; + if (currIdx!=NOIDX) + return idx(currIdx).match; + } + return NODICT; +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/prelude.h b/src/prelude.h new file mode 100644 index 0000000..16d2c4a --- /dev/null +++ b/src/prelude.h @@ -0,0 +1,387 @@ +/* -------------------------------------------------------------------------- + * prelude.h: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Basic data type definitions, prototypes and standard macros including + * machine dependent variations... + * ------------------------------------------------------------------------*/ + +#define const /* const is more trouble than it's worth,... */ +#include + +/*--------------------------------------------------------------------------- + * To select a particular machine/compiler, just place a 1 in the appropriate + * position in the following list and ensure that 0 appears in all other + * positions: + * + * The letters UN in the comment field indicate that I have not personally + * been able to test this configuration yet and I have not heard from anybody + * else that has tried it. If you run Gofer on one of these systems and it + * works (or needs patches) please let me know so that I can fix it and + * update the source. + *-------------------------------------------------------------------------*/ + +#define TURBOC 0 /* For IBM PC, using Turbo C 1.5 */ +#define BCC 0 /* For IBM PC, using Borland C++ 3.1 */ +#define WATCOM 0 /* For IBM PC, using WATCOM C/C++32 v9.5 */ +#define ZTC 0 /* For IBM PC (>= 386) Zortech C++ v3.0 (-mx) */ +#define DJGPP 0 /* For DJGPP version 1.09 (gcc2.2.2) and DOS 5.0 */ +#define OS2 0 /* For IBM OS/2 2.0 using EMX GCC */ +#define SUNOS 1 /* For Sun 3/Sun 4 running SunOs 4.x */ +#define MIPS 0 /* For MIPS RC6280/Sony machine NWS-3870 UN */ +#define NEXTSTEP 0 /* For NeXTstep 3.0 using NeXT cc */ +#define NEXTGCC 0 /* For NeXTstep with gcc 2.x, doesn't work w/ NS3.2*/ +#define MINIX68K 0 /* For Minix68k with gcc UN */ +#define AMIGA 0 /* For Amiga using gcc 2.2.2 UN */ +#define HPUX 0 /* For HPUX using gcc */ +#define LINUX 0 /* For Linux using gcc UN */ +#define RISCOS 0 /* For Acorn DesktopC and RISCOS2 or 3 */ +#define ALPHA 0 /* For DEC Alpha with OSF/1 (32 bit ints, no gofc) */ +#define SVR4 0 /* For SVR4 using GCC2.2 */ +#define ULTRIX 0 /* For DEC Ultrix 4.x using GCC2.3.3 */ +#define AIX 0 /* For IBM AIX on RS/6000 using GCC */ +#define ATARI 0 /* For Atari ST/STE/TT/Falcon w/ Lattice C 5.52 UN */ +#define SGI4 0 /* For SiliconGraphics Indigo, IRIX v*4*.0.5 UN */ +#define NETBSD 0 /* For NetBSD-current */ + +/*--------------------------------------------------------------------------- + * To add a new machine/compiler, add a new macro line above, add the new + * to the appropriate flags below and add a `machine specific' section in the + * following section of this file. Please send me details of any new machines + * or compilers that you try so that I can pass them onto others! + * + * UNIX if the machine runs fairly standard Unix + * SMALL_GOFER for 16 bit operation on a limited memory PC + * REGULAR_GOFER for 32 bit operation using largish default table sizes + * LARGE_GOFER for 32 bit operation using larger default table sizes + * JMPBUF_ARRAY if jmpbufs can be treated like arrays. + * DOS_IO to use DOS style IO for terminal control + * TERMIO_IO to use Unix termio for terminal control + * SGTTY_IO to use Unix sgtty for terminal control + * TERMIOS_IO to use posix termios for terminal control + * BREAK_FLOATS to use two integers to store a float (or double) + * if SMALL_GOFER, then you *must* use BREAK_FLOATS == 1 + * (assumes sizeof(int)==2, sizeof(float)==4). + * Otherwise, assuming sizeof(int)==sizeof(float)==4, + * BREAK_FLOATS == 0 will give you floats for floating pt, + * BREAK_FLOATS == 1 will give you doubles for floating pt. + * HAS_FLOATS to indicate support for floating point + * HASKELL_ARRAYS to include support for Haskell array primitives + * IO_MONAD to include the IO and ST monad primitives and support + * IO_DIALOGUE to include old style Haskell Dialogue based I/O + * NPLUSK to include support for (n+k) and (c*n) patterns + * DO_COMPS to include support for the do notation. If you do not + * want to use this, edit out the relevant section of the + * the grammar in parser.y to reduce the size of the + * grammar and free up some memory. Conversely, if you + * do decide to use DO_COMPS, make sure that the required + * part of the grammar is included ... ! + * FIXED_SUBST to force a fixed size for the current substitution + *-------------------------------------------------------------------------*/ + +#define UNIX (SUNOS | NEXTSTEP | HPUX | NEXTGCC | LINUX | AMIGA | \ + MINIX68K | ALPHA | OS2 | SVR4 | ULTRIX | AIX | MIPS |\ + SGI4 | NETBSD) +#define SMALL_GOFER (TURBOC | BCC) +#define REGULAR_GOFER (RISCOS | DJGPP | ZTC | ATARI) +#define LARGE_GOFER (UNIX | WATCOM) +#define JMPBUF_ARRAY (UNIX | DJGPP | RISCOS | ZTC | ATARI) +#define DOS_IO (TURBOC | BCC | DJGPP | ZTC | WATCOM | ATARI) +#define TERMIO_IO (LINUX | HPUX | OS2 | SVR4 | SGI4) +#define SGTTY_IO (SUNOS | NEXTSTEP | NEXTGCC | AMIGA | MINIX68K | \ + ALPHA | ULTRIX | AIX | MIPS) +#define TERMIOS_IO (NETBSD) +#define BREAK_FLOATS (TURBOC | BCC) +#define HAS_FLOATS (REGULAR_GOFER | LARGE_GOFER | BREAK_FLOATS) + +#define HASKELL_ARRAYS (REGULAR_GOFER | LARGE_GOFER) +#define IO_MONAD (REGULAR_GOFER | LARGE_GOFER) +#define IO_DIALOGUE 1 /* Warning: This may become 0 in future versions */ +#define NPLUSK 1 /* Warning: This may become 0 in future versions */ +#define DO_COMPS 0 /* Warning: This may become 1 in future versions */ +#define FIXED_SUBST 0 /* Warning: This may not be appropriate for PCs */ + +/*--------------------------------------------------------------------------- + * The following flags should be set automatically according to builtin + * compiler flags, but you might want to set them manually to avoid default + * behaviour in some situations: + *-------------------------------------------------------------------------*/ + +#ifdef __GNUC__ /* look for GCC 2.x extensions */ +#if __GNUC__ >= 2 && !NEXTSTEP /* NeXT cc lies and says it's 2.x */ +#define GCC_THREADED 1 + +/* WARNING: if you use the following optimisations to assign registers for + * particular global variables, you should be very careful to make sure that + * storage(RESET) is called after a longjump (usually resulting from an error + * condition) and before you try to access the heap. The current version of + * main deals with this using everybody(RESET) at the head of the main read, + * eval, print loop + */ + +#ifdef m68k /* global registers on an m68k */ +#define GLOBALfst asm("a4") +#define GLOBALsnd asm("a5") +#define GLOBALsp asm("a3") +#endif + +#ifdef sparc /* global registers on a sparc */ +/* sadly, although the gcc documentation suggests that the following reg */ +/* assignments should be ok, experience shows (at least on Suns) that they */ +/* are not -- it seems that atof() and friends spoil things. */ +/*#define GLOBALfst asm("g5")*/ +/*#define GLOBALsnd asm("g6")*/ +/*#define GLOBALsp asm("g7")*/ +#endif + +#endif +#endif + +#ifndef GCC_THREADED +#define GCC_THREADED 0 +#endif + +/*--------------------------------------------------------------------------- + * Machine specific sections: + * Include any machine specific declarations and define macros: + * local prefix for locally defined functions + * far prefix for far pointers + * allowBreak() call to allow user to interrupt computation + * FOPEN_WRITE fopen *text* file for writing + * FOPEN_APPEND fopen *text* file for append + * + * N.B. `far' must be explicitly defined (usually to the empty string) + *-------------------------------------------------------------------------*/ + +#ifdef __STDC__ /* To enable use of prototypes whenever possible */ +#define Args(x) x +#else +#if (TURBOC | BCC | ZTC) /* K&R 1 does not permit `defined(__STDC__)' ... */ +#define Args(x) x +#else +#define Args(x) () +#endif +#endif + +#if (TURBOC | BCC) +#include +#define local near pascal +extern int kbhit Args((void)); +#define allowBreak() kbhit() +#define FOPEN_WRITE "wt" +#define FOPEN_APPEND "at" +#define farCalloc(n,s) farcalloc((unsigned long)n,(unsigned long)s) +#define sigProto(nm) int nm(void) +#define sigRaise(nm) nm() +#define sigHandler(nm) int nm() +#define sigResume return 1 +#endif + +#if SUNOS +#include +#define far +#define farCalloc(n,s) (Void *)valloc(((unsigned)n)*((unsigned)s)) +#endif + +#if MIPS +#define far +#define farCalloc(n,s) (Void *)valloc(((unsigned)n)*((unsigned)s)) +#endif + +#if (NEXTSTEP | NEXTGCC | MINIX68K | ULTRIX) +#include +#define far +#define farCalloc(n,s) (Void *)valloc(((unsigned)n)*((unsigned)s)) +#endif + +#if AMIGA +#include +#define Main int +#define far +#define farCalloc(n,s) (Void *)valloc(((unsigned)n)*((unsigned)s)) +#endif + +#if (HPUX | DJGPP | ZTC | LINUX | ALPHA | OS2 | SVR4 | AIX | SGI4 | NETBSD) +#include +#define far +#endif + +#if WATCOM +#include +#undef far +#define far +#endif + +#if RISCOS +#include +#include +#include +#define far +#define isascii(c) (((unsigned)(c))<128) +#define Main int +#define MainDone return 0;/*NOTUSED*/ +extern int access Args((char *, int)); +extern int namecmp Args((char *, char *)); +#endif + +#ifndef USE_READLINE +#define USE_READLINE 0 +#endif +#ifndef allowBreak +#define allowBreak() +#endif +#ifndef local +#define local +#endif +#ifndef farCalloc +#define farCalloc(n,s) (Void *)calloc(((unsigned)n),((unsigned)s)) +#endif +#ifndef FOPEN_WRITE +#define FOPEN_WRITE "w" +#endif +#ifndef FOPEN_APPEND +#define FOPEN_APPEND "a" +#endif +#ifndef sigProto +#define sigProto(nm) Void nm Args((int)) +#define sigRaise(nm) nm(1) +#define sigHandler(nm) Void nm(sig_arg) int sig_arg; +#define sigResume return +#endif +#ifndef Main /* to cope with systems that don't like */ +#define Main Void /* main to be declared as returning Void */ +#endif +#ifndef MainDone +#define MainDone +#endif + +#if (UNIX | DJGPP | RISCOS | ZTC | WATCOM | ATARI) +#define ctrlbrk(bh) signal(SIGINT,bh) +#endif + +/*--------------------------------------------------------------------------- + * General settings: + *-------------------------------------------------------------------------*/ + +#define Void void /* older compilers object to: typedef void Void; */ +typedef unsigned Bool; +#define TRUE 1 +#define FALSE 0 +typedef char *String; +typedef int Int; +typedef long Long; +typedef int Char; +typedef unsigned Unsigned; + +#ifndef STD_PRELUDE +#if RISCOS +#define STD_PRELUDE "prelude" +#else +#define STD_PRELUDE "standard.prelude" +#endif +#endif + +#define NUM_SYNTAX 100 +#define NUM_SELECTS 100 +#define NUM_FILES 20 +#define NUM_MODULES 64 +#define NUM_FIXUPS 100 +#define NUM_TUPLES 100 +#define NUM_OFFSETS 1024 +#define NUM_CHARS 256 + +/* Managing two different sized versions of Gofer has caused problems in + * the past for people who tried to change one setting, but inadvertantly + * modified the settings for a different size. Now that we have three + * sizes of Gofer, I think it's time to try a new scheme: + */ + +#if SMALL_GOFER /* the McDonalds mentality :-) */ +#define Pick(s,r,l) s +#endif +#if REGULAR_GOFER +#define Pick(s,r,l) r +#endif +#if LARGE_GOFER +#define Pick(s,r,l) l +#endif + +#define NUM_TYCON Pick(60, 160, 160) +#define NUM_NAME Pick(625, 2000, 16000) +#define NUM_CLASSES Pick(20, 40, 40) +#define NUM_INSTS Pick(60, 100, 400) +#define NUM_INDEXES Pick(700, 2000, 2000) +#define NUM_DICTS Pick(400, 32000, 32000) +#define NUM_TEXT Pick(7000, 20000, 80000) +#define NUM_TEXTH Pick(1, 10, 10) +#define NUM_TYVARS Pick(800, 3000, 4000) +#define NUM_STACK Pick(1800, 16000, 16000) +#define NUM_ADDRS Pick(28000, 100000, 320000) +#define MINIMUMHEAP Pick(7500, 7500, 7500) +#define MAXIMUMHEAP Pick(32765, 0, 0) +#define DEFAULTHEAP Pick(28000, 100000, 100000) +#define MAXPOSINT Pick(32767, 2147483647, 2147483647) + +#define minRecovery Pick(1000, 1000, 1000) +#define bitsPerWord Pick(16, 32, 32) +#define wordShift Pick(4, 5, 5) +#define wordMask Pick(15, 31, 31) + +#define bitArraySize(n) ((n)/bitsPerWord + 1) +#define placeInSet(n) ((-(n)-1)>>wordShift) +#define maskInSet(n) (1<<((-(n)-1)&wordMask)) + +#ifndef __GNUC__ +#if !RISCOS +extern Int strcmp Args((String, String)); +extern Int strlen Args((String)); +extern char *strcpy Args((String,String)); +extern char *strcat Args((String,String)); +#endif +#endif +#if !LINUX +extern char *getenv Args((char *)); +extern int system Args((const char *)); +extern double atof Args((char *)); +#endif +extern char *strchr Args((char *,int)); /* test membership in str */ +extern Void exit Args((Int)); +extern Void internal Args((String)); +extern Void fatal Args((String)); + +#if HAS_FLOATS +#ifdef NEED_MATH +#include +#endif + +#if (REGULAR_GOFER | LARGE_GOFER) & BREAK_FLOATS +#define FloatImpType double +#define FloatPro double +#define FloatFMT "%.9g" +#else +#define FloatImpType float +#define FloatPro double /* type to use in prototypes */ + /* strictly ansi (i.e. gcc) conforming */ + /* but breaks data hiding :-( */ +#define FloatFMT "%g" +#endif +#else +#define FloatImpType int /*dummy*/ +#define FloatPro int +#define FloatFMT "%d" +#endif + +#ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/ +#define FILENAME_MAX 256 +#else +#if FILENAME_MAX < 256 +#undef FILENAME_MAX +#define FILENAME_MAX 256 +#endif +#endif + +#define DEF_EDITOR "vi" /* replace with ((char *)0)*/ +#define DEF_EDITLINE "vi +%d %s" /* if no default editor rqd*/ + +/*-------------------------------------------------------------------------*/ diff --git a/src/prims.c b/src/prims.c new file mode 100644 index 0000000..09af0fe --- /dev/null +++ b/src/prims.c @@ -0,0 +1,2201 @@ +/* -------------------------------------------------------------------------- + * prims.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Primitive functions, input output etc... + * if PRIMITIVES_CODE == 0 then the code for PRIMITIVES is excluded: only + * the primitives table and consChar() parts are retained. + * ------------------------------------------------------------------------*/ + +#if PRIMITIVES_CODE +#include +#if (TURBOC | BCC) +#include +#endif +#endif + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +#if PRIMITIVES_CODE +#define PROTO_PRIM(name) static Void name Args((StackPtr)) +#define primFun(name) static Void name(root) StackPtr root; +#define primArg(n) stack(root+n) + +/* IMPORTANT: the second element of an update must be written first. + * this is to deal with the case where an INDIRECT tag is written into + * a Cell before the second value has been set. If a garbage collection + * occurs before the second element was set then the INDIRECTion will be + * (wrongly) elided and result in chaos. I know. It happened to me. + */ + +#define update(l,r) ((snd(stack(root))=r),(fst(stack(root))=l)) +#define updateRoot(c) update(INDIRECT,c) +#define updapRoot(l,r) update(l,r) +#define cantReduce() evalFails(root) + +PROTO_PRIM(primFatbar); +PROTO_PRIM(primFail); +PROTO_PRIM(primSel); +PROTO_PRIM(primIf); +PROTO_PRIM(primStrict); +PROTO_PRIM(primTrace); + +#if HASKELL_ARRAYS +static Int local getSize Args((Cell, Cell)); +static List local addAssocs Args((Cell, Int, Cell, List)); +static List local foldAssocs Args((Cell, Int, Cell, Cell, List)); + +PROTO_PRIM(primArray); +PROTO_PRIM(primUpdate); +PROTO_PRIM(primAccum); +PROTO_PRIM(primAccumArray); +PROTO_PRIM(primAmap); +PROTO_PRIM(primSubscript); +PROTO_PRIM(primBounds); +PROTO_PRIM(primElems); +#endif + +PROTO_PRIM(primPlusInt); +PROTO_PRIM(primMinusInt); +PROTO_PRIM(primMulInt); +PROTO_PRIM(primDivInt); +PROTO_PRIM(primQuotInt); +PROTO_PRIM(primModInt); +PROTO_PRIM(primRemInt); +PROTO_PRIM(primNegInt); + +PROTO_PRIM(primCharToInt); +PROTO_PRIM(primIntToChar); +PROTO_PRIM(primIntToFloat); + +PROTO_PRIM(primPlusFloat); +PROTO_PRIM(primMinusFloat); +PROTO_PRIM(primMulFloat); +PROTO_PRIM(primDivFloat); +PROTO_PRIM(primNegFloat); + +#if HAS_FLOATS +PROTO_PRIM(primSinFloat); +PROTO_PRIM(primCosFloat); +PROTO_PRIM(primTanFloat); +PROTO_PRIM(primAsinFloat); +PROTO_PRIM(primAcosFloat); +PROTO_PRIM(primAtanFloat); +PROTO_PRIM(primAtan2Float); +PROTO_PRIM(primExpFloat); +PROTO_PRIM(primLogFloat); +PROTO_PRIM(primLog10Float); +PROTO_PRIM(primSqrtFloat); +PROTO_PRIM(primFloatToInt); +#endif + +PROTO_PRIM(primEqInt); +PROTO_PRIM(primLeInt); + +PROTO_PRIM(primEqChar); +PROTO_PRIM(primLeChar); + +PROTO_PRIM(primEqFloat); +PROTO_PRIM(primLeFloat); + +PROTO_PRIM(primCmp); +PROTO_PRIM(primGenericEq); +PROTO_PRIM(primGenericLe); +PROTO_PRIM(primGenericLt); +PROTO_PRIM(primGenericGe); +PROTO_PRIM(primGenericGt); +PROTO_PRIM(primGenericNe); + +PROTO_PRIM(primPrint); +PROTO_PRIM(primNPrint); + +static Void local printer Args((StackPtr,Name,Int,Cell)); +static Void local startList Args((StackPtr,Cell)); +static Void local startNList Args((StackPtr,Cell)); + +PROTO_PRIM(primLPrint); +PROTO_PRIM(primNLPrint); +PROTO_PRIM(primSPrint); +PROTO_PRIM(primNSPrint); + +static Cell local textAsVar Args((Text,Cell)); +static Cell local textAsOp Args((Text,Cell)); +static Cell local stringOutput Args((String,Cell)); +static Cell local printBadRedex Args((Cell,Cell)); +static Cell local printDBadRedex Args((Cell,Cell)); + +#if (IO_DIALOGUE | LAMBDAVAR | LAMBDANU) +static String local evalName Args((Cell)); +#endif +#if IO_DIALOGUE +static Void local abandonDialogue Args((Cell)); +static Cell local readFile Args((Void)); +static Cell local writeFile Args((Void)); +static Cell local appendFile Args((Void)); +static Cell local readChan Args((Void)); +static Cell local appendChan Args((Void)); +static FILE *local validOutChannel Args((String)); +static Cell local echo Args((Void)); +static Cell local getCLArgs Args((Void)); +static Cell local getProgName Args((Void)); +static Cell local getEnv Args((Void)); +static Cell local outputDString Args((FILE *)); + +PROTO_PRIM(primInput); +PROTO_PRIM(primFopen); +#endif + +#if IO_MONAD +PROTO_PRIM(primSTRun); +PROTO_PRIM(primFst); +PROTO_PRIM(primSnd); +PROTO_PRIM(primSTReturn); +PROTO_PRIM(primIOBind); +PROTO_PRIM(primSTBind); +PROTO_PRIM(primSTInter); +PROTO_PRIM(primSTNew); +PROTO_PRIM(primSTAssign); +PROTO_PRIM(primSTDeref); +PROTO_PRIM(primSTMutVarEq); +PROTO_PRIM(primIOGetch); +PROTO_PRIM(primIOPutchar); +#if HASKELL_ARRAYS +PROTO_PRIM(primSTNewArr); +PROTO_PRIM(primSTReadArr); +PROTO_PRIM(primSTWriteArr); +PROTO_PRIM(primSTFreeze); +#endif +#endif + +#ifdef LAMBDAVAR +PROTO_PRIM(primLvReturn); +PROTO_PRIM(primLvPure); +PROTO_PRIM(primLvRead); +PROTO_PRIM(primLvBind); +PROTO_PRIM(primLvVar); +PROTO_PRIM(primLvNewvar); +PROTO_PRIM(primLvAssign); +PROTO_PRIM(primLvVarEq); +PROTO_PRIM(primLvGetch); +PROTO_PRIM(primLvPutchar); +PROTO_PRIM(primLvSystem); +#endif + +#ifdef LAMBDANU +PROTO_PRIM(primLnReturn); +PROTO_PRIM(primLnBind); +PROTO_PRIM(primLnFlip); +PROTO_PRIM(primLnNew); +PROTO_PRIM(primLnAssign); +PROTO_PRIM(primLnRead); +PROTO_PRIM(primLnIo); +PROTO_PRIM(primLnBegin); +PROTO_PRIM(primLnTagEq); +PROTO_PRIM(primLnGetch); +PROTO_PRIM(primLnPutchar); +PROTO_PRIM(primLnSystem); +PROTO_PRIM(primLnDone); +#endif + +#endif + +/* -------------------------------------------------------------------------- + * Table of primitive/built-in values: + * ------------------------------------------------------------------------*/ + +#if PRIMITIVES_CODE +#define GofcPrim(imp) imp +#define NoGofcPrim(imp) imp +#else +#define GofcPrim(imp) PRIM_GOFC +#define NoGofcPrim(imp) PRIM_NOGOFC +#endif + +struct primitive primitives[] = { + {"primFatbar", 2, GofcPrim(primFatbar)}, + {"primFail", 0, GofcPrim(primFail)}, + {"primUndefMem", 1, GofcPrim(primFail)}, + {"primGCBhole", 0, NoGofcPrim(primFail)}, + {"primError", 1, GofcPrim(primFail)}, + {"primSel", 3, GofcPrim(primSel)}, + {"primIf", 3, GofcPrim(primIf)}, + {"primTrace", 2, NoGofcPrim(primTrace)}, + +#if HASKELL_ARRAYS + {"primArray", 3, GofcPrim(primArray)}, + {"primUpdate", 3, GofcPrim(primUpdate)}, + {"primAccum", 4, GofcPrim(primAccum)}, + {"primAccumArray", 5, GofcPrim(primAccumArray)}, + {"primAmap", 2, GofcPrim(primAmap)}, + {"primSubscript", 3, GofcPrim(primSubscript)}, + {"primBounds", 1, GofcPrim(primBounds)}, + {"primElems", 1, GofcPrim(primElems)}, + {"primEltUndef", 0, NoGofcPrim(primFail)}, + {"primOutBounds", 2, NoGofcPrim(primFail)}, +#endif + + {"primCompare", 1, NoGofcPrim(primCmp)}, + {"primPrint", 3, NoGofcPrim(primPrint)}, + {"primNprint", 3, NoGofcPrim(primNPrint)}, + {"primLprint", 2, NoGofcPrim(primLPrint)}, + {"primNlprint", 2, NoGofcPrim(primNLPrint)}, + {"primSprint", 2, NoGofcPrim(primSPrint)}, + {"primNsprint", 2, NoGofcPrim(primNSPrint)}, + + {"primPlusInt", 2, GofcPrim(primPlusInt)}, + {"primMinusInt", 2, GofcPrim(primMinusInt)}, + {"primMulInt", 2, GofcPrim(primMulInt)}, + {"primDivInt", 2, GofcPrim(primDivInt)}, + {"primQuotInt", 2, GofcPrim(primQuotInt)}, + {"primModInt", 2, GofcPrim(primModInt)}, + {"primRemInt", 2, GofcPrim(primRemInt)}, + {"primNegInt", 1, GofcPrim(primNegInt)}, + + {"primPlusFloat", 2, GofcPrim(primPlusFloat)}, + {"primMinusFloat", 2, GofcPrim(primMinusFloat)}, + {"primMulFloat", 2, GofcPrim(primMulFloat)}, + {"primDivFloat", 2, GofcPrim(primDivFloat)}, + {"primNegFloat", 1, GofcPrim(primNegFloat)}, + +#if HAS_FLOATS + {"primSinFloat", 1, GofcPrim(primSinFloat)}, + {"primCosFloat", 1, GofcPrim(primCosFloat)}, + {"primTanFloat", 1, GofcPrim(primTanFloat)}, + {"primAsinFloat", 1, GofcPrim(primAsinFloat)}, + {"primAcosFloat", 1, GofcPrim(primAcosFloat)}, + {"primAtanFloat", 1, GofcPrim(primAtanFloat)}, + {"primAtan2Float", 2, GofcPrim(primAtan2Float)}, + {"primExpFloat", 1, GofcPrim(primExpFloat)}, + {"primLogFloat", 1, GofcPrim(primLogFloat)}, + {"primLog10Float", 1, GofcPrim(primLog10Float)}, + {"primSqrtFloat", 1, GofcPrim(primSqrtFloat)}, + {"primFloatToInt", 1, GofcPrim(primFloatToInt)}, +#endif + + {"primIntToChar", 1, GofcPrim(primIntToChar)}, + {"primCharToInt", 1, GofcPrim(primCharToInt)}, + {"primIntToFloat", 1, GofcPrim(primIntToFloat)}, + + {"primEqInt", 2, GofcPrim(primEqInt)}, + {"primLeInt", 2, GofcPrim(primLeInt)}, + {"primEqChar", 2, GofcPrim(primEqChar)}, + {"primLeChar", 2, GofcPrim(primLeChar)}, + {"primEqFloat", 2, GofcPrim(primEqFloat)}, + {"primLeFloat", 2, GofcPrim(primLeFloat)}, + + {"primGenericEq", 2, GofcPrim(primGenericEq)}, + {"primGenericNe", 2, GofcPrim(primGenericNe)}, + {"primGenericGt", 2, GofcPrim(primGenericGt)}, + {"primGenericLe", 2, GofcPrim(primGenericLe)}, + {"primGenericGe", 2, GofcPrim(primGenericGe)}, + {"primGenericLt", 2, GofcPrim(primGenericLt)}, + + {"primShowsInt", 3, GofcPrim(primPrint)}, + {"primShowsFloat", 3, GofcPrim(primPrint)}, + + {"primStrict", 2, GofcPrim(primStrict)}, + +#if IO_DIALOGUE + {"primInput", 1, NoGofcPrim(primInput)}, + {"primFopen", 3, GofcPrim(primFopen)}, +#endif + +#if IO_MONAD + {"primSTRun", 1, GofcPrim(primSTRun)}, + {"primFst", 1, NoGofcPrim(primFst)}, + {"primSnd", 1, NoGofcPrim(primSnd)}, + {"primSTReturn", 1, GofcPrim(primSTReturn)}, + {"primIOBind", 3, GofcPrim(primIOBind)}, + {"primSTBind", 3, GofcPrim(primSTBind)}, + {"primSTInter", 2, GofcPrim(primSTInter)}, + {"primSTNew", 2, GofcPrim(primSTNew)}, + {"primSTAssign", 3, GofcPrim(primSTAssign)}, + {"primSTDeref", 2, GofcPrim(primSTDeref)}, + {"primSTMutVarEq", 2, GofcPrim(primSTMutVarEq)}, + {"primIOGetch", 1, GofcPrim(primIOGetch)}, + {"primIOPutchar", 2, GofcPrim(primIOPutchar)}, +#if HASKELL_ARRAYS + {"primSTNewArr", 4, GofcPrim(primSTNewArr)}, + {"primSTReadArr", 4, GofcPrim(primSTReadArr)}, + {"primSTWriteArr", 5, GofcPrim(primSTWriteArr)}, + {"primSTFreeze", 2, GofcPrim(primSTFreeze)}, +#endif +#endif + +#ifdef LAMBDAVAR + {"primLvReturn", 2, NoGofcPrim(primLvReturn)}, + {"primLvPure", 1, NoGofcPrim(primLvPure)}, + {"primLvRead", 3, NoGofcPrim(primLvRead)}, + {"primLvBind", 3, NoGofcPrim(primLvBind)}, + {"primLvVar", 2, NoGofcPrim(primLvVar)}, + {"primLvNewvar", 1, NoGofcPrim(primLvNewvar)}, + {"primLvAssign", 3, NoGofcPrim(primLvAssign)}, + {"primLvVarEq", 2, NoGofcPrim(primLvVarEq)}, + {"primLvUnbound", 0, NoGofcPrim(primFail)}, + {"primLvGetch", 1, NoGofcPrim(primLvGetch)}, + {"primLvPutchar", 2, NoGofcPrim(primLvPutchar)}, + {"primLvSystem", 2, NoGofcPrim(primLvSystem)}, +#endif + +#ifdef LAMBDANU + {"primLnReturn", 2, NoGofcPrim(primLnReturn)}, + {"primLnBind", 3, NoGofcPrim(primLnBind)}, + {"primLnFlip", 3, NoGofcPrim(primLnFlip)}, + {"primLnNew", 1, NoGofcPrim(primLnNew)}, + {"primLnAssign", 3, NoGofcPrim(primLnAssign)}, + {"primLnRead", 3, NoGofcPrim(primLnRead)}, + {"primLnIo", 2, NoGofcPrim(primLnIo)}, + {"primLnBegin", 1, NoGofcPrim(primLnBegin)}, + {"primLnTagEq", 2, NoGofcPrim(primLnTagEq)}, + {"primLnGetch", 1, NoGofcPrim(primLnGetch)}, + {"primLnPutchar", 2, NoGofcPrim(primLnPutchar)}, + {"primLnSystem", 2, NoGofcPrim(primLnSystem)}, + {"primLnUnbound", 0, NoGofcPrim(primFail)}, + {"primLnNocont", 0, NoGofcPrim(primFail)}, + {"primLnDone", 1, NoGofcPrim(primLnDone)}, +#endif + + {0, 0, 0} +}; + +/* -------------------------------------------------------------------------- + * Primitive functions: + * ------------------------------------------------------------------------*/ + +#if PRIMITIVES_CODE +primFun(primFatbar) { /* Fatbar primitive */ + Cell l = primArg(2); /* _FAIL [] r = r */ + Cell r = primArg(1); /* l [] r = l -- otherwise */ + Cell temp = evalWithNoError(l); + if (nonNull(temp)) + if (temp==nameFail) + updateRoot(r); + else { + updateRoot(temp); + cantReduce(); + } + else + updateRoot(l); +} + +primFun(primFail) { /* Failure primitive */ + cantReduce(); +} + +primFun(primSel) { /* Component selection */ + Cell c = primArg(3); /* _sel c e n return nth component*/ + Cell e = primArg(2); /* in expression e */ + Cell n = intOf(primArg(1)); /* built using cfun c */ + + eval(e); + if (whnfHead==c && ((isName(whnfHead) && name(whnfHead).arity==whnfArgs) + || (isTuple(whnfHead) && tupleOf(whnfHead)==whnfArgs))) + updateRoot(pushed(n-1)); + else + cantReduce(); +} + +primFun(primIf) { /* Conditional primitive */ + eval(primArg(3)); + if (whnfHead==nameTrue) + updateRoot(primArg(2)); + else + updateRoot(primArg(1)); +} + +primFun(primStrict) { /* Strict application primitive */ + eval(primArg(1)); /* evaluate 2nd argument */ + updapRoot(primArg(2),primArg(1)); /* and apply 1st argument to result */ +} + +primFun(primTrace) { /* an unsound trace primitive for */ + fflush(stdout); /* debugging purposes */ + eval(pop()); /* :: String -> a -> a */ + while (whnfHead==nameCons) { + eval(pop()); + putchar(charOf(whnfHead)); + eval(pop()); + } + updateRoot(pop()); +} + +/* -------------------------------------------------------------------------- + * Array primitives: + * ------------------------------------------------------------------------*/ + +#if HASKELL_ARRAYS +static Int local getSize(bounds,range) +Cell bounds, range; { + Int lo; + eval(bounds); /* get components of bounds pair */ + eval(ap(range,pop())); /* get lower bound as an integer */ + lo = whnfInt; + eval(ap(range,pop())); /* get upper bound as an integer */ + whnfInt -= lo; + return (whnfInt<0 ? 0 : whnfInt+1); +} + +static List local addAssocs(r,s,as,vs) /* add assocs in as to array */ +Cell r; /* list vs, using r for the range */ +Int s; /* and s for array size */ +Cell as; +List vs; { + for (;;) { /* loop through assocs */ + eval(as); + if (whnfHead==nameNil && whnfArgs==0) + break; + else if (whnfHead==nameCons && whnfArgs==2) { + eval(pop()); + /* at this point, the top of the stack looks like: + * + * pushed(0) == index (first component in assoc) + * pushed(1) == value for assoc + * pushed(2) == rest of assocs + */ + eval(ap(r,top())); + if (whnfInt<0 || whnfInt>=s) + return UNIT; + else { + List us = NIL; + drop(); + for (us=vs; whnfInt>0; --whnfInt) + us = tl(us); + hd(us) = (isNull(hd(us)) ? top() : nameEltUndef); + drop(); + as = pop(); + } + } + else + internal("runtime type error"); + } + return vs; +} + +static List local foldAssocs(r,s,f,as,vs) +Cell r; /* fold assocs as into array list */ +Int s; /* vs using function f, with r for */ +Cell f; /* range and s for size */ +Cell as; /* bounds. */ +List vs; { + for (;;) { /* loop through assocs */ + eval(as); + if (whnfHead==nameNil && whnfArgs==0) + break; + else if (whnfHead==nameCons && whnfArgs==2) { + eval(pop()); + /* at this point, the top of the stack looks like: + * + * pushed(0) == index (first component in assoc) + * pushed(1) == value for assoc + * pushed(2) == rest of assocs + */ + eval(ap(r,top())); + if (whnfInt<0 || whnfInt>s) + return UNIT; + else { + List us = NIL; + drop(); + for (us=vs; whnfInt>0; --whnfInt) + us = tl(us); + hd(us) = ap(ap(f,hd(us)),pop()); + as = pop(); + } + } + else + internal("runtime type error"); + } + return vs; +} + +primFun(primArray) { /* Array creation */ + Cell range = primArg(3); /* :: (a -> Int) -> */ + Cell bounds = primArg(2); /* (a,a) -> */ + Cell assocs = primArg(1); /* [Assoc a b] -> Array a b */ + List vs = NIL; + List us = NIL; + Int size; + + size = getSize(bounds,range); /* check bounds */ + vs = copy(size,NIL); /* initialize elems*/ + vs = addAssocs(range,size,assocs,vs); /* process assocs */ + if (vs==UNIT) { + updapRoot(ap(nameOutBounds,bounds),top()); + cantReduce(); + } + for (us=vs; nonNull(us); us=tl(us)) /* set undef elts */ + if (isNull(hd(us))) + hd(us) = nameEltUndef; + + updapRoot(ARRAY,ap(bounds,vs)); +} + +primFun(primUpdate) { /* Array update */ + Cell range = primArg(3); /* :: (a -> Int) -> */ + Cell oldArr = primArg(2); /* Array a b -> */ + Cell assocs = primArg(1); /* [Assoc a b] -> Array a b */ + Cell bounds = NIL; + Cell elems = NIL; + List vs = NIL; + List us = NIL; + Int size; + + eval(oldArr); /* find bounds */ + bounds = fst(snd(whnfHead)); + elems = snd(snd(whnfHead)); + size = getSize(bounds,range); + vs = copy(size,NIL); /* initialize elems*/ + vs = addAssocs(range,size,assocs,vs); /* process assocs */ + if (vs==UNIT) { + updapRoot(ap(nameOutBounds,bounds),top()); + cantReduce(); + } + for (us=vs; nonNull(us) && nonNull(elems); us=tl(us), elems=tl(elems)) + if (isNull(hd(us))) /* undef values */ + hd(us) = hd(elems); /* replaced by the */ + /* old array vals */ + updapRoot(ARRAY,ap(bounds,vs)); +} + +primFun(primAccum) { /* Array accum */ + Cell range = primArg(4); /* :: (a -> Int) -> */ + Cell f = primArg(3); /* (b -> c -> b) -> */ + Cell orig = primArg(2); /* Array a b -> */ + Cell assocs = primArg(1); /* [Assoc a c] -> Array a b */ + Cell bounds = NIL; + List vs = NIL; + Int size; + + eval(orig); /* find bounds */ + bounds = fst(snd(whnfHead)); + vs = dupList(snd(snd(whnfHead))); /* elements of orig*/ + size = getSize(bounds,range); + vs = foldAssocs(range,size,f,assocs,vs); /* process assocs */ + if (vs==UNIT) { + updapRoot(ap(nameOutBounds,bounds),top()); + cantReduce(); + } + updapRoot(ARRAY,ap(bounds,vs)); +} + +primFun(primAccumArray) { /* Array accumArray */ + Cell range = primArg(5); /* :: (a -> Int) -> */ + Cell f = primArg(4); /* (b -> c -> b) -> */ + Cell z = primArg(3); /* b -> */ + Cell bounds = primArg(2); /* (a,a) -> */ + Cell assocs = primArg(1); /* [Assoc a c] -> Array a b*/ + List vs = NIL; + Int size; + + size = getSize(bounds,range); /* check size */ + vs = copy(size,z); /* initialize elems*/ + vs = foldAssocs(range,size,f,assocs,vs); /* process assocs */ + if (vs==UNIT) { + updapRoot(ap(nameOutBounds,bounds),top()); + cantReduce(); + } + updapRoot(ARRAY,ap(bounds,vs)); +} + +primFun(primAmap) { /* map function over array */ + Cell f = primArg(2); /* :: (b -> c) -> */ + Cell a = primArg(1); /* Array a b -> Array a c */ + List us = NIL; + List vs = NIL; + + eval(a); + a = whnfHead; + for (us=snd(snd(a)); nonNull(us); us=tl(us)) + vs = cons(ap(f,hd(us)),vs); + updapRoot(ARRAY,ap(fst(snd(a)),rev(vs))); +} + +primFun(primSubscript) { /* Subscript primitive */ + Int index = 0; /* :: (a -> Int) -> */ + List vs = NIL; /* Array a b -> */ + /* a -> b */ + + eval(ap(primArg(3),primArg(1))); /* find required position */ + if ((index=whnfInt) < 0) + cantReduce(); + eval(primArg(2)); /* evaluate array */ + if (whatIs(whnfHead)!=ARRAY) + internal("primBounds"); + for (vs=snd(snd(whnfHead)); nonNull(vs) && index>0; vs=tl(vs)) + --index; + if (isNull(vs)) + cantReduce(); + updateRoot(hd(vs)); +} + +primFun(primBounds) { /* Bounds primitive */ + eval(primArg(1)); /* :: Array a b -> (a,a) */ + if (whatIs(whnfHead)!=ARRAY) + internal("primBounds"); + updateRoot(fst(snd(whnfHead))); +} + +primFun(primElems) { /* elems primitive */ + Cell vs = NIL; + Cell us = NIL; + eval(primArg(1)); /* evaluate array to whnf */ + if (whatIs(whnfHead)!=ARRAY) + internal("primElems"); + for (us=snd(snd(whnfHead)); nonNull(us); us=tl(us)) + vs = ap(ap(nameCons,hd(us)),vs); + updateRoot(revOnto(vs,nameNil)); +} +#endif + +/* -------------------------------------------------------------------------- + * Integer arithmetic primitives: + * ------------------------------------------------------------------------*/ + +primFun(primPlusInt) { /* Integer addition primitive */ + Int x; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + updateRoot(mkInt(x+whnfInt)); +} + +primFun(primMinusInt) { /* Integer subtraction primitive */ + Int x; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + updateRoot(mkInt(x-whnfInt)); +} + +primFun(primMulInt) { /* Integer multiplication primitive */ + Int x; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + updateRoot(mkInt(x*whnfInt)); +} + +primFun(primQuotInt) { /* Integer division primitive */ + Int x; /* truncated towards zero */ + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + + if (whnfInt==0) + cantReduce(); + + updateRoot(mkInt(x/whnfInt)); +} + +primFun(primDivInt) { /* Integer division primitive */ + Int x,r; /* truncated towards -ve infinity */ + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + + if (whnfInt==0) + cantReduce(); + r = x%whnfInt; + x = x/whnfInt; + if ((whnfInt<0 && r>0) || (whnfInt>0 && r<0)) + x--; + updateRoot(mkInt(x)); +} + +primFun(primModInt) { /* Integer modulo primitive */ + Int x,y; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + if (whnfInt==0) + cantReduce(); + y = x%whnfInt; /* "... the modulo having the sign */ + if ((y<0 && whnfInt>0) || /* of the divisor ..." */ + (y>0 && whnfInt<0)) /* See definition on p.91 of Haskell*/ + updateRoot(mkInt(y+whnfInt)); /* report... */ + else + updateRoot(mkInt(y)); +} + +primFun(primRemInt) { /* Integer remainder primitive */ + Int x; + eval(primArg(2)); /* div and rem satisfy: */ + x = whnfInt; /* (x `div` y)*y + (x `rem` y) == x */ + eval(primArg(1)); /* which is exactly the property */ + if (whnfInt==0) /* described in K&R 2: */ + cantReduce(); /* (a/b)*b + a%b == a */ + updateRoot(mkInt(x%whnfInt)); +} + +primFun(primNegInt) { /* Integer negation primitive */ + eval(primArg(1)); + updateRoot(mkInt(-whnfInt)); +} + +/* -------------------------------------------------------------------------- + * Coercion primitives: + * ------------------------------------------------------------------------*/ + +primFun(primCharToInt) { /* Character to integer primitive */ + eval(primArg(1)); + updateRoot(mkInt(charOf(whnfHead))); +} + +primFun(primIntToChar) { /* Integer to character primitive */ + eval(primArg(1)); + if (whnfInt<0 || whnfInt>MAXCHARVAL) + cantReduce(); + updateRoot(mkChar(whnfInt)); +} + +primFun(primIntToFloat) { /* Integer to Float primitive */ + eval(primArg(1)); + updateRoot(mkFloat((Float)(whnfInt))); +} + +/* -------------------------------------------------------------------------- + * Float arithmetic primitives: + * ------------------------------------------------------------------------*/ + +primFun(primPlusFloat) { /* Float addition primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + updateRoot(mkFloat(x+whnfFloat)); +} + +primFun(primMinusFloat) { /* Float subtraction primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + updateRoot(mkFloat(x-whnfFloat)); +} + +primFun(primMulFloat) { /* Float multiplication primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + updateRoot(mkFloat(x*whnfFloat)); +} + +primFun(primDivFloat) { /* Float division primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + if (whnfFloat==0) + cantReduce(); + updateRoot(mkFloat(x/whnfFloat)); +} + +primFun(primNegFloat) { /* Float negation primitive */ + eval(primArg(1)); + updateRoot(mkFloat(-whnfFloat)); +} + +#if HAS_FLOATS +primFun(primSinFloat) { /* Float sin (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(sin(whnfFloat))); +} + +primFun(primCosFloat) { /* Float cos (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(cos(whnfFloat))); +} + +primFun(primTanFloat) { /* Float tan (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(tan(whnfFloat))); +} + +primFun(primAsinFloat) { /* Float arc sin (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(asin(whnfFloat))); +} + +primFun(primAcosFloat) { /* Float arc cos (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(acos(whnfFloat))); +} + +primFun(primAtanFloat) { /* Float arc tan (trig) primitive */ + eval(primArg(1)); + updateRoot(mkFloat(atan(whnfFloat))); +} + +primFun(primAtan2Float) { /* Float arc tan with quadrant info*/ + Float t; /* (trig) primitive */ + eval(primArg(2)); + t = whnfFloat; + eval(primArg(1)); + updateRoot(mkFloat(atan2(t,whnfFloat))); +} + +primFun(primExpFloat) { /* Float exponential primitive */ + eval(primArg(1)); + updateRoot(mkFloat(exp(whnfFloat))); +} + +primFun(primLogFloat) { /* Float logarithm primitive */ + eval(primArg(1)); + if (whnfFloat<=0) + cantReduce(); + updateRoot(mkFloat(log(whnfFloat))); +} + +primFun(primLog10Float) { /* Float logarithm (base 10) prim */ + eval(primArg(1)); + if (whnfFloat<=0) + cantReduce(); + updateRoot(mkFloat(log10(whnfFloat))); +} + +primFun(primSqrtFloat) { /* Float square root primitive */ + eval(primArg(1)); + if (whnfFloat<0) + cantReduce(); + updateRoot(mkFloat(sqrt(whnfFloat))); +} + +primFun(primFloatToInt) { /* Adhoc Float --> Int conversion */ + eval(primArg(1)); + updateRoot(mkInt((Int)(whnfFloat))); +} +#endif + +/* -------------------------------------------------------------------------- + * Comparison primitives: + * ------------------------------------------------------------------------*/ + +primFun(primEqInt) { /* Integer equality primitive */ + Int x; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + updateRoot(x==whnfInt ? nameTrue : nameFalse); +} + +primFun(primLeInt) { /* Integer <= primitive */ + Int x; + eval(primArg(2)); + x = whnfInt; + eval(primArg(1)); + updateRoot(x<=whnfInt ? nameTrue : nameFalse); +} + +primFun(primEqChar) { /* Character equality primitive */ + Cell x; + eval(primArg(2)); + x = whnfHead; + eval(primArg(1)); + updateRoot(x==whnfHead ? nameTrue : nameFalse); +} + +primFun(primLeChar) { /* Character <= primitive */ + Cell x; + eval(primArg(2)); + x = whnfHead; + eval(primArg(1)); + updateRoot(x<=whnfHead ? nameTrue : nameFalse); +} + +primFun(primEqFloat) { /* Float equality primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + updateRoot(x==whnfFloat ? nameTrue : nameFalse); +} + +primFun(primLeFloat) { /* Float <= primitive */ + Float x; + eval(primArg(2)); + x = whnfFloat; + eval(primArg(1)); + updateRoot(x<=whnfFloat ? nameTrue : nameFalse); +} + +/* Generic comparisons implemented using the internal primitive function: + * + * primCmp [] = EQ + * ((C xs, D ys):rs) + * | C < D = LT + * | C == D = primCmp (zip xs ys ++ rs) + * | C > D = GT + * ((Int n, Int m):rs) + * | n < m = LT + * | n == m = primCmp rs + * | n > m = GT + * etc ... similar for comparison of characters: + * + * The list argument to primCmp is represented as an `internal list'; + * i.e. no (:)/[] constructors - use internal cons and NIL instead! + * + * To compare two values x and y, evaluate primCmp [(x,y)] and use result. + */ + +#define LT 1 +#define EQ 2 +#define GT 3 +#define compResult(x) updateRoot(mkInt(x)) + +static Name namePrimCmp; + +primFun(primCmp) { /* generic comparison function */ + Cell rs = primArg(1); + + if (isNull(rs)) { + compResult(EQ); + return; + } + else { + Cell x = fst(hd(rs)); + Cell y = snd(hd(rs)); + Int whnfArgs1; + Cell whnfHead1; + + rs = tl(rs); + eval(x); + whnfArgs1 = whnfArgs; + whnfHead1 = whnfHead; + + switch (whatIs(whnfHead1)) { + case INTCELL : if (whnfArgs==0) { /* compare ints */ + eval(y); + if (!isInt(whnfHead) || whnfArgs!=0) + break; + if (intOf(whnfHead1) > whnfInt) + compResult(GT); + else if (intOf(whnfHead1) < whnfInt) + compResult(LT); + else + updapRoot(namePrimCmp,rs); + return; + } + break; + + case FLOATCELL: if (whnfArgs==0) { /* compare floats */ + eval(y); + if (!isFloat(whnfHead) || whnfArgs!=0) + break; + if (floatOf(whnfHead1) > whnfFloat) + compResult(GT); + else if (floatOf(whnfHead1) < whnfFloat) + compResult(LT); + else + updapRoot(namePrimCmp,rs); + return; + } + break; + + case CHARCELL : if (whnfArgs==0) { /* compare chars */ + eval(y); + if (!isChar(whnfHead) || whnfArgs!=0) + break; + if (charOf(whnfHead1) > charOf(whnfHead)) + compResult(GT); + else if (charOf(whnfHead1) < charOf(whnfHead)) + compResult(LT); + else + updapRoot(namePrimCmp,rs); + return; + } + break; + +#if HASKELL_ARRAYS + case ARRAY : break; +#endif +#if IO_MONAD + case MUTVAR : break; +#endif + + default : eval(y); /* compare structs */ + if (whnfHead1==whnfHead && + whnfArgs1==whnfArgs && + (whnfHead==UNIT || + isTuple(whnfHead) || + (isName(whnfHead) && + name(whnfHead).defn==CFUN))) { + while (whnfArgs1-- >0) + rs = cons(pair(pushed(whnfArgs+whnfArgs1), + pushed(whnfArgs1)),rs); + updapRoot(namePrimCmp,rs); + return; + } + if (isName(whnfHead1) && + name(whnfHead1).defn==CFUN && + isName(whnfHead) && + name(whnfHead).defn==CFUN) { + if (name(whnfHead1).number + > name(whnfHead).number) + compResult(GT); + else if (name(whnfHead1).number + < name(whnfHead).number) + compResult(LT); + else + break; + return; + } + break; + } + /* we're going to fail because we can't compare x and y; modify */ + /* the root expression so that it looks reasonable before failing */ + /* i.e. output produced will be: {_compare x y} */ + updapRoot(ap(namePrimCmp,x),y); + } + cantReduce(); +} + +primFun(primGenericEq) { /* Generic equality test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt==EQ ? nameTrue : nameFalse); +} + +primFun(primGenericLe) { /* Generic <= test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt<=EQ ? nameTrue : nameFalse); +} + +primFun(primGenericLt) { /* Generic < test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt= test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt>=EQ ? nameTrue : nameFalse); +} + +primFun(primGenericGt) { /* Generic > test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt>EQ ? nameTrue : nameFalse); +} + +primFun(primGenericNe) { /* Generic /= test */ + Cell c = ap(namePrimCmp,singleton(pair(primArg(2),primArg(1)))); + eval(c); + updateRoot(whnfInt!=EQ ? nameTrue : nameFalse); +} + +/* -------------------------------------------------------------------------- + * Print primitives: + * ------------------------------------------------------------------------*/ + +static Cell consOpen, consSpace, consComma, consClose; +static Cell consObrace, consCbrace, consOsq, consCsq; +static Cell consBack, consMinus, consQuote, consDQuote; + +static Name nameLPrint, nameNLPrint; /* list printing primitives */ +static Name nameSPrint, nameNSPrint; /* string printing primitives */ + +#define print(pr,d,e,ss) ap(ap(ap(pr,mkInt(d)),e),ss) +#define lprint(pr,xs,ss) ap(ap(pr,xs),ss) +#define printString(s,ss) revOnto(stringOutput(s,NIL),ss) +#define printSChar(c,ss) printString(unlexChar(c,'\"'),ss) + +primFun(primPrint) { /* evaluate and print term */ + Int d = intOf(primArg(3)); /* :: Int->Expr->[Char]->[Char] */ + Cell e = primArg(2); + Cell ss = primArg(1); + Cell temp = evalWithNoError(e); + if (nonNull(temp)) + updateRoot(printBadRedex(temp,ss)); + else + printer(root,namePrint,d,ss); +} + +primFun(primNPrint) { /* print term without evaluation */ + Int d = intOf(primArg(3)); /* :: Int->Expr->[Char]->[Char] */ + Cell e = primArg(2); + Cell ss = primArg(1); + unwind(e); + printer(root,nameNPrint,d,ss); +} + +static Void local printer(root,pr,d,ss) /* Main part: primPrint/primNPrint */ +StackPtr root; /* root or print redex */ +Name pr; /* printer to use on components */ +Int d; /* precedence level */ +Cell ss; { /* rest of output */ + Int used = 0; + Cell output = NIL; + + switch(whatIs(whnfHead)) { + + case NAME : { Syntax sy = syntaxOf(name(whnfHead).text); + + if (name(whnfHead).defn!=CFUN || + name(whnfHead).arity>whnfArgs) + pr = nameNPrint; + + if (whnfHead==nameCons && whnfArgs==2) {/*list */ + if (pr==namePrint) + startList(root,ss); + else + startNList(root,ss); + return; + } + if (whnfArgs==1 && sy!=APPLIC) { /* (e1+) */ + used = 1; + output = ap(consClose, + textAsOp(name(whnfHead).text, + ap(consSpace, + print(pr,FUN_PREC-1,pushed(0), + ap(consOpen,NIL))))); + } + else if (whnfArgs>=2 && sy!=APPLIC) { /* e1+e2 */ + Syntax a = assocOf(sy); + Int p = precOf(sy); + used = 2; + if (whnfArgs>2 || d>p) + output = ap(consOpen,output); + output = print(pr,(a==RIGHT_ASS?p:1+p), + pushed(1), + ap(consSpace, + textAsOp(name(whnfHead).text, + ap(consSpace, + print(pr,(a==LEFT_ASS? p:1+p), + pushed(0), + output))))); + if (whnfArgs>2 || d>p) + output = ap(consClose,output); + } + else /* f ... */ + output = textAsVar(name(whnfHead).text,NIL); + } + break; + + case INTCELL : { Int digit; + + if (intOf(whnfHead)<0 && d>=FUN_PREC) + output = ap(consClose,output); + + do { + digit = whnfInt%10; + if (digit<0) + digit= (-digit); + output = ap(consChar('0'+digit),output); + } while ((whnfInt/=10)!=0); + + if (intOf(whnfHead)<0) { + output = ap(consMinus,output); + if (d>=FUN_PREC) + output = ap(consOpen,output); + } + + output = rev(output); + pr = nameNPrint; + } + break; + + case UNIT : output = ap(consClose,ap(consOpen,NIL)); + pr = nameNPrint; + break; + + case TUPLE : { Int tn = tupleOf(whnfHead); + Cell punc = consOpen; + Int i; + + used = tn=FUN_PREC) + output = ap(consOpen,output); + output = stringOutput(floatToString(whnfFloat),output); + if (whnfFloat<0.0 && d>=FUN_PREC) + output = ap(consClose,output); + pr = nameNPrint; + break; + +#if HASKELL_ARRAYS + case ARRAY : output = stringOutput("{array}",output); + pr = nameNPrint; + break; +#endif + +#if IO_MONAD + case MUTVAR : output = stringOutput("{mutable variable}",output); + pr = nameNPrint; + break; +#endif + + case DICTCELL : output = stringOutput("{dict}",output); + pr = nameNPrint; + break; + + case FILECELL : output = stringOutput("{file}",output); + pr = nameNPrint; + break; + + default : internal("Error in graph"); + break; + } + + if (used=FUN_PREC) { /* Determine if parens are needed */ + updapRoot(consOpen,revOnto(output,ap(consClose,ss))); + return; + } + } + + updateRoot(revOnto(output,ss)); +} + +/* -------------------------------------------------------------------------- + * List printing primitives: + * ------------------------------------------------------------------------*/ + +static Void local startList(root,ss) /* start printing evaluated list */ +StackPtr root; +Cell ss; { + Cell x = pushed(0); + Cell xs = pushed(1); + Cell temp = evalWithNoError(x); + if (nonNull(temp)) + updapRoot(consOsq, + printBadRedex(temp, + lprint(nameLPrint,xs,ss))); + else if (isChar(whnfHead) && whnfArgs==0) + updapRoot(consDQuote, + printSChar(charOf(whnfHead), + lprint(nameSPrint,xs,ss))); + else + updapRoot(consOsq, + print(namePrint,MIN_PREC,x, + lprint(nameLPrint,xs,ss))); +} + +static Void local startNList(root,ss) /* start printing unevaluated list */ +StackPtr root; +Cell ss; { + Cell x = pushed(0); + Cell xs = pushed(1); + unwind(x); + if (isChar(whnfHead) && whnfArgs==0) + updapRoot(consDQuote, + printSChar(charOf(whnfHead), + lprint(nameNSPrint,xs,ss))); + else + updapRoot(consOsq, + print(nameNPrint,MIN_PREC,x, + lprint(nameNLPrint,xs,ss))); +} + +primFun(primLPrint) { /* evaluate and print list */ + Cell e = primArg(2); + Cell ss = primArg(1); + Cell temp = evalWithNoError(e); + + if (nonNull(temp)) + updateRoot(printString("] ++ ",printBadRedex(temp,ss))); + else if (whnfHead==nameCons && whnfArgs==2) + updapRoot(consComma, + ap(consSpace, + print(namePrint,MIN_PREC,pushed(0), + lprint(nameLPrint,pushed(1),ss)))); + else if (whnfHead==nameNil && whnfArgs==0) + updapRoot(consCsq,ss); + else + updateRoot(printString("] ++ ",printBadRedex(e,ss))); +} + +primFun(primNLPrint) { /* print list without evaluation */ + Cell e = primArg(2); + Cell ss = primArg(1); + unwind(e); + if (whnfHead==nameCons && whnfArgs==2) + updapRoot(consComma, + ap(consSpace, + print(nameNPrint,MIN_PREC,pushed(0), + lprint(nameNLPrint,pushed(1),ss)))); + else if (whnfHead==nameNil && whnfArgs==0) + updapRoot(consCsq,ss); + else + updateRoot(printString("] ++ ",print(nameNPrint,FUN_PREC-1,e,ss))); +} + +primFun(primSPrint) { /* evaluate and print string */ + Cell e = primArg(2); + Cell ss = primArg(1); + Cell temp = evalWithNoError(e); + + if (nonNull(temp)) + updateRoot(printString("\" ++ ",printBadRedex(temp,ss))); + else if (whnfHead==nameCons && whnfArgs==2) { + Cell x = pushed(0); + Cell xs = pushed(1); + temp = evalWithNoError(x); + if (nonNull(temp)) + updateRoot(printString("\" ++ [", + printBadRedex(temp, + lprint(nameLPrint,xs,ss)))); + else if (isChar(whnfHead) && whnfArgs==0) + updateRoot(printSChar(charOf(whnfHead), + lprint(nameSPrint,xs,ss))); + else + updateRoot(printString("\" ++ [", + printBadRedex(x, + lprint(nameLPrint,xs,ss)))); + } + else if (whnfHead==nameNil && whnfArgs==0) + updapRoot(consDQuote,ss); + else + updateRoot(printString("\" ++ ",printBadRedex(e,ss))); +} + +primFun(primNSPrint) { /* print string without eval */ + Cell e = primArg(2); + Cell ss = primArg(1); + unwind(e); + if (whnfHead==nameCons && whnfArgs==2) { + Cell x = pushed(0); + Cell xs = pushed(1); + unwind(x); + if (isChar(whnfHead) && whnfArgs==0) + updateRoot(printSChar(charOf(whnfHead), + lprint(nameNSPrint,xs,ss))); + else + updateRoot(printString("\" ++ [", + print(nameNPrint,MIN_PREC,x, + lprint(nameNLPrint,xs,ss)))); + } + else if (whnfHead==nameNil && whnfArgs==0) + updapRoot(consDQuote,ss); + else + updateRoot(printString("\" ++ ",print(nameNPrint,FUN_PREC-1,e,ss))); +} + +/* -------------------------------------------------------------------------- + * Auxiliary functions for printer(s): + * ------------------------------------------------------------------------*/ + +static Cell local textAsVar(t,ss) /* reverse t as function symbol */ +Text t; /* onto output ss */ +Cell ss; { + String s = textToStr(t); + if ((isascii(s[0]) && isalpha(s[0])) || s[0]=='_' || strcmp(s,"[]")==0) + return stringOutput(s,ss); + else + return ap(consClose,stringOutput(s,ap(consOpen,ss))); +} + +static Cell local textAsOp(t,ss) /* reverse t as op. symbol onto ss */ +Text t; +Cell ss; { + String s = textToStr(t); + if (isascii(s[0]) && isalpha(s[0])) + return ap(consBack,stringOutput(s,ap(consBack,ss))); + else + return stringOutput(s,ss); +} + +static Cell local stringOutput(s,ss) /* reverse string s onto output ss */ +String s; +Cell ss; { + while (*s) + ss = ap(consChar(*s++),ss); + return ss; +} + +static Cell local printBadRedex(rx,rs) /* Produce expression to print bad */ +Cell rx, rs; { /* redex and then print rest ... */ + return ap(consObrace, + print(nameNPrint,MIN_PREC,rx, + ap(consCbrace, + rs))); +} + +static Cell local printDBadRedex(rx,rs) /* Produce expression for bad redex*/ +Cell rx, rs; { /* within a Dialogue, with special */ + if (isAp(rx) && fun(rx)==nameError) /* handling of {error str} redexes */ + return arg(rx); + else + return printBadRedex(rx,rs); +} + +Void abandon(what,rx) /* abandon computation */ +String what; +Cell rx; { + outputString(errorStream, + revOnto(stringOutput("\n",NIL), + revOnto(stringOutput(what,NIL), + revOnto(stringOutput(" error: ",NIL), + printDBadRedex(rx,nameNil))))); + errAbort(); +} + +/* -------------------------------------------------------------------------- + * Evaluate name, obtaining a C string from a Gofer string: + * ------------------------------------------------------------------------*/ + +#if (IO_DIALOGUE | LAMBDAVAR | LAMBDANU) +static String local evalName(es) /* evaluate es :: [Char] and save */ +Cell es; { /* in char array... return ptr to */ + static char buffer[FILENAME_MAX+1]; /* string or 0, if error occurs */ + Int pos = 0; + StackPtr saveSp = sp; + + while (isNull(evalWithNoError(es))) + if (whnfHead==nameCons && whnfArgs==2) { + Cell e = pop(); /* avoid leaving anything on stack */ + es = pop(); + if (isNull(evalWithNoError(e)) + && isChar(whnfHead) && whnfArgs==0 + && pos echo changed in dialogue*/ +static Bool stdinUsed; /* TRUE => ReadChan stdin has been */ + /* seen in dialogue */ +static FILE *writingFile = 0; /* points to file open for writing */ + +Void dialogue(prog) /* carry out dialogue ... */ +Cell prog; { /* :: Dialog=[Response]->[Request] */ + static String ioerr = "Attempt to read response before request complete"; + Cell tooStrict = mkStr(findText(ioerr)); + Cell resps = prog = ap(prog,NIL); + Cell temp; + + echoChanged = FALSE; + stdinUsed = FALSE; + for (;;) { /* Keep Responding to Requests */ + resps = snd(resps) = ap(nameError,tooStrict); + clearStack(); + if (nonNull(temp=evalWithNoError(prog))) + abandonDialogue(temp); + else if (whnfHead==nameCons && whnfArgs==2) { + if (nonNull(temp=evalWithNoError(pushed(0)))) + abandonDialogue(temp); + + prog = pushed(1+whnfArgs); + + if (whnfHead==nameReadFile && whnfArgs==1) + fst(resps) = ap(nameCons,readFile()); + else if (whnfHead==nameWriteFile && whnfArgs==2) + fst(resps) = ap(nameCons,writeFile()); + else if (whnfHead==nameAppendFile && whnfArgs==2) + fst(resps) = ap(nameCons,appendFile()); + else if (whnfHead==nameReadChan && whnfArgs==1) + fst(resps) = ap(nameCons,readChan()); + else if (whnfHead==nameAppendChan && whnfArgs==2) + fst(resps) = ap(nameCons,appendChan()); + else if (whnfHead==nameEcho && whnfArgs==1) + fst(resps) = ap(nameCons,echo()); + else if (whnfHead==nameGetArgs && whnfArgs==0) + fst(resps) = ap(nameCons,getCLArgs()); + else if (whnfHead==nameGetProgName && whnfArgs==0) + fst(resps) = ap(nameCons,getProgName()); + else if (whnfHead==nameGetEnv && whnfArgs==1) + fst(resps) = ap(nameCons,getEnv()); + else + abandonDialogue(pushed(whnfArgs)); + } + else if (whnfHead==nameNil && whnfArgs==0) { + normalTerminal(); + return; + } + else + internal("Type error during Dialogue"); + } +} + +static Void local abandonDialogue(rx) /* abandon dialogue after failure */ +Cell rx; { /* to reduce redex rx */ + abandon("Dialogue",rx); +} + +static Cell local readFile() { /* repond to ReadFile request */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + Cell temp = NIL; /* pushed(1) = ReadFile request */ + /* pushed(2) = rest of program */ + + if (!s) /* problem with filename? */ + abandonDialogue(pushed(1)); + if (access(s,0)!=0) /* can't find file */ + return ap(nameFailure,ap(nameSearchError,pushed(0))); + if (isNull(temp = openFile(s))) /* can't open file */ + return ap(nameFailure,ap(nameReadError,pushed(0))); + return ap(nameStr,temp); /* otherwise we got a file! */ +} + +static Cell local writeFile() { /* respond to WriteFile req. */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + FILE *fp; /* pushed(1) = output string */ + Cell temp; /* pushed(2) = output request */ + /* pushed(3) = rest of program */ + + if (!s) /* problem with filename? */ + abandonDialogue(pushed(2)); + pushed(2) = NIL; /* eliminate space leak! */ + if ((fp=fopen(s,FOPEN_WRITE))==0) /* problem with output file? */ + return ap(nameFailure,ap(nameWriteError,pushed(0))); + drop(); + temp = outputDString(writingFile = fp); + fclose(fp); + writingFile = 0; + if (nonNull(temp)) + return ap(nameFailure,ap(nameWriteError,temp)); + else + return nameSuccess; +} + +static Cell local appendFile() { /* respond to AppendFile req. */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + FILE *fp; /* pushed(1) = output string */ + Cell temp; /* pushed(2) = output request */ + /* pushed(3) = rest of program */ + + if (!s) /* problem with filename? */ + abandonDialogue(pushed(2)); + pushed(2) = NIL; /* eliminate space leak! */ + if (access(s,0)!=0) /* can't find file? */ + return ap(nameFailure,ap(nameSearchError,pushed(0))); + if ((fp=fopen(s,FOPEN_APPEND))==0) /* problem with output file? */ + return ap(nameFailure,ap(nameWriteError,pushed(0))); + drop(); + temp = outputDString(writingFile = fp); + fclose(fp); + writingFile = 0; + if (nonNull(temp)) + return ap(nameFailure,ap(nameWriteError,temp)); + else + return nameSuccess; +} + +static Cell local readChan() { /* respond to readChan req. */ + String s = evalName(pushed(0)); /* pushed(0) = channel name string */ + /* pushed(1) = output request */ + /* pushed(2) = rest of program */ + + if (!s) /* problem with filename? */ + abandonDialogue(pushed(1)); + if (strcmp(s,"stdin")!=0) /* only valid channel == stdin */ + return ap(nameFailure,ap(nameSearchError,pushed(0))); + if (stdinUsed) /* can't reuse stdin channel! */ + return ap(nameFailure,ap(nameReadError,pushed(0))); + stdinUsed = TRUE; + return ap(nameStr,ap(nameInput,UNIT)); +} + +static Cell local appendChan() { /* respond to AppendChannel req. */ + String s = evalName(pushed(0)); /* pushed(0) = channel name string */ + FILE *fp; /* pushed(1) = output string */ + Cell temp; /* pushed(2) = output request */ + /* pushed(3) = rest of program */ + if (!s) /* problem with filename? */ + abandonDialogue(pushed(2)); + pushed(2) = NIL; /* eliminate space leak! */ + if ((fp = validOutChannel(s))==0) /* problem with output channel? */ + return ap(nameFailure,ap(nameSearchError,pushed(0))); + drop(); + if (nonNull(temp=outputDString(fp))) + return ap(nameFailure,ap(nameWriteError,temp)); + else + return nameSuccess; +} + +static FILE *local validOutChannel(s) /* return FILE * for valid output */ +String s; { /* channel name or 0 otherwise... */ + if (strcmp(s,"stdout")==0) + return stdout; + if (strcmp(s,"stderr")==0) + return stderr; + if (strcmp(s,"stdecho")==0) /* in Gofer, stdecho==stdout */ + return stdout; + return 0; +} + +static Cell local echo() { /* respond to Echo request */ + /* pushed(0) = boolean echo status */ + /* pushed(1) = echo request */ + /* pushed(2) = rest of program */ + static String inUse = "stdin already in use"; + static String repeat = "repeated Echo request"; + + if (isNull(evalWithNoError(pushed(0)))) { + if (stdinUsed) + return ap(nameFailure,ap(nameOtherError,mkStr(findText(inUse)))); + if (echoChanged) + return ap(nameFailure,ap(nameOtherError,mkStr(findText(repeat)))); + if (whnfHead==nameFalse && whnfArgs==0) { + echoChanged = TRUE; + noechoTerminal(); + return nameSuccess; + } + if (whnfHead==nameTrue && whnfArgs==0) { + echoChanged = TRUE; + return nameSuccess; + } + } + abandonDialogue(pushed(1)); + return NIL;/*NOTREACHED*/ +} + +static Cell local getCLArgs() { /* get command args -- always [] */ + return ap(nameStrList,nameNil); +} + +static Cell local getProgName() { /* get program name -- an error! */ + return ap(nameFailure,ap(nameOtherError,nameNil)); +} + +static Cell local getEnv() { /* get environment variable */ + String s = evalName(pushed(0)); /* pushed(0) = variable name string*/ + String r = 0; /* pushed(1) = output request */ + /* pushed(2) = rest of program */ + if (!s) + abandonDialogue(pushed(1)); + if (r=getenv(s)) + return ap(nameStr,revOnto(stringOutput(r,NIL),nameNil)); + else + return ap(nameFailure,ap(nameSearchError,pushed(0))); +} + +primFun(primInput) { /* read single character from stdin*/ + Int c = readTerminalChar(); + + if (c==EOF || c<0 || c>=NUM_CHARS) { + clearerr(stdin); + updateRoot(nameNil); + } + else + updapRoot(consChar(c),ap(nameInput,UNIT)); +} + +primFun(primFopen) { /* open file for reading as str */ + Cell succ = primArg(1); /* :: String->a->(String->a)->a */ + Cell fail = primArg(2); + String s = evalName(primArg(3)); + + if (s){ + Cell file = openFile(s); + if (nonNull(file)) { + updapRoot(succ,file); + return; + } + } + updateRoot(fail); +} + +static Cell local outputDString(fp) /* Evaluate string cs and print */ +FILE *fp; { /* on specified output stream fp */ + Cell temp = NIL; + for (;;) { /* keep reducing and printing head */ + temp = evalWithNoError(pop()); /* character */ + if (nonNull(temp)) + return printDBadRedex(temp,nameNil); + else if (whnfHead==nameCons && whnfArgs==2) { + if (nonNull(temp=evalWithNoError(pop()))) + return printDBadRedex(temp,top()); + else if (isChar(whnfHead) && whnfArgs==0) { + fputc(charOf(whnfHead),fp); + if (!writingFile) + fflush(fp); + } + else + break; + } + else if (whnfHead==nameNil && whnfArgs==0) { + if (writingFile) + fflush(fp); + return NIL; + } + else + break; + } + internal("runtime type error"); + return nameNil;/*NOTREACHED*/ +} +#endif + +/* -------------------------------------------------------------------------- + * Top-level printing mechanism: + * ------------------------------------------------------------------------*/ + +Cell outputString(fp,cs) /* Evaluate string cs and print */ +FILE *fp; /* on specified output stream fp */ +Cell cs; { + Cell temp; + + for (;;) { /* keep reducing and printing head */ + clearStack(); /* character */ + temp = evalWithNoError(cs); + if (nonNull(temp)) + cs = printBadRedex(temp,nameNil); + else if (whnfHead==nameCons && whnfArgs==2) { + Cell c = pushed(0); + cs = pushed(1); + + if (nonNull(temp=evalWithNoError(c))) + cs = printBadRedex(temp,cs); + else if (isChar(whnfHead) && whnfArgs==0) { + fputc(charOf(whnfHead),fp); + fflush(fp); + } + else + break; + } + else if (whnfHead==nameNil && whnfArgs==0) + return NIL; + else + break; + } + internal("runtime type error"); + return nameNil;/*NOTREACHED*/ +} + +/* -------------------------------------------------------------------------- + * IO monad implementation. Use these functions instead of old LAMBDAVAR + * and LAMBDANU + * Based on `Lazy State Threads' by Simon Peyton Jones and John Launchbury, + * to appear in PLDI '94. + * + * type ST s a = State s -> (a, State s) + * ------------------------------------------------------------------------*/ + +#if IO_MONAD +Void ioExecute(prog) /* execute IO monad program of type*/ +Cell prog; { /* IO () */ + Cell temp; + noechoTerminal(); + if (nonNull(temp=evalWithNoError(ap(prog,UNIT))) || + nonNull(temp=evalWithNoError(pushed(1)))) + abandon("Program execution",temp); +} + +primFun(primSTRun) { /* ST monad encapsulate */ + updapRoot(nameFst, /* :: all s.(ST s a) -> a */ + ap(primArg(1),UNIT)); +} + +primFun(primFst) { /* fst primitive */ + eval(primArg(1)); /* :: (a,s) -> a */ + updateRoot(top()); +} + +primFun(primSnd) { /* snd primitive */ + eval(primArg(1)); /* :: (a,s) -> s */ + updateRoot(pushed(1)); +} + +primFun(primSTReturn) { /* ST monad return */ + updapRoot(mkTuple(2),primArg(1)); /* return :: a -> ST s a */ +} /* return a = \s -> (a,s) */ + +primFun(primIOBind) { /* IO monad bind */ + Cell m = primArg(3); /* :: ST s a -> */ + Cell f = primArg(2); /* (a -> ST s b) -> */ + Cell s = primArg(1); /* ST s b */ + eval(ap(m,s)); + updapRoot(ap(f,top()),pushed(1)); /* A strict bind operation on ST */ +} + +primFun(primSTBind) { /* ST monad bind */ + Cell m = primArg(3); /* :: ST s a -> */ + Cell f = primArg(2); /* (a -> ST s b) -> */ + Cell s = primArg(1); /* ST s b */ + Cell r = ap(m,s); /* lazy version of bind on ST */ + updapRoot(ap(f,ap(nameFst,r)),ap(nameSnd,r)); +} + +primFun(primSTInter) { /* ST monad interleave */ + Cell m = primArg(2); /* :: ST s a -> */ + Cell s = primArg(1); /* ST s a */ + updapRoot(ap(mkTuple(2),ap(nameFst,ap(m,s))),s); +} + +primFun(primSTNew) { /* ST monad variable allocator */ + Cell i = primArg(2); /* :: a -> */ + Cell s = primArg(1); /* ST s (MutVar s a) */ + eval(s); /* force evaluation of state */ + updapRoot(ap(mkTuple(2),ap(MUTVAR,i)),s); +} + +primFun(primSTAssign) { /* ST monad assignment */ + Cell v = primArg(3); /* :: MutVar s a -> */ + Cell e = primArg(2); /* a -> */ + Cell s = primArg(1); /* ST s () */ + eval(s); /* force evaluation of state */ + eval(v); + if (!isPair(whnfHead) || fst(whnfHead)!=MUTVAR) + internal("type error in assign"); + snd(whnfHead) = e; /* Arrgh! impurity! :-) */ + updapRoot(ap(mkTuple(2),UNIT),s); +} + +primFun(primSTDeref) { /* ST monad dereference */ + Cell v = primArg(2); /* :: MutVar s a -> */ + Cell s = primArg(1); /* ST s a */ + eval(s); /* force evaluation of state */ + eval(v); + if (!isPair(whnfHead) || fst(whnfHead)!=MUTVAR) + internal("type error in deref"); + updapRoot(ap(mkTuple(2),snd(whnfHead)),s); +} + +primFun(primSTMutVarEq) { /* ST monad variable equality */ + Cell x = primArg(2); /* :: MutVar s a -> */ + Cell y = primArg(1); /* MutVar s a -> Bool */ + eval(x); + x = whnfHead; + eval(y); + updateRoot(x==whnfHead ? nameTrue : nameFalse); +} + +primFun(primIOGetch) { /* get character from stdin */ + Cell s = primArg(1); /* :: IO Char */ + eval(s); + updapRoot(ap(mkTuple(2),mkChar(readTerminalChar())),s); +} + +primFun(primIOPutchar) { /* print character on stdout */ + Cell c = primArg(2); /* :: Char -> */ + Cell s = primArg(1); /* IO () */ + eval(s); + eval(c); + putchar(charOf(whnfHead)); + fflush(stdout); + updapRoot(ap(mkTuple(2),UNIT),s); +} + +#if HASKELL_ARRAYS +primFun(primSTNewArr) { /* allocate mutable array */ + Cell range = primArg(4); /* :: (a -> Int) -> */ + Cell bounds = primArg(3); /* (a,a) -> */ + Cell z = primArg(2); /* b -> */ + Cell s = primArg(1); /* ST s (MutArr s a b) */ + Int size; + eval(s); + size = getSize(bounds,range); + updapRoot(ap(mkTuple(2), ap(ARRAY, ap(bounds,copy(size,z)))), s); +} + +primFun(primSTReadArr) { /* read element in mutable array */ + Cell index = primArg(4); /* :: ((a,a) -> a -> Int) -> */ + Cell a = primArg(3); /* MutArr s a b -> */ + Cell i = primArg(2); /* a -> */ + Cell s = primArg(1); /* ST s b */ + Cell vs = NIL; + eval(s); + eval(a); + vs = snd(whnfHead); + eval(ap(ap(index,fst(vs)),i)); + while (whnfInt-- > 0) + vs = snd(vs); + updapRoot(ap(mkTuple(2),fst(snd(vs))),s); +} + +primFun(primSTWriteArr) { /* write element in mutable array */ + Cell index = primArg(5); /* :: ((a,a) -> a -> Int) -> */ + Cell a = primArg(4); /* MutArr s a b -> */ + Cell i = primArg(3); /* a -> */ + Cell v = primArg(2); /* b -> */ + Cell s = primArg(1); /* ST s () */ + Cell vs = NIL; + eval(s); + eval(a); + vs = snd(whnfHead); + eval(ap(ap(index,fst(vs)),i)); + while (whnfInt-- > 0) + vs = snd(vs); + fst(snd(vs)) = v; + updapRoot(ap(mkTuple(2),UNIT),s); +} + +primFun(primSTFreeze) { /* freeze mutable array */ + Cell arr = primArg(2); /* :: MutArr s a b -> */ + Cell s = primArg(1); /* ST s (Array a b) */ + eval(s); + eval(arr); + updapRoot(ap(mkTuple(2),ap(ARRAY,dupList(snd(whnfHead)))),s); +} +#endif +#endif + +/* -------------------------------------------------------------------------- + * Lambda-var prototype implementation: + * + * OBSOLETE: You are strongly advised NOT to use the following code + * ------------------------------------------------------------------------*/ + +#ifdef LAMBDAVAR +Void lvExecute(prog) /* execute lambda var prog of type */ +Cell prog; { /* Proc () */ + Cell temp; + noechoTerminal(); + temp = evalWithNoError(ap(prog,UNIT)); + if (nonNull(temp)) + abandon("Program execution",temp); +} + +primFun(primLvReturn) { /* lambda var return */ + updateRoot(primArg(2)); /* return :: a -> Proc a */ + /* return e _ = e */ +} + +primFun(primLvPure) { /* lambda var pure */ + updapRoot(primArg(1),UNIT); /* pure :: Proc a -> a */ + /* pure e = e () */ +} + +primFun(primLvRead) { /* lambda var reader */ + Cell v = primArg(3); /* (?)::Var a->(a->Proc b)->Proc b */ + Cell f = primArg(2); /* (Var v ? f) () ===> f v () */ + eval(v); + if (whnfHead!=nameVar || whnfArgs!=1) + internal("type error in reader"); + updapRoot(ap(f,pushed(0)),UNIT); +} + +primFun(primLvBind) { /* lambda var bind */ + Cell m = primArg(3); /*($=)::Proc a->(a->Proc b)->Proc b*/ + Cell f = primArg(2); /* (m $= f) () ===> f (m ()) () */ + Cell a = ap(m,UNIT); /* strict in first argument */ + eval(a); + updapRoot(ap(f,a),UNIT); +} + +primFun(primLvVar) { /* lambda var, new variable */ + updapRoot(ap(primArg(2), /* var :: (Var a -> Proc b)->Proc b*/ + ap(nameVar, /* var f () = f {newvar} () */ + nameLvUnbound)), + UNIT); +} + +primFun(primLvNewvar) { /* lambda var, improved new var */ + updapRoot(nameVar,nameLvUnbound); /* newvar :: Proc (Var a) */ + /* newvar () = {newVar} */ +} + +primFun(primLvAssign) { /* lambda var assign */ + Cell e = primArg(3); /* assign :: a -> Var a -> Proc () */ + Cell v = primArg(2); /* assign e (Var v) () = () */ + eval(v); + if (whnfHead!=nameVar || whnfArgs!=1) + internal("type error in assign"); + while (isPair(v) && fst(v)==INDIRECT) { + v = arg(v); + allowBreak(); + } + snd(v) = e; /* Arrgh! impurity! */ + updateRoot(UNIT); +} + +primFun(primLvVarEq) { /* lambda var equality for Vars */ + Cell x = primArg(2); /* :: Var a -> Var a -> Bool */ + Cell y = primArg(1); + eval(x); + while (isPair(x) && fst(x)==INDIRECT) { + x = arg(x); + allowBreak(); + } + eval(y); + while (isPair(y) && fst(y)==INDIRECT) { + y = arg(y); + allowBreak(); + } + updateRoot(x==y ? nameTrue : nameFalse); +} + +primFun(primLvGetch) { /* get character from stdin */ + updateRoot(mkChar(readTerminalChar())); +} + +primFun(primLvPutchar) { /* print character on stdout */ + eval(primArg(2)); /* putchar c () ==> () */ + putchar(charOf(whnfHead)); + updateRoot(UNIT); +} + +primFun(primLvSystem) { /* do system call */ + String s = evalName(primArg(2)); /* system s () ==> int result */ + Int n = s ? system(s) : 1; + updateRoot(mkInt(n)); +} +#endif + +/* -------------------------------------------------------------------------- + * Lambda-nu prototype implementation: + * + * OBSOLETE: You are strongly advised NOT to use the following code + * ------------------------------------------------------------------------*/ + +#ifdef LAMBDANU +Void lnExecute(prog) /* execute lambda nu prog of type */ +Cell prog; { /* Cmd a () */ + Cell temp; + noechoTerminal(); + temp = evalWithNoError(ap(prog,nameLnDone)); + if (nonNull(temp)) + abandon("Command execution",temp); +} + +primFun(primLnDone) { /* lambda nu done */ + updateRoot(UNIT); /* behaviour is ignored, so isn't */ +} /* really important */ + +primFun(primLnReturn) { /* lambda nu return */ + updapRoot(primArg(1),primArg(2)); /* return :: a -> Cmd d a */ +} /* return a c = c a */ + +primFun(primLnBind) { /* lambda nu bind */ + Cell a = primArg(3); /* (>>=)::Cmd c a -> (a -> Cmd c b)*/ + Cell b = primArg(2); /* -> Cmd c b */ + Cell c = primArg(1); /* (a>>=b) c = a (flip b c) */ + updapRoot(a,ap(ap(nameLnFlip,b),c)); +} + +primFun(primLnFlip) { /* flip primitive, for use in bind */ + updapRoot(ap(primArg(3),primArg(1)),primArg(2)); +} + +primFun(primLnNew) { /* lambda nu allocate variable */ + Cell c = primArg(1); /* new :: Cmd a (Tag b) */ + updapRoot(c,ap(nameTag,nameLnUnbound)); +} + +primFun(primLnAssign) { /* lambda nu assign */ + Cell v = primArg(3); /* assign:: Tag a -> a -> Cmd d () */ + Cell e = primArg(2); /* assign (Tag v) e c = c () */ + Cell c = primArg(1); + eval(v); + if (whnfHead!=nameTag || whnfArgs!=1) + internal("type error in assign"); + while (isPair(v) && fst(v)==INDIRECT) { + v = arg(v); + allowBreak(); + } + snd(v) = e; /* Arrgh! impurity! */ + updapRoot(c,UNIT); +} + +primFun(primLnRead) { /* lambda nu reader */ + Cell vv = primArg(3); /* (?) :: Tag a -> (a -> Cmd d b) */ + Cell b = primArg(2); /* -> Cmd d b */ + Cell c = primArg(1); /* (Tag v ? b) c = b v c */ + eval(vv); + if (whnfHead!=nameTag || whnfArgs!=1) + internal("type error in reader"); + updapRoot(ap(b,pushed(0)),c); +} + +primFun(primLnIo) { /* lambda nu i/o */ + updapRoot(primArg(2),primArg(1)); /* io :: ((a->d)->d) -> Cmd d a */ +} /* io a c = a c */ + +primFun(primLnBegin) { /* lambda nu begin */ + updapRoot(primArg(1),nameLnNocont); /* begin :: Cmd d a -> d */ +} + +primFun(primLnTagEq) { /* lambda nu equality for Tags */ + Cell x = primArg(2); /* :: Tag a -> Tag a -> Bool */ + Cell y = primArg(1); + eval(x); + while (isPair(x) && fst(x)==INDIRECT) { + x = arg(x); + allowBreak(); + } + eval(y); + while (isPair(y) && fst(y)==INDIRECT) { + y = arg(y); + allowBreak(); + } + updateRoot(x==y ? nameTrue : nameFalse); +} + +primFun(primLnGetch) { /* get character from stdin */ + updapRoot(primArg(1),mkChar(readTerminalChar())); +} + +primFun(primLnPutchar) { /* print character on stdout */ + Cell c = primArg(1); /* putchar :: Char -> Cmd a () */ + eval(primArg(2)); /* putchar x c = c () */ + putchar(charOf(whnfHead)); + updapRoot(c,UNIT); +} + +primFun(primLnSystem) { /* do system call */ + Cell c = primArg(1); /* system :: String -> Cmd a Int*/ + String s = evalName(primArg(2)); /* system s c = c (int result) */ + Int n = s ? system(s) : 1; + updapRoot(c,mkInt(n)); +} +#endif + +#endif + +/* -------------------------------------------------------------------------- + * Build array of character conses: + * ------------------------------------------------------------------------*/ + +static Cell consCharArray[NUM_CHARS]; + +Cell consChar(c) /* return application (:) c */ +Char c; { + if (c<0) + c += NUM_CHARS; + return consCharArray[c]; +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/runtime.c b/src/runtime.c new file mode 100644 index 0000000..b6dadce --- /dev/null +++ b/src/runtime.c @@ -0,0 +1,1823 @@ +/* -------------------------------------------------------------------------- + * runtime.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer Compiler version 1.00 January 1992 + * Gofer version 2.30 March 1994 + * + * Runtime system for compiled Gofer programs ... uses a considerably + * simplified runtime system than required in the full interpreter. + * ------------------------------------------------------------------------*/ + +#define NEED_MATH +#include "gofc.h" + +#define cfunNil mkCfun(0) /* List constructors: */ +#define cfunCons mkCfun(1) + +#define cfunFalse mkCfun(0) /* Bool constructors: */ +#define cfunTrue mkCfun(1) + +/* -------------------------------------------------------------------------- + * Static data areas: + * ------------------------------------------------------------------------*/ + +static int keep_argc; /* keep record of command line */ +static char **keep_argv; /* arguments */ + +static Cell consCharArray[NUM_CHARS]; /* array of ((:) c) for each char c*/ + +static Cell resps = 0; /* pointer to list of responses */ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Cell openFile Args((String)); +static Void closeFile Args((Int)); + +#if IO_DIALOGUE +static Void readFile Args((Void)); +static Void writeFile Args((Void)); +static Void appendFile Args((Void)); +static Void readChan Args((Void)); +static Void appendChan Args((Void)); +static FILE *validOutChannel Args((String)); +static Void echo Args((Void)); +static Void getArgs Args((Void)); +static Void getProgName Args((Void)); +static Void getEnv Args((Void)); +static String evalName Args((Cell)); +#endif +static Void outputString Args((FILE *,Cell)); + +#if HASKELL_ARRAYS +static Void addAssocs Args((Cell,Int,Cell)); +static Void foldAssocs Args((Cell,Int,Cell,Cell)); +#endif + +static Int compare Args((Void)); + +static Void primInit Args((Void)); +static Void primMark Args((Void)); + +static sigProto(onBreak); + +static Void abandon Args((String)); +static Void leave Args((int)); + +/* -------------------------------------------------------------------------- + * Machine dependent code for Gofer runtime system: + * ------------------------------------------------------------------------*/ + +#define MACHDEP_RUNTIME 1 +#define internal abandon +#include "machdep.c" +#undef internal + +/* -------------------------------------------------------------------------- + * Heap storage: Provides a garbage collected heap. + * + * We currently have a choice of two garbage collectors here. You may use + * either one or substitute your own collector if you prefer. + * ------------------------------------------------------------------------*/ + +#if GC_MARKSCAN +#include "markscan.c" +#endif +#if GC_TWOSPACE +#include "twospace.c" +#endif + +/* -------------------------------------------------------------------------- + * Control stack: + * ------------------------------------------------------------------------*/ + +Cell cellStack[NUM_STACK]; /* Storage for cells on stack */ +#ifndef GLOBALsp +StackPtr sp; /* stack pointer */ +#endif + +Void overflow() { /* Report stack overflow */ + abandon("control stack overflow"); +} + +Void insufficientArgs() { /* Report insufficent args on stack*/ + abandon("insufficient arguments on stack"); +} + +/* -------------------------------------------------------------------------- + * File operations: + * ------------------------------------------------------------------------*/ + +static FILE *infiles[NUM_FILES]; /* file pointers for input files */ + +static Cell openFile(s) /* create FILECELL object for named*/ +String s; { /* input file */ + Int i; + + for (i=0; i=NUM_FILES) { /* if at first we don't */ + garbageCollect(); /* succeed, garbage collect*/ + for (i=0; i=NUM_FILES) { /* ... before we give up */ + abandon("Too many files open"); + } + + if (infiles[i]=fopen(s,"r")) { + heap(1); + return pair(FILECELL,i); + } + else + return cfunNil; +} + +static Void closeFile(n) /* close input file n */ +Int n; { /* only permitted when the */ + if (0<=n && n echo changed in dialogue*/ +static Bool stdinUsed; /* TRUE => ReadChan stdin has been */ + /* seen in dialogue */ + +Void dialogue(prog) /* carry out dialogue ... */ +Cell prog; { /* :: [Response]->[Request] */ + + echoChanged = FALSE; /* set status flags */ + stdinUsed = FALSE; + + clearStack(); + heap(3); + pushStr("Attempt to read response before request complete"); + resps = pair(primError,pop()); /* set up initial responses */ + + eval(pair(prog,resps)); + while (whnf==cfunCons) { + eval(pop()); /* evaluate the request */ + + if (whnf==cfunReadFile) /* carry out the request */ + readFile(); + else if (whnf==cfunWriteFile) + writeFile(); + else if (whnf==cfunAppendFile) + appendFile(); + else if (whnf==nameReadChan) + readChan(); + else if (whnf==cfunAppendChan) + appendChan(); + else if (whnf==cfunEcho) + echo(); + else if (whnf==cfunGetArgs) + getArgs(); + else if (whnf==cfunGetProgName) + getProgName(); + else if (whnf==cfunGetEnv) + getEnv(); + else + abandon("type error in request"); + + heap(2); + fst(resps) = pair(cfunCons,pop()); /* save response */ + snd(resps) = pair(primError,snd(resps)); + resps = snd(resps); + + eval(pop()); /* evaluate the rest of the program*/ + } + if (whnf!=cfunNil) + abandon("type error in dialogue"); +} + +/* -------------------------------------------------------------------------- + * File system requests: + * ------------------------------------------------------------------------*/ + +static Void readFile() { /* repond to ReadFile request */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + Cell f; /* pushed(1) = rest of program */ + + if (access(s,0)!=0) { /* can't find file */ + heap(2); + topfun(cfunSearchError); + topfun(cfunFailure); + } + else if (isPair(f=openFile(s))) { /* file opened? */ + pushed(0) = f; + heap(1); + topfun(cfunStr); + } + else { /* can't open file */ + heap(2); + topfun(cfunReadError); + topfun(cfunFailure); + } +} + +static Void writeFile() { /* respond to WriteFile request */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + FILE *fp; /* pushed(1) = contents */ + /* pushed(2) = rest of program */ + + if ((fp=fopen(s,FOPEN_WRITE))==0) { /* problem with output file */ + heap(2); + topfun(cfunWriteError); + topfun(cfunFailure); + slide(1,top()); + } + else { + drop(); /* discard file name */ + outputString(fp,pop()); /* output string */ + fclose(fp); /* and then close file */ + onto(cfunSuccess); + } +} + +static Void appendFile() { /* respond to AppendFile request */ + String s = evalName(pushed(0)); /* pushed(0) = file name string */ + FILE *fp; /* pushed(1) = contents */ + /* pushed(2) = rest of program */ + + if (access(s,0)!=0) { /* can't find file */ + heap(2); + topfun(cfunSearchError); + topfun(cfunFailure); + slide(1,top()); + } + else if ((fp=fopen(s,FOPEN_APPEND))==0) { + heap(2); + topfun(cfunWriteError); /* problem with output file */ + topfun(cfunFailure); + slide(1,top()); + } + else { + drop(); /* discard file name */ + outputString(fp,pop()); /* output string */ + fclose(fp); /* and then close file */ + onto(cfunSuccess); + } +} + +/* -------------------------------------------------------------------------- + * Channel system requests: + * ------------------------------------------------------------------------*/ + +static Cell primInput; /* builtin primitive function */ + +static Void readChan() { /* respond to ReadChan request */ + String s = evalName(pushed(0)); /* pushed(0) = channel name string */ + /* pushed(1) = rest of program */ + + if (strcmp(s,"stdin")!=0) { /* only valid channel == stdin */ + heap(2); + topfun(cfunSearchError); + topfun(cfunFailure); + } + else if (stdinUsed) { /* can't reuse stdin channel */ + heap(2); + topfun(cfunReadError); + topfun(cfunFailure); + } + else { /* otherwise we can read from stdin*/ + stdinUsed = 1; + pushed(0) = cfunFalse;/*dummy*/ + heap(2); + topfun(primInput); + topfun(cfunStr); + } +} + +static comb1(pr_Input) /* input from stdin primitive */ +{ Int c = readTerminalChar(); + if (c==EOF || c<0 || c>=NUM_CHARS) { + clearerr(stdin); + update(0,cfunNil); + } + else { + needStack(1); + heap(1); + pushpair(primInput,cfunNil); + updap(0,consCharArray[c<0 ? c+NUM_CHARS : c],pop()); + } + ret(); +} +End + +static comb3(pr_Fopen) /* open file for reading as str */ +{ String s = evalName(offset(3)); /* :: String->a->(String->a)->a */ + + if (s) { + Cell file = openFile(s); + if (file!=cfunNil) { + updap(0,offset(1),file); + ret(); + } + } + update(0,offset(2)); + ret(); +} +End + +static Void appendChan() { /* respond to AppendChan request */ + String s = evalName(pushed(0)); /* pushed(0) = channel name string */ + FILE *fp; /* pushed(1) = contents */ + /* pushed(2) = rest of program */ + + if ((fp=validOutChannel(s))==0) { /* problem with output channel */ + heap(2); + topfun(cfunSearchError); + topfun(cfunFailure); + slide(1,top()); + } + else { /* otherwise do output */ + drop(); + outputString(fp,pop()); + onto(cfunSuccess); + } +} + +static FILE *validOutChannel(s) /* return FILE * for valid output */ +String s; { /* channel name or 0 otherwise... */ + if (strcmp(s,"stdout")==0) + return stdout; + if (strcmp(s,"stderr")==0) + return stderr; + if (strcmp(s,"stdecho")==0) /* in Gofer, stdecho==stdout */ + return stdout; + return 0; +} + +/* -------------------------------------------------------------------------- + * Environment requests: + * ------------------------------------------------------------------------*/ + +static Void echo() { /* respond to Echo request */ + /* pushed(0) = boolean echo status */ + /* pushed(1) = rest of program */ + + if (stdinUsed) { /* stdin already used? */ + heap(3); + top() = mkString("stdin already in use"); + topfun(cfunOtherError); + topfun(cfunFailure); + } + else if (echoChanged) { /* echo previously changed? */ + heap(3); + top() = mkString("repeated Echo request"); + topfun(cfunOtherError); + topfun(cfunFailure); + } + else { /* otherwise evaluate and carry */ + eval(top()); /* out request */ + if (whnf==cfunFalse) + noechoTerminal(); + echoChanged = 1; + top() = cfunSuccess; + } +} + +static Void getArgs() { /* respond to GetArgs request */ + int i = keep_argc; + + push(cfunNil); /* build list of args in reverse */ + while (1=1 && keep_argv[0]) { /* normally, just return argv[0] */ + heap(2); + pushStr(keep_argv[0]); + topfun(cfunStr); + } + else { + heap(3); + push(cfunNil); /* return Failure (OtherError "") */ + topfun(cfunOtherError); + topfun(cfunFailure); + } +} + +static Void getEnv() { /* repond to GetEnv request */ + String s = evalName(pushed(0)); /* pushed(0) = variable name str */ + String r = getenv(s); /* pushed(1) = rest of program */ + if (r) { + heap(2); + top() = mkString(r); + topfun(cfunStr); + } + else { + heap(2); + topfun(cfunSearchError); + topfun(cfunFailure); + } +} + +/* -------------------------------------------------------------------------- + * Evaluate name, obtaining a C string from a Gofer string: + * ------------------------------------------------------------------------*/ + +static String evalName(es) /* evaluate es :: [Char] and save */ +Cell es; { /* in char array... return ptr to */ + static char buffer[FILENAME_MAX+1]; /* string or 0, if error occurs */ + Int pos = 0; + + eval(es); + while (whnf==cfunCons && pos=FILENAME_MAX) /* perhaps name was too long? */ + abandon("name too long"); + if (whnf!=cfunNil) /* check for proper end of string */ + abandon("type error in name"); + buffer[pos] = '\0'; + return buffer; +} +#endif + +/* -------------------------------------------------------------------------- + * Top-level printing mechanism: + * ------------------------------------------------------------------------*/ + +static Void outputString(fp,cs) /* Evaluate string cs and print */ +FILE *fp; /* on specified output stream fp */ +Cell cs; { + eval(cs); /* keep reducing and printing head */ + while (whnf==cfunCons) { + eval(pop()); /* evaluate character */ + fputc(charOf(whnf),fp); + /*fflush(fp);*/ + eval(pop()); /* evaluate rest of string */ + } + if (whnf!=cfunNil) /* check for proper end of string */ + abandon("type error in string"); +} + +/* -------------------------------------------------------------------------- + * Builtin primitive functions: + * ------------------------------------------------------------------------*/ + +static comb2(pr_FATBAR) /* FAIL `FATBAR` r = r */ + eval(offset(2)); /* l `FATBAR` r = l */ + update(0,offset(whnf==FAIL?1:2)); + ret(); +End + +static comb0(pr_FAIL) /* Pattern matching/guard failure */ + update(0,FAIL); + ret(); +End + +static comb0(pr_UNDEFMEM) /* undefined member */ + abandon("undefined member function"); + ret();/*not reached*/ +End + +static comb0(pr_BlackHole) /* garbage collector black hole */ + abandon("{GC black hole detected}"); + ret();/* not reached */ +End + +static comb3(pr_SEL) /* component selection */ + eval(offset(2)); /* _SEL c e n ==> nth component in */ + if (whnf==offset(3)) { /* expression e built using cfun c */ + update(0,pushed(intOf(offset(1))-1)); + } + else + abandon("pattern matching"); + ret(); +End + +static comb3(pr_IF) /* conditional primitive */ + eval(offset(3)); + if (whnf==cfunTrue) { + update(0,offset(2)); + } + else { + update(0,offset(1)); + } + ret(); +End + +static comb2(pr_STRICT) /* strict application primitive */ + eval(offset(1)); + updap(0,offset(2),offset(1)); + ret(); +End + +static comb1(pr_Error) /* error primitive */ + fputs("\nprogram error: ",stderr); + outputString(stderr,pop()); + fputc('\n',stderr); + leave(1); +End + +/* -------------------------------------------------------------------------- + * Array primitives: + * ------------------------------------------------------------------------*/ + +#if HASKELL_ARRAYS +#define getSize(bnds,rng,size) { Int lo; \ + heap(2); \ + eval(bnds); \ + eval(pop()); lo=whnfInt; \ + eval(pop()); \ + size = whnfInt - lo; \ + size = (size>=0 ? size+1 : 0); \ + } + +static Cell primUndefElt; /* undefined element primitive */ +static comb0(pr_UndefElt) + abandon("undefined array element"); + ret();/*not reached*/ +End + +static Void addAssocs(r,size,arr) /* add assocs in top() to array arr*/ +Cell r; /* using r for the range */ +Int size; /* and with size elements */ +Cell arr; { + eval(pop()); + while (whnf==cfunCons) { + ArrEltPtr pa; + eval(pop()); /* evaluate an assoc pair */ + heap(1); /* find integer position */ + topfun(r); + eval(pop()); + + if (whnfInt<0 || whnfInt>=size) /* test range */ + abandon("Array element out of bounds"); + setEltPtr(pa,arr,whnfInt); /* find elem */ + if (arrElt(pa)!=FAIL) { /* set value */ + arrElt(pa) = primUndefElt; + drop(); + } + else + arrElt(pa) = pop(); + + eval(pop()); /* evaluate rest of list */ + } +} + +static Void foldAssocs(r,size,f,arr) /* fold assocs in top() to array */ +Cell r; /* using r for the range */ +Int size; /* and with size elements */ +Cell f; /* and fold function f */ +Cell arr; { + eval(pop()); + while (whnf==cfunCons) { + ArrEltPtr pa; + eval(pop()); /* evaluate an assoc pair */ + heap(1); /* find integer position */ + topfun(r); + eval(pop()); + + if (whnfInt<0 || whnfInt>=size) /* test range */ + abandon("Array element out of bounds"); + setEltPtr(pa,arr,whnfInt); /* find elem */ + heap(2); /* apply fold */ + arrElt(pa) = pair(f,arrElt(pa)); + arrElt(pa) = pair(arrElt(pa),pop()); + + eval(pop()); /* evaluate rest of list */ + } +} + +static comb3(pr_Array) /* Array creation */ +{ Int size, i; /* :: (a -> Int) -> */ + ArrEltPtr pa; /* (a,a) -> */ + needStack(4); /* [Assoc a b] -> Array a b */ + getSize(offset(2),offset(3),size); + allocArray(size,offset(2),FAIL); /* alloc array at offset(4) */ + onto(offset(1)); /* load assocs */ + offset(1) = FAIL; /* avoid space leak */ + addAssocs(offset(3),size,offset(4)); + setEltPtr(pa,offset(4),0); + for (i=0; i Int) -> */ + ArrEltPtr pa, opa; /* Array a b -> */ + needStack(5); /* [Assoc a b] -> Array a b */ + eval(offset(2)); /* evaluate array */ + onto(whnf); /* and save at offset(4) */ + getSize(arrBnds(offset(4)),offset(3),size); + allocArray(size,arrBnds(offset(4)),FAIL); /* alloc array at offset(5)*/ + onto(offset(1)); /* load assocs */ + offset(1) = FAIL; /* avoid space leak */ + addAssocs(offset(3),size,offset(5)); + setEltPtr(opa,offset(4),0); + setEltPtr(pa, offset(5),0); + for (i=0; i Int) -> */ + needStack(4); /* (b -> c -> b) -> */ + eval(offset(2)); /* Array a b -> */ + dupArray(whnf); /* [Assoc a c] -> Array a b */ + getSize(arrBnds(top()),offset(4),size); + onto(offset(1)); /* load assocs */ + offset(1) = FAIL; /* avoid space leak */ + foldAssocs(offset(4),size,offset(3),offset(5)); + update(0,offset(5)); + ret(); +} +End + +static comb5(pr_AccumArray) /* array accumArray */ +{ Int size; /* :: (a -> Int) -> */ + needStack(4); /* (b -> c -> b) -> */ + getSize(offset(2),offset(5),size); /* b -> */ + allocArray(size,offset(2), /* (a,a) -> */ + offset(3)); /* [Assoc a c] -> Array a b*/ + onto(offset(1)); /* load assocs */ + offset(1) = FAIL; /* avoid space leak */ + foldAssocs(offset(5),size,offset(4),offset(6)); + update(0,offset(6)); + ret(); +} +End + +static comb2(pr_Amap) /* map function over array */ + needStack(3); /* :: (b -> c) -> */ + eval(offset(1)); /* Array a b -> Array a c */ + dupArray(whnf); +#define applyF(pa) heap(1); arrElt(pa)=pair(offset(2),arrElt(pa)) + arrMap(applyF,top()); +#undef applyF + update(0,top()); + ret(); +End + +static comb3(pr_Subscript) /* array subscript */ +{ ArrEltPtr pa; /* :: (a -> Int) -> */ + Int size, index; /* Array a b -> */ + Cell arr; /* a -> b */ + needStack(2); + heap(1); + pushpair(offset(3),offset(1)); + eval(pop()); + index = whnfInt; + eval(offset(2)); + arr = whnf; + getSize(arrBnds(arr),offset(3),size); + if (index<0 || index>=size) + abandon("subscript out of range"); + setEltPtr(pa,arr,index); + update(0,arrElt(pa)); + ret(); +} +End + +static comb1(pr_Bounds) /* bounds primitive */ + eval(offset(1)); /* :: Array a b -> (a,a) */ + update(0,arrBnds(whnf)); + ret(); +End + +static comb1(pr_Elems) /* elems primitive */ +{ Cell es; + needStack(2); + eval(offset(1)); + push(cfunNil); +#define addElem(pa) heap(2); pushpair(cfunCons,arrElt(pa)); mkap() + arrMap(addElem,whnf); +#undef addElem + for (es=cfunNil; isPair(top()); ) { /* reverse the list */ + Cell tmp = snd(top()); + snd(top()) = es; + es = top(); + top() = tmp; + } + update(0,es); + ret(); +} +End +#endif + +/* -------------------------------------------------------------------------- + * IO monad/lazy state threads implementation: + * ------------------------------------------------------------------------*/ + +#if IO_MONAD +static Cell primFst; /* builtin primitive functions */ +static Cell primSnd; /* for fst and snd projections */ + +#define cfunPair mkCfun(2) +#define cfunUnit mkCfun(0) + +Void iomonad(prog) /* execute program in IO monad */ +Cell prog; { + noechoTerminal(); + heap(1); + eval(pair(prog,cfunUnit)); /* run program */ + drop(); /* discard result (must be ()) */ + eval(pop()); /* force the state */ +} + +static comb1(pr_STRun) /* ST monad encapsulate */ + heap(1); /* :: all s.(ST s a) -> a */ + toparg(cfunUnit); + updap(0,primFst,top()); + ret(); +End + +static comb1(pr_Fst) /* fst primitive */ + eval(pop()); /* :: (a,s) -> a */ + update(0,offset(2)); + ret(); +End + +static comb1(pr_Snd) /* snd primitive */ + eval(pop()); /* :: (a,s) -> s */ + update(0,offset(1)); + ret(); +End + +static comb1(pr_STReturn) /* ST monad return */ + updap(0,cfunPair,offset(1)); /* :: a -> ST s a */ + ret(); +End + +static comb3(pr_IOBind) /* IO monad bind */ + heap(1); /* :: ST s a -> */ + eval(pair(offset(3),offset(1))); /* (a -> ST s b) -> */ + heap(1); /* ST s b */ + topfun(offset(2)); + updap(0,offset(5),offset(4)); + ret(); +End + +static comb3(pr_STBind) /* ST monad bind */ + needStack(3); /* :: ST s a -> */ + heap(4); /* (a -> ST s b) -> */ + pushpair(offset(3),offset(1)); /* ST s b */ + pushpair(primSnd,offset(4)); + pushpair(primFst,offset(4)); + topfun(offset(2)); + updap2(0); + ret(); +End + +static comb2(pr_STInter) /* ST monad interleave */ + needStack(1); /* :: ST s a -> ST s a */ + heap(3); + pushpair(offset(2),offset(1)); + topfun(primFst); + topfun(mkCfun(2)); + updap(0,pop(),offset(1)); + ret(); +End + +static comb2(pr_STNew) /* ST monad variable allocator */ + heap(2); /* :: a -> */ + topfun(MUTVAR); /* ST s (MutVar s a) */ + topfun(cfunPair); + eval(offset(1)); /* force evaluation of state */ + updap(0,offset(2),offset(1)); + ret(); +End + +static comb3(pr_STAssign) /* ST monad assignment */ + eval(offset(1)); /* :: MutVar s a -> */ + eval(offset(3)); /* a -> */ + snd(whnf) = offset(2); /* ST s () */ + heap(1); + needStack(1); + pushpair(cfunPair,cfunUnit); + updap(0,top(),offset(1)); + ret(); +End + +static comb2(pr_STDeref) /* ST monad dereference */ + eval(offset(1)); /* :: MutVar s a -> */ + eval(offset(2)); /* ST s a */ + heap(1); + updap(0,pair(cfunPair,snd(whnf)),offset(1)); + ret(); +End + +static comb2(pr_STMutVarEq) /* ST monad variable equality */ +{ Cell x; /* :: MutVar s a -> */ + eval(offset(2)); /* MutVar s a -> Bool */ + x = whnf; + eval(offset(1)); + update(0,(x==whnf ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb1(pr_IOGetch) /* get character from stdin */ + needStack(1); /* :: IO Char */ + eval(offset(1)); + heap(1); + updap(0,pair(cfunPair,mkChar(readTerminalChar())),offset(1)); + ret(); +End + +static comb2(pr_IOPutchar) /* print character on stdout */ + eval(offset(1)); /* :: Char -> */ + eval(offset(2)); /* IO () */ + putchar(charOf(whnf)); +#if DJGPP + fflush(stdout); +#endif + heap(1); + updap(0,pair(cfunPair,cfunUnit),offset(1)); + ret(); +End + +#if HASKELL_ARRAYS +static comb4(pr_STNewArr) /* allocate mutable array */ +{ Cell arr; /* :: (a -> Int) -> */ + Int size; /* (a,a) -> */ + needStack(2); /* b -> */ + eval(offset(1)); /* ST s (MutArr s a b) */ + getSize(offset(3),offset(4),size); + allocArray(size,offset(3),offset(2)); + heap(1); + topfun(cfunPair); + updap(0,top(),offset(1)); + ret(); +} +End + +static comb4(pr_STReadArr) /* read element in mutable array */ +{ Cell arr; /* :: ((a,a) -> a -> Int) -> */ + ArrEltPtr pa; /* MutArr s a b -> */ + needStack(2); /* a -> */ + eval(offset(1)); /* ST s b */ + eval(offset(3)); + arr = whnf; + heap(2); + pushpair(offset(4),arrBnds(arr)); + toparg(offset(2)); + eval(pop()); + setEltPtr(pa,arr,whnfInt); /* assumes index checks range */ + heap(1); + pushpair(cfunPair,arrElt(pa)); + updap(0,top(),offset(1)); + ret(); +} +End + +static comb5(pr_STWriteArr) /* write element in mutable array */ +{ Cell arr; /* :: ((a,a) -> a -> Int) -> */ + ArrEltPtr pa; /* MutArr s a b -> */ + needStack(1); /* a -> */ + eval(offset(1)); /* b -> */ + eval(offset(4)); /* ST s () */ + arr = whnf; + heap(2); + pushpair(offset(5),arrBnds(arr)); + toparg(offset(3)); + eval(pop()); + setEltPtr(pa,arr,whnfInt); /* assumes index checks range */ + arrElt(pa) = offset(2); + heap(1); + pushpair(cfunPair,cfunUnit); + updap(0,top(),offset(1)); + ret(); +} +End + +static comb2(pr_STFreeze) /* freeze mutable array */ + needStack(1); /* :: MutArr s a b -> */ + eval(offset(1)); /* ST s (Array a b) */ + eval(offset(2)); + dupArray(whnf); + heap(1); + topfun(cfunPair); + updap(0,top(),offset(1)); + ret(); +End +#endif +#endif + +/* -------------------------------------------------------------------------- + * Integer arithmetic primitives: + * ------------------------------------------------------------------------*/ + +static comb2(pr_PlusInt) /* integer addition primitive */ +{ Int x; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + heap(1); + update(0,mkInt(x+whnfInt)); + ret(); +} +End + +static comb2(pr_MinusInt) /* integer subtraction primitive */ +{ Int x; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + heap(1); + update(0,mkInt(x-whnfInt)); + ret(); +} +End + +static comb2(pr_MulInt) /* integer multiplication primitive*/ +{ Int x; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + heap(1); + update(0,mkInt(x*whnfInt)); + ret(); +} +End + +static comb2(pr_DivInt) /* integer division primitive */ +{ Int x,y; /* truncate towards -ve infinity */ + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + if (whnfInt==0) + abandon("division by zero"); + y = x%whnfInt; + x = x/whnfInt; + if ((y<0 && whnfInt>0) || (y>0 && whnfInt<0)) + x--; + heap(1); + update(0,mkInt(x)); + ret(); +} +End + +static comb2(pr_QuotInt) /* integer division primitive */ +{ Int x; /* truncated towards zero */ + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + if (whnfInt==0) + abandon("division by zero"); + heap(1); + update(0,mkInt(x/whnfInt)); + ret(); +} +End + +static comb2(pr_ModInt) /* integer modulo primitive */ +{ Int x,y; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + if (whnfInt==0) + abandon("division by zero"); + heap(1); + y = x%whnfInt; /* "... the modulo having the sign */ + if ((y<0 && whnfInt>0) || /* of the divisor ..." */ + (y>0 && whnfInt<0)) { /* See definition on p.81 of */ + update(0,mkInt(y+whnfInt)); /* Haskell report... */ + } + else { + update(0,mkInt(y)); + } + ret(); +} +End + +static comb2(pr_RemInt) /* integer remainder primitive */ +{ Int x; + eval(offset(2)); /* div and rem satisfy: */ + x = whnfInt; /* (x `div` y)*y+(x `rem` y) == x */ + eval(offset(1)); /* which is exactly the property */ + if (whnfInt==0) /* described in K&R 2: */ + abandon("division by zero"); /* (a/b)*b + a%b == a */ + heap(1); + update(0,mkInt(x%whnfInt)); + ret(); +} +End + +static comb1(pr_NegInt) /* integer negation primitive */ + eval(offset(1)); + heap(1); + update(0,mkInt(-whnfInt)); + ret(); +End + +/* -------------------------------------------------------------------------- + * Coercion primitives: + * ------------------------------------------------------------------------*/ + +static comb1(pr_CharToInt) /* character to integer conversion */ + eval(offset(1)); + heap(1); + update(0,mkInt(charOf(whnf))); + ret(); +End + +static comb1(pr_IntToChar) /* integer to character conversion */ + eval(offset(1)); + if (whnfInt<0 || whnfInt>=NUM_CHARS) + abandon("character out of range"); + update(0,mkChar(whnfInt)); + ret(); +End + +static comb1(pr_IntToFloat) /* integer to float primitive */ + eval(offset(1)); + heap(1); + update(0,mkFloat((Float)(whnfInt))); + ret(); +End + +/* -------------------------------------------------------------------------- + * Float arithmetic primitives: + * ------------------------------------------------------------------------*/ + +static comb2(pr_PlusFloat) /* float addition primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + heap(1); + update(0,mkFloat(x+floatOf(whnf))); + ret(); +} +End + +static comb2(pr_MinusFloat) /* float subtraction primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + heap(1); + update(0,mkFloat(x-floatOf(whnf))); + ret(); +} +End + +static comb2(pr_MulFloat) /* float multiplication primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + heap(1); + update(0,mkFloat(x*floatOf(whnf))); + ret(); +} +End + +static comb2(pr_DivFloat) /* float division primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + if (floatOf(whnf)==0) + abandon("float division by zero"); + heap(1); + update(0,mkFloat(x/floatOf(whnf))); + ret(); +} +End + +static comb1(pr_NegFloat) /* float negation primitive */ + eval(offset(1)); + heap(1); + update(0,mkFloat(-floatOf(whnf))); + ret(); +End + +#if HAS_FLOATS +#define FPRIM(n,f) static comb1(n) \ + eval(offset(1)); \ + heap(1); \ + update(0,safeMkFloat(f(floatOf(whnf))));\ + ret(); \ + End +FPRIM(pr_SinFloat,sin) /* floating point math prims */ +FPRIM(pr_CosFloat,cos) +FPRIM(pr_TanFloat,tan) +FPRIM(pr_AsinFloat,asin) +FPRIM(pr_AcosFloat,acos) +FPRIM(pr_AtanFloat,atan) +FPRIM(pr_LogFloat,log) /* one day, I should expand these */ +FPRIM(pr_Log10Float,log10) /* to ensure the argument is > 0 */ +FPRIM(pr_ExpFloat,exp) +FPRIM(pr_SqrtFloat,sqrt) +#undef FPRIM + +static comb2(pr_Atan2Float) /* arc tan with quadrant info */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + heap(1); + update(0,mkFloat(atan2(x,floatOf(whnf)))); + ret(); +} +End + +static comb1(pr_FloatToInt) /* convert floating point to int */ + eval(offset(1)); /* :: Float -> Int */ + heap(1); + update(0,mkInt((Int)(floatOf(whnf)))); + ret(); +End +#endif + +/* -------------------------------------------------------------------------- + * Comparison primitives: + * ------------------------------------------------------------------------*/ + +static comb2(pr_EqInt) /* integer equality primitive */ +{ Int x; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + update(0,(x==whnfInt ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb2(pr_LeInt) /* integer <= primitive */ +{ Int x; + eval(offset(2)); + x = whnfInt; + eval(offset(1)); + update(0,(x<=whnfInt ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb2(pr_EqChar) /* character equality primitive */ +{ Cell x; + eval(offset(2)); + x = whnf; + eval(offset(1)); + update(0,(x==whnf ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb2(pr_LeChar) /* character <= primitive */ +{ Cell x; + eval(offset(2)); + x = whnf; + eval(offset(1)); + update(0,(x<=whnf ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb2(pr_EqFloat) /* float equality primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + update(0,(x==floatOf(whnf) ? cfunTrue : cfunFalse)); + ret(); +} +End + +static comb2(pr_LeFloat) /* float <= primitive */ +{ Float x; + eval(offset(2)); + x = floatOf(whnf); + eval(offset(1)); + update(0,(x<=floatOf(whnf) ? cfunTrue : cfunFalse)); + ret(); +} +End + +/* -------------------------------------------------------------------------- + * Generic comparison primitives: + * + * The following primitives are provided for the benefit of anyone that + * wants to use Gofer's generic comparison functions in place of the + * type class alternative. Be warned however, that an attempt to compare + * two function values using these routines will generate a runtime error + * which will not be trapped unless you compile the runtime system and + * application with ARGCHECK=1 (in which case, the overall performance + * will degrade, even if you never actually do compare function values). + * You see, using type classes really can bring benefits ... :-) + * + * (The hardest thing in the following code is ensuring that all of the + * appropriate temporary variables stay on the stack to ensure proper + * operation of the garbage collector.) + * ------------------------------------------------------------------------*/ + +#define LT 0 +#define EQ 1 +#define GT 2 + +static Int compare() { /* Shared auxiliary function */ + StackPtr args = sp; /* for generic comparisons */ + Int xy; + + heap(2); + pushed(1) = pair(pushed(1),cfunNil);/* turn arguments into lists */ + pushed(0) = pair(pushed(0),cfunNil);/* simulating depth-first stack */ + + do { + Int xdepth, ydepth; + + eval(fst(pushed(0))); /* evaluate part of `x' */ + push(whnf); + xdepth = pushedSince(args); + + eval(fst(pushed(1+xdepth))); /* evaluate part of `y' */ + push(whnf); + ydepth = pushedSince(args) - xdepth; + + xy = xdepth+ydepth; /* discard values on top of depth- */ + pushed(xy) = snd(pushed(xy)); /* first stacks */ + pushed(xy+1) = snd(pushed(xy+1)); + + /* If the whnf of the part of x is X x1 ... xn + * and the whnf of the part of y is Y y1 ... ym, + * then the top of the stack will look like this: + * + * top() = Y \ + * y1 | + * . | ydepth elements + * . | + * ym / + * X \ + * x1 | + * . | xdepth elements + * . | + * xn / + * xs + * ys + */ + + if (isPair(top()) || isPair(pushed(ydepth))) { + if (isPair(top()) && fst(top())==FLOATCELL) { /* Floats */ + Float xf = floatOf(pushed(ydepth)); + Float yf = floatOf(top()); + if (xfyf) return GT; + } + else { /* Ints */ + Int xi = intOf(pushed(ydepth)); + Int yi = intOf(top()); + if (xiyi) return GT; + } + } + else { /* two proper constructor applics */ + if (top()>pushed(ydepth)) /* x structure has smaller constr */ + return LT; + if (top()0; --i) { /* add new values */ + pushed(xy+1) = pair(pushed(i),pushed(xy+1)); + pushed(xy) = pair(pushed(i+ydepth),pushed(xy)); + } + } + } + sp = args; + } while (isPair(top())); /* loop if value queue not empty*/ + + return EQ; /* everything matched, so x==y */ +} + +#define genericPrim(n,bool) static comb2(n) \ + { Int result = bool; \ + update(0, result?cfunTrue:cfunFalse); \ + ret(); \ + } \ + End +genericPrim(pr_GenericEq, compare()==EQ) +genericPrim(pr_GenericNe, compare()!=EQ) +genericPrim(pr_GenericLt, compare()==LT) +genericPrim(pr_GenericLe, compare()!=GT) +genericPrim(pr_GenericGt, compare()==GT) +genericPrim(pr_GenericGe, compare()!=LT) +#undef genericPrim + +/* -------------------------------------------------------------------------- + * Print primitives: + * ------------------------------------------------------------------------*/ + +static comb3(pr_ShowsInt) /* find string rep. for integer */ +{ Int num; /* :: Int -> Int -> ShowS */ + drop(); /* throw away first parameter */ + eval(pop()); + num = whnfInt; + + if (0<=num && num<10) { /* single digit */ + updap(0,consCharArray['0'+num],top()); + } + else if (num<0) { /* negative integer*/ + num = -num; + do { + heap(1); + topfun(consCharArray['0'+num%10]); + } while ((num/=10)>0); + updap(0,consCharArray['-'],top()); + } + else { /* positive integer*/ + do { + heap(1); + topfun(consCharArray['0'+num%10]); + } while ((num/=10)>9); + updap(0,consCharArray['0'+num],top()); + } + ret(); +} +End + +static comb3(pr_ShowsFloat) /* find string rep. for float */ +{ String s; /* :: Int -> Float -> ShowS */ + Int n; + drop(); /* throw away first parameter */ + eval(pop()); + s = floatToString(floatOf(whnf)); + n = strlen(s); + while (10; ) /* initialise dictionaries */ + if (dictImps[i]>=0) + if (dict[i]) + dict[i] = pair(sc[dictImps[i]],dict[i]); + else + dict[i] = primUndefMem; + + for (i=0; i0) /* add `universal quantifiers' */ + type = mkPolyType(tycon(t).kind,type); + + n = findName(textOf(c)); /* add definition to name table */ + + if (isNull(n)) + n = newName(textOf(c)); + else if (name(n).defn!=PREDEFINED) { + ERROR(tycon(t).line) + "Repeated definition for constructor function \"%s\"", + textToStr(name(n).text) + EEND; + } + + name(n).line = tycon(t).line; + name(n).arity = arity; + name(n).number = num; + name(n).type = type; + name(n).defn = CFUN; + + return n; +} + +static List local selectCtxt(ctxt,vs) /* calculate subset of context */ +List ctxt; +List vs; { + if (isNull(vs)) + return NIL; + else { + List ps = NIL; + for (; nonNull(ctxt); ctxt=tl(ctxt)) { + List us = offsetTyvarsIn(hd(ctxt),NIL); + for (; nonNull(us) && cellIsMember(hd(us),vs); us=tl(us)) + ; + if (isNull(us)) + ps = cons(hd(ctxt),ps); + } + return rev(ps); + } +} + +static Void local checkSynonyms(ts) /* check for mutually recursive */ +List ts; { /* synonyms in list of tycons ts */ + List syns = NIL; + for (; nonNull(ts); ts=tl(ts)) /* build list of all synonyms */ + if (tycon(hd(ts)).what!=DATATYPE) + syns = cons(hd(ts),syns); + while (nonNull(syns)) /* then visit each synonym */ + syns = visitSyn(NIL,hd(syns),syns); +} + +static List local visitSyn(path,t,syns) /* visit synonym definition to look*/ +List path; /* for cycles */ +Tycon t; +List syns; { + if (cellIsMember(t,path)) { /* every elt in path depends on t */ + ERROR(tycon(t).line) + "Type synonyms \"%s\" and \"%s\" are mutually recursive", + textToStr(tycon(t).text), textToStr(tycon(hd(path)).text) + EEND; + } + else { + List ds = tycon(t).kind; + List path1 = NIL; + for (; nonNull(ds); ds=tl(ds)) + if (cellIsMember(hd(ds),syns)) { + if (isNull(path1)) + path1 = cons(t,path); + syns = visitSyn(path1,hd(ds),syns); + } + } + tycon(t).defn = fullExpand(tycon(t).defn); + return removeCell(t,syns); +} + +/* -------------------------------------------------------------------------- + * Expanding out all type synonyms in a type expression: + * ------------------------------------------------------------------------*/ + +static Type local fullExpand(t) /* find full expansion of type exp */ +Type t; { /* assuming that all relevant */ + Cell h = t; /* synonym defns of lower rank have*/ + Int n = 0; /* already been fully expanded */ + for (; isAp(h); h=fun(h), n++) + arg(h) = fullExpand(arg(h)); + if (isSynonym(h) && n>=tycon(h).arity) + if (n==tycon(h).arity) + t = instantiateSyn(tycon(h).defn,t); + else { + Type p = t; + while (--n > tycon(h).arity) + p = fun(p); + fun(p) = instantiateSyn(tycon(h).defn,fun(p)); + } + return t; +} + +static Type local instantiateSyn(t,env) /* instantiate type according using*/ +Type t; /* env to determine appropriate */ +Type env; { /* values for OFFSET type vars */ + switch (whatIs(t)) { + case AP : return ap(instantiateSyn(fun(t),env), + instantiateSyn(arg(t),env)); + + case OFFSET : return nthArg(offsetOf(t),env); + + default : return t; + } +} + +static Cell local fullExpPred(p) /* find full expansion of predicate*/ +Cell p; { + Cell h = p; + while (isAp(h)) { + arg(h) = fullExpand(arg(h)); + h = fun(h); + } + return p; +} + +/* -------------------------------------------------------------------------- + * Calculate set of variables appearing in a given type expression (possibly + * qualified) as a list of distinct values. The order in which variables + * appear in the list is the same as the order in which those variables + * occur in the type expression when read from left to right. + * ------------------------------------------------------------------------*/ + +static List local typeVarsIn(type,vs) /* calculate list of type variables */ +Cell type; /* used in type expression, reading */ +List vs; { /* from left to right */ + switch (whatIs(type)) { + case AP : return typeVarsIn(snd(type), + typeVarsIn(fst(type), + vs)); + case VARIDCELL : + case VAROPCELL : return maybeAppendVar(type,vs); + + case QUAL : { List qs = fst(snd(type)); + for (; nonNull(qs); qs=tl(qs)) + vs = typeVarsIn(hd(qs),vs); + return typeVarsIn(snd(snd(type)),vs); + } + } + return vs; +} + +static List local maybeAppendVar(v,vs) /* append variable to list if not */ +Cell v; /* already included */ +List vs; { + Text t = textOf(v); + List p = NIL; + List c = vs; + + while (nonNull(c)) { + if (textOf(hd(c))==t) + return vs; + p = c; + c = tl(c); + } + + if (nonNull(p)) + tl(p) = cons(v,NIL); + else + vs = cons(v,NIL); + + return vs; +} + +/* -------------------------------------------------------------------------- + * Check for ambiguous types: + * A type Preds => type is ambiguous if not (TV(P) `subset` TV(type)) + * ------------------------------------------------------------------------*/ + +static List local offsetTyvarsIn(t,vs) /* add list of offset tyvars in t */ +Type t; /* to list vs */ +List vs; { + switch (whatIs(t)) { + case AP : return offsetTyvarsIn(fun(t),offsetTyvarsIn(snd(t),vs)); + + case OFFSET : if (cellIsMember(t,vs)) + return vs; + else + return cons(t,vs); + + case QUAL : return offsetTyvarsIn(snd(t),vs); + + default : return vs; + } +} + +Bool isAmbiguous(type) /* Determine whether type is */ +Type type; { /* ambiguous */ + if (isPolyType(type)) + type = monoTypeOf(type); + if (whatIs(type)==QUAL) { /* only qualified types can be */ + List tvps = offsetTyvarsIn(fst(snd(type)),NIL); /* ambiguous */ + List tvts = offsetTyvarsIn(snd(snd(type)),NIL); + while (nonNull(tvps) && cellIsMember(hd(tvps),tvts)) + tvps = tl(tvps); + return nonNull(tvps); + } + return FALSE; +} + +Void ambigError(line,where,e,type) /* produce error message for */ +Int line; /* ambiguity */ +String where; +Cell e; +Type type; { + ERROR(line) "Ambiguous type signature in %s", where ETHEN + ERRTEXT "\n*** ambiguous type : " ETHEN ERRTYPE(type); + ERRTEXT "\n*** assigned to : " ETHEN ERREXPR(e); + ERRTEXT "\n" + EEND; +} + +/* -------------------------------------------------------------------------- + * Type expressions appearing in type signature declarations and expressions + * also require static checking, but unlike type expressions in type decls, + * they may introduce arbitrary new type variables. The static analysis + * required here is: + * - ensure that each type constructor is defined and used with the + * correct number of arguments. + * - replace type variables by offsets, constructor names by Tycons. + * - ensure that type is well-kinded. + * ------------------------------------------------------------------------*/ + +static Type local checkSigType(line,where,e,type) +Int line; /* check validity of type expression*/ +String where; /* in explicit type signature */ +Cell e; +Type type; { + List tyvars = typeVarsIn(type,NIL); + Int n = length(tyvars); + + if (whatIs(type)==QUAL) { + map2Proc(depPredExp,line,tyvars,fst(snd(type))); + snd(snd(type)) = depTypeExp(line,tyvars,snd(snd(type))); + + if (isAmbiguous(type)) + ambigError(line,where,e,type); + } + else + type = depTypeExp(line,tyvars,type); + + if (n>0) { + if (n>=NUM_OFFSETS) { + ERROR(line) "Too many type variables in %s\n", where + EEND; + } + type = mkPolyType(mkSelect(n),type); + } + + kindSigType(line,type); /* check that type is well-kinded */ + return type; +} + +/* -------------------------------------------------------------------------- + * Static analysis of class declarations: + * + * Performed in a similar manner to that used for type declarations. + * + * The first part of the static analysis is performed as the declarations + * are read during parsing: + * - no previous definition for class + * - class name not previously used as a type constructor + * - make new entry in class table + * - determine arity of class + * - record line number of declaration + * - build list of classes defined in current script for use in later + * stages of static analysis. + * ------------------------------------------------------------------------*/ + +Void classDefn(line,head,ms) /* process new class definition */ +Int line; /* definition line number */ +Cell head; /* class header :: ([Supers],Class) */ +List ms; { /* class definition body */ + Text ct = textOf(getHead(snd(head))); + Int arity = argCount; + Class new = findClass(ct); + + if (isNull(new)) { + if (nonNull(findTycon(ct))) { + ERROR(line) "\"%s\" used as both class and type constructor", + textToStr(ct) + EEND; + } + new = newClass(ct); + } + else if (class(new).head!=PREDEFINED) { + ERROR(line) "Repeated definition of type class \"%s\"", + textToStr(ct) + EEND; + } + + class(new).arity = arity; + class(new).line = line; + class(new).head = snd(head); + class(new).supers = fst(head); + class(new).members = ms; + classDefns = cons(new,classDefns); +} + +/* -------------------------------------------------------------------------- + * Further analysis of class declarations: + * + * Full static analysis of class definitions must be postponed until the + * complete script has been read and all static analysis on type definitions + * has been completed. + * + * Once this has been achieved, we carry out the following checks on each + * class definition: + * + * - check that class header has distinct type variable arguments. + * - convert class header to predicate skeleton. + * - check that superclasses are well-formed, replace by skeletons. + * - calculate list of dependent superclasses. + * + * - split body of class into members and declarations + * - make new name entry for each member function + * - record member function number (eventually an offset into dictionary!) + * - no member function has a previous definition ... + * - no member function is mentioned more than once in the list of members + * - each member function type is valid, replace vars by offsets + * - qualify each member function type by class header + * - only bindings for members appear in defaults + * - only function bindings appear in defaults + * ------------------------------------------------------------------------*/ + +static Void local checkClassDefn(c) /* validate class definition */ +Class c; { + List tyvars = NIL; + Int args = 0; + Int i; + Cell temp; + + /* build list of type variables in class header */ + + for (temp=class(c).head; isAp(temp); temp=fun(temp)) { + if (!isVar(arg(temp))) { + ERROR(class(c).line) "Type variable required in class header" + EEND; + } + if (nonNull(varIsMember(textOf(arg(temp)),tyvars))) { + ERROR(class(c).line) + "Repeated type variable \"%s\" in class header", + textToStr(textOf(arg(temp))) + EEND; + } + tyvars = cons(arg(temp),tyvars); + args++; + } + + for (temp=class(c).head, i=args-1; i>0; temp=fun(temp), i--) + arg(temp) = mkOffset(i); + arg(temp) = mkOffset(0); + fun(temp) = c; + + tcDeps = NIL; /* find dependents */ + map2Proc(depPredExp,class(c).line,tyvars,class(c).supers); + class(c).numSupers = length(class(c).supers); + temp = class(c).members; + class(c).members = extractSigdecls(temp); + class(c).defaults = extractBindings(temp); + map2Proc(checkMems,c,tyvars,class(c).members); + class(c).sig = tcDeps; + tcDeps = NIL; +} + +static Void local depPredExp(line,tyvars,pred) +Int line; +List tyvars; +Cell pred; { + Int args = 0; + Class c; + + for (;;) { /* parser ensures # args >= 1 */ + arg(pred) = depTypeExp(line,tyvars,arg(pred)); + args++; + if (isAp(fun(pred))) + pred = fun(pred); + else + break; + } + + if (isNull(c = findClass(textOf(fun(pred))))) { + ERROR(line) "Undefined class \"%s\"", textToStr(textOf(fun(pred))) + EEND; + } + fun(pred) = c; + + if (args!=class(c).arity) { + ERROR(line) "Wrong number of arguments for class \"%s\"", + textToStr(class(c).text) + EEND; + } + + if (cellIsMember(c,classDefns) && !cellIsMember(c,tcDeps)) + tcDeps = cons(c,tcDeps); +} + +static Void local checkMems(c,tyvars,m) /* check member function details */ +Class c; +List tyvars; +Cell m; { + Int line = intOf(fst3(m)); + List vs = snd3(m); + Type t = thd3(m); + + tyvars = typeVarsIn(t,tyvars); + if (whatIs(t)==QUAL) { /* overloaded member signatures? */ + map2Proc(depPredExp,line,tyvars,fst(snd(t))); + } + else + t = ap(QUAL,pair(NIL,t)); + fst(snd(t)) = cons(class(c).head,fst(snd(t))); + snd(snd(t)) = depTypeExp(line,tyvars,snd(snd(t))); + t = mkPolyType(mkSelect(length(tyvars)),t); + + if (isAmbiguous(t)) + ambigError(line,"class declaration",hd(vs),t); + + thd3(m) = t; /* save type */ + tyvars = take(class(c).arity,tyvars); /* delete extra type vars */ +} + +static Void local addMembers(c) /* Add definitions of member funs */ +Class c; { + Int mno = 1; /* member function number */ + List mfuns = NIL; /* list of member functions */ + List ms = class(c).members; + + for (; nonNull(ms); ms=tl(ms)) { /* cycle through each sigdecl */ + Int line = intOf(fst3(hd(ms))); + List vs = rev(snd3(hd(ms))); + Type t = thd3(hd(ms)); + for (; nonNull(vs); vs=tl(vs)) + mfuns = cons(newMember(line,mno++,hd(vs),t),mfuns); + } + class(c).members = rev(mfuns); /* save list of members */ + class(c).numMembers = length(class(c).members); + class(c).defaults = classBindings("class",c,class(c).defaults); +} + +static Name local newMember(l,no,v,t) /* Make definition for member fn */ +Int l; +Int no; +Cell v; +Type t; { + Name m = findName(textOf(v)); + + if (isNull(m)) + m = newName(textOf(v)); + else if (name(m).defn!=PREDEFINED) { + ERROR(l) "Repeated definition for member function \"%s\"", + textToStr(name(m).text) + EEND; + } + + name(m).line = l; + name(m).arity = 1; + name(m).number = no; + name(m).type = t; + name(m).defn = MFUN; + + return m; +} + +/* -------------------------------------------------------------------------- + * Static analysis of instance declarations: + * + * The first part of the static analysis is performed as the declarations + * are read during parsing: + * - make new entry in instance table + * - record line number of declaration + * - build list of instances defined in current script for use in later + * stages of static analysis. + * ------------------------------------------------------------------------*/ + +Void instDefn(line,head,ms) /* process new instance definition */ +Int line; /* definition line number */ +Cell head; /* inst header :: (context,Class) */ +List ms; { /* instance members */ + Inst new = newInst(); + inst(new).line = line; + inst(new).specifics = fst(head); + inst(new).head = snd(head); + inst(new).implements = ms; + instDefns = cons(new,instDefns); +} + +/* -------------------------------------------------------------------------- + * Further static analysis of instance declarations: + * + * Makes the following checks: + * - Class part of header is a valid class expression C t1 ... tn not + * overlapping with any other instance in class C. + * - Each element of context is a valid class expression, with type vars + * drawn from the types t1,...,tn. + * - replace type vars in class header by offsets, validate all types etc. + * - All bindings are function bindings + * - All bindings define member functions for class C + * - Arrange bindings into appropriate order for member list + * - No top level type signature declarations + * ------------------------------------------------------------------------*/ + +static Void local checkInstDefn(in) /* validate instance declaration */ +Inst in; { + Int line = inst(in).line; + List tyvars = typeVarsIn(inst(in).head,NIL); + + depPredExp(line,tyvars,inst(in).head); + map2Proc(depPredExp,line,tyvars,inst(in).specifics); + inst(in).cl = getHead(inst(in).head); + kindInst(in,length(tyvars)); + inst(in).head = fullExpPred(inst(in).head); + insertInst(line,inst(in).cl,in); + inst(in).numSpecifics = length(inst(in).specifics); + + if (nonNull(extractSigdecls(inst(in).implements))) { + ERROR(line) "Type signature decls not permitted in instance decl" + EEND; + } + + inst(in).implements = classBindings("instance", + inst(in).cl, + extractBindings(inst(in).implements)); +} + +/* -------------------------------------------------------------------------- + * Process class and instance declaration binding groups: + * ------------------------------------------------------------------------*/ + +static List local classBindings(where,c,bs) +String where; /* check validity of bindings bs for*/ +Class c; /* class c (or an instance of c) */ +List bs; { /* sort into approp. member order */ + List nbs = NIL; + + for (; nonNull(bs); bs=tl(bs)) { + Cell b = hd(bs); + Name nm = newName(inventText()); /* pick name for implementation */ + Int mno; + + if (!isVar(fst(b))) { /* only allows function bindings */ + ERROR(rhsLine(snd(snd(snd(b))))) + "Pattern binding illegal in %s declaration", where + EEND; + } + + mno = memberNumber(c,textOf(fst(b))); + + if (mno==0) { + ERROR(rhsLine(snd(hd(snd(snd(b)))))) + "No member \"%s\" in class \"%s\"", + textToStr(textOf(fst(b))), + textToStr(class(c).text) + EEND; + } + + name(nm).defn = snd(snd(b)); /* save definition of implementation*/ + nbs = numInsert(mno-1,nm,nbs); + } + return nbs; +} + +static Int local memberNumber(c,t) /* return number of member function */ +Class c; /* with name t in class c */ +Text t; { /* return 0 if not a member */ + List ms = class(c).members; + for (; nonNull(ms); ms=tl(ms)) + if (t==name(hd(ms)).text) + return name(hd(ms)).number; + return 0; +} + +static List local numInsert(n,x,xs) /* insert x at nth position in xs, */ +Int n; /* filling gaps with NIL */ +Cell x; +List xs; { + List start = isNull(xs) ? cons(NIL,NIL) : xs; + + for (xs=start; 0 0" + EEND; + } + fst(fun(p)) = ADDPAT; + intValOf(fun(p)) = intOf(arg(p)); + arg(p) = checkPat(l,v); + return p; + } + + if (textOf(h)==textMult) { /* c*n pattern */ + if (!isInt(arg(fun(p)))) { + ERROR(l) "First argument in (c*n) pattern must be an integer" + EEND; + } + if (intOf(arg(fun(p)))<=1) { + ERROR(l) "Integer c in (c*n) pattern must be > 1" + EEND; + } + fst(fun(p)) = MULPAT; + intValOf(fun(p)) = intOf(arg(fun(p))); + arg(p) = checkPat(l,arg(p)); + return p; + } + } +#endif + + return checkApPat(l,0,p); +} + +static Cell local checkApPat(line,args,p) +Int line; /* check validity of application */ +Int args; /* of constructor to arguments */ +Cell p; { + switch (whatIs(p)) { + case AP : fun(p) = checkApPat(line,args+1,fun(p)); + arg(p) = checkPat(line,arg(p)); + break; + + case TUPLE : if (tupleOf(p)!=args) { + ERROR(line) "Illegal tuple pattern" + EEND; + } + break; + + case CONIDCELL : + case CONOPCELL : p = conDefined(line,textOf(p)); + checkCfunArgs(line,p,args); + break; + + case NAME : checkIsCfun(line,p); + checkCfunArgs(line,p,args); + break; + + default : ERROR(line) "Illegal pattern syntax" + EEND; + } + return p; +} + +static Void local addPatVar(line,v) /* add variable v to list of vars */ +Int line; /* in current pattern, checking for */ +Cell v; { /* repeated variables. */ + Text t = textOf(v); + List p = NIL; + List n = patVars; + + for (; nonNull(n); p=n, n=tl(n)) + if (textOf(hd(n))==t) { + ERROR(line) "Repeated variable \"%s\" in pattern", + textToStr(t) + EEND; + } + + if (isNull(p)) + patVars = cons(v,NIL); + else + tl(p) = cons(v,NIL); +} + +static Name local conDefined(line,t) /* check that t is the name of a */ +Int line; /* previously defined constructor */ +Text t; { /* function. */ + Cell c=findName(t); + if (isNull(c)) { + ERROR(line) "Undefined constructor function \"%s\"", textToStr(t) + EEND; + } + checkIsCfun(line,c); + return c; +} + +static Void local checkIsCfun(line,c) /* Check that c is a constructor fn */ +Int line; +Cell c; { + if (name(c).defn!=CFUN) { + ERROR(line) "\"%s\" is not a constructor function", + textToStr(name(c).text) + EEND; + } +} + +static Void local checkCfunArgs(line,c,args) +Int line; /* Check constructor applied with */ +Cell c; /* correct number of arguments */ +Int args; { + if (name(c).arity!=args) { + ERROR(line) "Constructor function \"%s\" needs %d args in pattern", + textToStr(name(c).text), name(c).arity + EEND; + } +} + +/* -------------------------------------------------------------------------- + * Maintaining lists of bound variables and local definitions, for + * dependency and scope analysis. + * ------------------------------------------------------------------------*/ + +static List bounds; /* list of lists of bound vars */ +static List bindings; /* list of lists of binds in scope */ +static List depends; /* list of lists of dependents */ + +#define saveBvars() hd(bounds) /* list of bvars in current scope */ +#define restoreBvars(bs) hd(bounds)=bs /* restore list of bound variables */ + +static Cell local bindPat(line,p) /* add new bound vars for pattern */ +Int line; +Cell p; { + patVars = NIL; + p = checkPat(line,p); + hd(bounds) = revOnto(patVars,hd(bounds)); + return p; +} + +static Void local bindPats(line,ps) /* add new bound vars for patterns */ +Int line; +List ps; { + patVars = NIL; + map1Over(checkPat,line,ps); + hd(bounds) = revOnto(patVars,hd(bounds)); +} + +/* -------------------------------------------------------------------------- + * Before processing value and type signature declarations, all data and + * type definitions have been processed so that: + * - all valid type constructors (with their arities) are known. + * - all valid constructor functions (with their arities and types) are + * known. + * + * The result of parsing a list of value declarations is a list of Eqns: + * Eqn ::= (SIGDECL,(Line,[Var],type)) | (Expr,Rhs) + * The ordering of the equations in this list is the reverse of the original + * ordering in the script parsed. This is a consequence of the structure of + * the parser ... but also turns out to be most convenient for the static + * analysis. + * + * As the first stage of the static analysis of value declarations, each + * list of Eqns is converted to a list of Bindings. As part of this + * process: + * - The ordering of the list of Bindings produced is the same as in the + * original script. + * - When a variable (function) is defined over a number of lines, all + * of the definitions should appear together and each should give the + * same arity to the variable being defined. + * - No variable can have more than one definition. + * - For pattern bindings: + * - Each lhs is a valid pattern/function lhs, all constructor functions + * have been defined and are used with the correct number of arguments. + * - Each lhs contains no repeated pattern variables. + * - Each equation defines at least one variable (e.g. True = False is + * not allowed). + * - Types appearing in type signatures are well formed: + * - Type constructors used are defined and used with correct number + * of arguments. + * - type variables are replaced by offsets, type constructor names + * by Tycons. + * - Every variable named in a type signature declaration is defined by + * one or more equations elsewhere in the script. + * - No variable has more than one type declaration. + * + * ------------------------------------------------------------------------*/ + +#define bindingType(b) fst(snd(b)) /* type (or types) for binding */ +#define fbindAlts(b) snd(snd(b)) /* alternatives for function binding*/ + +static List local extractSigdecls(es) /* extract the SIGDECLS from list */ +List es; { /* of equations */ + List sigDecls = NIL; /* :: [(Line,[Var],Type)] */ + + for(; nonNull(es); es=tl(es)) + if (fst(hd(es))==SIGDECL) /* type-declaration? */ + sigDecls = cons(snd(hd(es)),sigDecls); /* discard SIGDECL tag*/ + + return sigDecls; +} + +static List local extractBindings(es) /* extract untyped bindings from */ +List es; { /* given list of equations */ + Cell lastVar = NIL; /* = var def'd in last eqn (if any) */ + Int lastArity = 0; /* = number of args in last defn */ + List bs = NIL; /* :: [Binding] */ + + for(; nonNull(es); es=tl(es)) { + Cell e = hd(es); + + if (fst(e)!=SIGDECL) { + Int line = rhsLine(snd(e)); + Cell lhsHead = getHead(fst(e)); + + switch (whatIs(lhsHead)) { + case VARIDCELL : + case VAROPCELL : { /* function-binding? */ + Cell newAlt = pair(getArgs(fst(e)), snd(e)); + if (nonNull(lastVar) && textOf(lhsHead)==textOf(lastVar)) { + if (argCount!=lastArity) { + ERROR(line) + "Equations give different arities for \"%s\"", + textToStr(textOf(lhsHead)) + EEND; + } + fbindAlts(hd(bs)) = cons(newAlt,fbindAlts(hd(bs))); + } + else { + lastVar = lhsHead; + lastArity = argCount; + notDefined(line,bs,lhsHead); + bs = cons(pair(lhsHead, + pair(NIL, + singleton(newAlt))), + bs); + } + } + break; + + case CONOPCELL : + case CONIDCELL : + case FINLIST : + case TUPLE : + case UNIT : + case ASPAT : lastVar = NIL; /* pattern-binding? */ + patVars = NIL; + fst(e) = checkPat(line,fst(e)); + if (isNull(patVars)) { + ERROR(line) + "No variables defined in lhs pattern" + EEND; + } + map2Proc(notDefined,line,bs,patVars); + bs = cons(pair(patVars,pair(NIL,e)),bs); + break; + + default : ERROR(line) "Improper left hand side" + EEND; + } + } + } + return bs; +} + +static List local eqnsToBindings(es) /* Convert list of equations to list*/ +List es; { /* of typed bindings */ + List bs = extractBindings(es); + map1Proc(addSigDecl,bs,extractSigdecls(es)); + return bs; +} + +static Void local notDefined(line,bs,v)/* check if name already defined in */ +Int line; /* list of bindings */ +List bs; +Cell v; { + if (nonNull(findBinding(textOf(v),bs))) { + ERROR(line) "\"%s\" multiply defined", textToStr(textOf(v)) + EEND; + } +} + +static Cell local findBinding(t,bs) /* look for binding for variable t */ +Text t; /* in list of bindings bs */ +List bs; { + for (; nonNull(bs); bs=tl(bs)) + if (isVar(fst(hd(bs)))) { /* function-binding? */ + if (textOf(fst(hd(bs)))==t) + return hd(bs); + } + else if (nonNull(varIsMember(t,fst(hd(bs))))) /* pattern-binding? */ + return hd(bs); + return NIL; +} + +static Void local addSigDecl(bs,sigDecl)/* add type information to bindings*/ +List bs; /* :: [Binding] */ +Cell sigDecl; { /* :: (Line,[Var],Type) */ + Int line = intOf(fst3(sigDecl)); + Cell vs = snd3(sigDecl); + Cell type = checkSigType(line,"type declaration",hd(vs),thd3(sigDecl)); + + map3Proc(setType,line,type,bs,vs); +} + +static Void local setType(line,type,bs,v) +Int line; /* Set type of variable */ +Cell type; +Cell v; +List bs; { + Text t = textOf(v); + Cell b = findBinding(t,bs); + + if (isNull(b)) { + ERROR(line) "Type declaration for variable \"%s\" with no body", + textToStr(t) + EEND; + } + + if (isVar(fst(b))) { /* function-binding? */ + if (isNull(bindingType(b))) { + bindingType(b) = type; + return; + } + } + else { /* pattern-binding? */ + List vs = fst(b); + List ts = bindingType(b); + + if (isNull(ts)) + bindingType(b) = ts = copy(length(vs),NIL); + + while (nonNull(vs) && t!=textOf(hd(vs))) { + vs = tl(vs); + ts = tl(ts); + } + + if (nonNull(vs) && isNull(hd(ts))) { + hd(ts) = type; + return; + } + } + + ERROR(line) "Repeated type declaration for \"%s\"", textToStr(t) + EEND; +} + +/* -------------------------------------------------------------------------- + * To facilitate dependency analysis, lists of bindings are temporarily + * augmented with an additional field, which is used in two ways: + * - to build the `adjacency lists' for the dependency graph. Represented by + * a list of pointers to other bindings in the same list of bindings. + * - to hold strictly positive integer values (depth first search numbers) of + * elements `on the stack' during the strongly connected components search + * algorithm, or a special value mkInt(0), once the binding has been added + * to a particular strongly connected component. + * + * Using this extra field, the type of each list of declarations during + * dependency analysis is [Binding'] where: + * + * Binding' ::= (Var, (Dep, (Type, [Alt]))) -- function binding + * | ([Var], (Dep, (Type, (Pat,Rhs)))) -- pattern binding + * + * ------------------------------------------------------------------------*/ + +#define depVal(d) (fst(snd(d))) /* Access to dependency information */ + +static List local dependencyAnal(bs) /* Separate lists of bindings into */ +List bs; { /* mutually recursive groups in */ + /* order of dependency */ + + mapProc(addDepField,bs); /* add extra field for dependents */ + mapProc(depBinding,bs); /* find dependents of each binding */ + bs = bscc(bs); /* sort to strongly connected comps */ + mapProc(remDepField,bs); /* remove dependency info field */ + return bs; +} + +static List local topDependAnal(bs) /* Like dependencyAnal(), but at */ +List bs; { /* top level, reporting on progress */ + List xs; + Int i = 0; + + setGoal("Dependency analysis",(Target)(length(bs))); + mapProc(addDepField,bs); /* add extra field for dependents */ + for (xs=bs; nonNull(xs); xs=tl(xs)) { + depBinding(hd(xs)); + soFar((Target)(i++)); + } + bs = bscc(bs); /* sort to strongly connected comps */ + mapProc(remDepField,bs); /* remove dependency info field */ + done(); + return bs; +} + +static Void local addDepField(b) /* add extra field to binding to */ +Cell b; { /* hold list of dependents */ + snd(b) = pair(NIL,snd(b)); +} + +static Void local remDepField(bs) /* remove dependency field from */ +List bs; { /* list of bindings */ + mapProc(remDepField1,bs); +} + +static Void local remDepField1(b) /* remove dependency field from */ +Cell b; { /* single binding */ + snd(b) = snd(snd(b)); +} + +static Void local clearScope() { /* initialise dependency scoping */ + bounds = NIL; + bindings = NIL; + depends = NIL; +} + +static Void local withinScope(bs) /* enter scope of bindings bs */ +List bs; { + bounds = cons(NIL,bounds); + bindings = cons(bs,bindings); + depends = cons(NIL,depends); +} + +static Void local leaveScope() { /* leave scope of last withinScope */ + bounds = tl(bounds); + bindings = tl(bindings); + depends = tl(depends); +} + +/* -------------------------------------------------------------------------- + * As a side effect of the dependency analysis we also make the following + * checks: + * - Each lhs is a valid pattern/function lhs, all constructor functions + * have been defined and are used with the correct number of arguments. + * - No lhs contains repeated pattern variables. + * - Expressions used on the rhs of an eqn should be well formed. This + * includes: + * - Checking for valid patterns (including repeated vars) in lambda, + * case, and list comprehension expressions. + * - Recursively checking local lists of equations. + * - No free (i.e. unbound) variables are used in the declaration list. + * ------------------------------------------------------------------------*/ + +static Void local depBinding(b) /* find dependents of binding */ +Cell b; { + Cell defpart = snd(snd(snd(b))); /* definition part of binding */ + + hd(depends) = NIL; + + if (isVar(fst(b))) { /* function-binding? */ + mapProc(depAlt,defpart); + } + else { /* pattern-binding? */ + depRhs(snd(defpart)); + } + + depVal(b) = hd(depends); +} + +static Void local depDefaults(c) /* dependency analysis on defaults */ +Class c; { /* from class definition */ + depClassBindings(class(c).defaults); +} + +static Void local depInsts(in) /* dependency analysis on instance */ +Inst in; { /* bindings */ + depClassBindings(inst(in).implements); +} + +static Void local depClassBindings(bs) /* dependency analysis on list of */ +List bs; { /* bindings, possibly containing */ + for (; nonNull(bs); bs=tl(bs)) /* NIL bindings ... */ + if (nonNull(hd(bs))) /* No need to add extra field for */ + mapProc(depAlt,name(hd(bs)).defn); /* dependency information.. */ +} + +static Void local depAlt(a) /* find dependents of alternative */ +Cell a; { + List origBvars = saveBvars(); /* save list of bound variables */ + bindPats(rhsLine(snd(a)),fst(a)); /* add new bound vars for patterns */ + depRhs(snd(a)); /* find dependents of rhs */ + restoreBvars(origBvars); /* restore original list of bvars */ +} + +static Void local depRhs(r) /* find dependents of rhs */ +Cell r; { + switch (whatIs(r)) { + case GUARDED : mapProc(depGuard,snd(r)); + break; + + case LETREC : fst(snd(r)) = eqnsToBindings(fst(snd(r))); + withinScope(fst(snd(r))); + fst(snd(r)) = dependencyAnal(fst(snd(r))); + hd(depends) = fst(snd(r)); + depRhs(snd(snd(r))); + leaveScope(); + break; + + default : snd(r) = depExpr(intOf(fst(r)),snd(r)); + break; + } +} + +static Void local depGuard(g) /* find dependents of single guarded*/ +Cell g; { /* expression */ + depPair(intOf(fst(g)),snd(g)); +} + +static Cell local depExpr(line,e) /* find dependents of expression */ +Int line; +Cell e; { + switch (whatIs(e)) { + + case VARIDCELL : + case VAROPCELL : return depVar(line,e); + + case CONIDCELL : + case CONOPCELL : return conDefined(line,textOf(e)); + + case AP : depPair(line,e); + break; + + case NAME : + case UNIT : + case TUPLE : + case STRCELL : + case CHARCELL : + case FLOATCELL : + case INTCELL : break; + + case COND : depTriple(line,snd(e)); + break; + + case FINLIST : map1Over(depExpr,line,snd(e)); + break; + + case LETREC : fst(snd(e)) = eqnsToBindings(fst(snd(e))); + withinScope(fst(snd(e))); + fst(snd(e)) = dependencyAnal(fst(snd(e))); + hd(depends) = fst(snd(e)); + snd(snd(e)) = depExpr(line,snd(snd(e))); + leaveScope(); + break; + + case LAMBDA : depAlt(snd(e)); + break; + + case DOCOMP : + case COMP : depComp(line,snd(e),snd(snd(e))); + break; + +#if IO_MONAD + case RUNST : snd(e) = depExpr(line,snd(e)); + break; +#endif + + case ESIGN : fst(snd(e)) = depExpr(line,fst(snd(e))); + snd(snd(e)) = checkSigType(line, + "expression", + fst(snd(e)), + snd(snd(e))); + break; + + case CASE : fst(snd(e)) = depExpr(line,fst(snd(e))); + map1Proc(depCaseAlt,line,snd(snd(e))); + break; + + case ASPAT : ERROR(line) "Illegal `@' in expression" + EEND; + + case LAZYPAT : ERROR(line) "Illegal `~' in expression" + EEND; + + case WILDCARD : ERROR(line) "Illegal `_' in expression" + EEND; + + default : internal("in depExpr"); + } + return e; +} + +static Void local depPair(line,e) /* find dependents of pair of exprs*/ +Int line; +Cell e; { + fst(e) = depExpr(line,fst(e)); + snd(e) = depExpr(line,snd(e)); +} + +static Void local depTriple(line,e) /* find dependents of triple exprs */ +Int line; +Cell e; { + fst3(e) = depExpr(line,fst3(e)); + snd3(e) = depExpr(line,snd3(e)); + thd3(e) = depExpr(line,thd3(e)); +} + +static Void local depComp(l,e,qs) /* find dependents of comprehension*/ +Int l; +Cell e; +List qs; { + if (isNull(qs)) + fst(e) = depExpr(l,fst(e)); + else { + Cell q = hd(qs); + List qs1 = tl(qs); + switch (whatIs(q)) { + case FROMQUAL : { List origBvars = saveBvars(); + snd(snd(q)) = depExpr(l,snd(snd(q))); + fst(snd(q)) = bindPat(l,fst(snd(q))); + depComp(l,e,qs1); + restoreBvars(origBvars); + } + break; + + case QWHERE : snd(q) = eqnsToBindings(snd(q)); + withinScope(snd(q)); + snd(q) = dependencyAnal(snd(q)); + hd(depends) = snd(q); + depComp(l,e,qs1); + leaveScope(); + break; + + case DOQUAL : + case BOOLQUAL : snd(q) = depExpr(l,snd(q)); + depComp(l,e,qs1); + break; + } + } +} + +static Void local depCaseAlt(line,a) /* find dependents of case altern. */ +Int line; +Cell a; { + List origBvars = saveBvars(); /* save list of bound variables */ + fst(a) = bindPat(line,fst(a)); /* add new bound vars for patterns */ + depRhs(snd(a)); /* find dependents of rhs */ + restoreBvars(origBvars); /* restore original list of bvars */ +} + +static Cell local depVar(line,e) /* register occurrence of variable */ +Int line; +Cell e; { + List bounds1 = bounds; + List bindings1 = bindings; + List depends1 = depends; + Text t = textOf(e); + Cell n; + + while (nonNull(bindings1)) { + n = varIsMember(t,hd(bounds1)); /* look for t in bound variables */ + if (nonNull(n)) + return n; + + n = findBinding(t,hd(bindings1)); /* look for t in var bindings */ + if (nonNull(n)) { + if (!cellIsMember(n,hd(depends1))) + hd(depends1) = cons(n,hd(depends1)); + return (isVar(fst(n)) ? fst(n) : e); + } + + bounds1 = tl(bounds1); + bindings1 = tl(bindings1); + depends1 = tl(depends1); + } + + if (isNull(n=findName(t))) { /* check global definitions */ + ERROR(line) "Undefined variable \"%s\"", textToStr(t) + EEND; + } + + return n; +} + +/* -------------------------------------------------------------------------- + * Several parts of this program require an algorithm for sorting a list + * of values (with some added dependency information) into a list of strongly + * connected components in which each value appears before its dependents. + * + * Each of these algorithms is obtained by parameterising a standard + * algorithm in "scc.c" as shown below. + * ------------------------------------------------------------------------*/ + +#define visited(d) (isInt(DEPENDS(d))) /* binding already visited ? */ + +static Cell daSccs = NIL; +static Int daCount; + +static Int local sccMin(x,y) /* calculate minimum of x,y (unless */ +Int x,y; { /* y is zero) */ + return (x<=y || y==0) ? x : y; +} + +#define SCC2 tcscc /* make scc algorithm for Tycons */ +#define LOWLINK tclowlink +#define DEPENDS(c) (isTycon(c) ? tycon(c).kind : class(c).sig) +#define SETDEPENDS(c,v) if(isTycon(c)) tycon(c).kind=v; else class(c).sig=v +#include "scc.c" +#undef SETDEPENDS +#undef DEPENDS +#undef LOWLINK +#undef SCC2 + +#define SCC bscc /* make scc algorithm for Bindings */ +#define LOWLINK blowlink +#define DEPENDS(t) depVal(t) +#define SETDEPENDS(c,v) depVal(c)=v +#include "scc.c" +#undef SETDEPENDS +#undef DEPENDS +#undef LOWLINK +#undef SCC + +/* -------------------------------------------------------------------------- + * Main static analysis: + * ------------------------------------------------------------------------*/ + +Void checkExp() { /* Top level static check on Expr */ + staticAnalysis(RESET); + clearScope(); /* Analyse expression in the scope */ + withinScope(NIL); /* of no local bindings */ + inputExpr = depExpr(0,inputExpr); + leaveScope(); + staticAnalysis(RESET); +} + +Void checkDefns() { /* Top level static analysis */ + staticAnalysis(RESET); + + mapProc(checkTyconDefn,tyconDefns); /* validate tycon definitions */ + checkSynonyms(tyconDefns); /* check synonym definitions */ + mapProc(checkClassDefn,classDefns); /* process class definitions */ + mapProc(kindTCGroup,tcscc(tyconDefns,classDefns)); /* attach kinds */ + mapProc(addConstrs,tyconDefns); /* add definitions for constr funs */ + mapProc(addMembers,classDefns); /* add definitions for member funs */ + tyconDefns = NIL; + + mapProc(checkPrimDefn,primDefns); /* check primitive declarations */ + primDefns = NIL; + + instDefns = rev(instDefns); /* process instance definitions */ + mapProc(checkInstDefn,instDefns); + + mapProc(addRSsigdecls,typeInDefns); /* add sigdecls for RESTRICTSYN */ + valDefns = eqnsToBindings(valDefns);/* translate value equations */ + map1Proc(opDefined,valDefns,opDefns);/*check all declared ops bound */ + mapProc(allNoPrevDef,valDefns); /* check against previous defns */ + + mapProc(checkTypeIn,typeInDefns); /* check restricted synonym defns */ + + clearScope(); + withinScope(valDefns); + valDefns = topDependAnal(valDefns); /* top level dependency ordering */ + mapProc(depDefaults,classDefns); /* dep. analysis on class defaults */ + mapProc(depInsts,instDefns); /* dep. analysis on inst defns */ + leaveScope(); + + staticAnalysis(RESET); +} + +static Void local addRSsigdecls(pr) /* add sigdecls from TYPE ... IN ..*/ +Pair pr; { + List vs = snd(pr); /* get list of variables */ + for (; nonNull(vs); vs=tl(vs)) { + if (fst(hd(vs))==SIGDECL) { /* find a sigdecl */ + valDefns = cons(hd(vs),valDefns); /* add to valDefns */ + hd(vs) = hd(snd3(snd(hd(vs)))); /* and replace with var */ + } + } +} + +static Void local opDefined(bs,op) /* check that op bound in bs */ +List bs; /* (or in current module for */ +Cell op; { /* constructor functions etc...) */ + Name n; + + if (isNull(findBinding(textOf(op),bs)) + && (isNull(n=findName(textOf(op))) || !nameThisModule(n))) { + ERROR(0) "No top level definition for operator symbol \"%s\"", + textToStr(textOf(op)) + EEND; + } +} + +static Void local allNoPrevDef(b) /* ensure no previous bindings for*/ +Cell b; { /* variables in new binding */ + if (isVar(fst(b))) + noPrevDef(rhsLine(snd(hd(snd(snd(b))))),fst(b)); + else { + Int line = rhsLine(snd(snd(snd(b)))); + map1Proc(noPrevDef,line,fst(b)); + } +} + +static Void local noPrevDef(line,v) /* ensure no previous binding for */ +Int line; /* new variable */ +Cell v; { + Name n = findName(textOf(v)); + + if (isNull(n)) { + n = newName(textOf(v)); + name(n).defn = PREDEFINED; + } + else if (name(n).defn!=PREDEFINED) { + ERROR(line) "Attempt to redefine variable \"%s\"", + textToStr(name(n).text) + EEND; + } + name(n).line = line; +} + +static Void local checkTypeIn(cvs) /* Check that vars in restricted */ +Pair cvs; { /* synonym are defined, and replace*/ + Tycon c = fst(cvs); /* vars with names */ + List vs = snd(cvs); + + for (; nonNull(vs); vs=tl(vs)) + if (isNull(findName(textOf(hd(vs))))) { + ERROR(tycon(c).line) + "No top level binding of \"%s\" for restricted synonym \"%s\"", + textToStr(textOf(hd(vs))), textToStr(tycon(c).text) + EEND; + } +} + +/* -------------------------------------------------------------------------- + * Static Analysis control: + * ------------------------------------------------------------------------*/ + +Void staticAnalysis(what) +Int what; { + switch (what) { + case INSTALL : + case RESET : daSccs = NIL; + patVars = NIL; + bounds = NIL; + bindings = NIL; + depends = NIL; + tcDeps = NIL; + break; + + case MARK : mark(daSccs); + mark(patVars); + mark(bounds); + mark(bindings); + mark(depends); + mark(tcDeps); + break; + } +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/storage.c b/src/storage.c new file mode 100644 index 0000000..00a8e80 --- /dev/null +++ b/src/storage.c @@ -0,0 +1,1378 @@ +/* -------------------------------------------------------------------------- + * storage.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Primitives for manipulating global data structures + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "errors.h" +#include + +static List local insertName Args((Name,List)); +static Void local patternError Args((String)); +static Bool local stringMatch Args((String,String)); + +static Int local hash Args((String)); +static Int local saveText Args((Text)); +static Cell local markCell Args((Cell)); +static Void local markSnd Args((Cell)); +static Cell local indirectChain Args((Cell)); +static Cell local lowLevelLastIn Args((Cell)); +static Cell local lowLevelLastOut Args((Cell)); +static Void local closeFile Args((Int)); + +/* -------------------------------------------------------------------------- + * Text storage: + * + * provides storage for the characters making up identifier and symbol + * names, string literals, character constants etc... + * + * All character strings are stored in a large character array, with textHw + * pointing to the next free position. Lookup in the array is improved using + * a hash table. Internally, text strings are represented by integer offsets + * from the beginning of the array to the string in question. + * + * Where memory permits, the use of multiple hashtables gives a significant + * increase in performance, particularly when large source files are used. + * + * Each string in the array is terminated by a zero byte. No string is + * stored more than once, so that it is safe to test equality of strings by + * comparing the corresponding offsets. + * + * Special text values (beyond the range of the text array table) are used + * to generate unique `new variable names' as required. + * + * The same text storage is also used to hold text values stored in a saved + * expression. This grows downwards from the top of the text table (and is + * not included in the hash table). + * ------------------------------------------------------------------------*/ + +#define TEXTHSZ 512 /* Size of Text hash table */ +#define NOTEXT ((Text)(~0)) /* Empty bucket in Text hash table */ +static Text textHw; /* Next unused position */ +static Text savedText = NUM_TEXT; /* Start of saved portion of text */ +static Text nextNewText; /* Next new text value */ +static Text nextNewDText; /* Next new dict text value */ +static char text[NUM_TEXT]; /* Storage of character strings */ +static Text textHash[TEXTHSZ][NUM_TEXTH]; /* Hash table storage */ + +String textToStr(t) /* find string corresp to given Text*/ +Text t; { + static char newVar[16]; + + if (0<=t && t savedText) { + ERROR(0) "Character string storage space exhausted" + EEND; + } + while (text[textHw++] = *s++) + ; + if (hashno savedText) { + ERROR(0) "Character string storage space exhausted" + EEND; + } + savedText -= l+1; + strcpy(text+savedText,s); + return savedText; +} + +/* -------------------------------------------------------------------------- + * Syntax storage: + * + * Operator declarations are stored in a table which associates Text values + * with Syntax values. + * ------------------------------------------------------------------------*/ + +static Int syntaxHw; /* next unused syntax table entry */ +static struct { /* table of Text <-> Syntax values */ + Text text; + Syntax syntax; +} tabSyntax[NUM_SYNTAX]; + +Syntax syntaxOf(t) /* look up syntax of operator symbol*/ +Text t; { + int i; + + for (i=0; i=NUM_SYNTAX) { + ERROR(line) "Too many fixity declarations" + EEND; + } + + tabSyntax[syntaxHw].text = t; + tabSyntax[syntaxHw].syntax = sy; + syntaxHw++; +} + +/* -------------------------------------------------------------------------- + * Addr storage: records `next unused program location' + * ------------------------------------------------------------------------*/ + +static Addr addrHw; /* next unused program location */ + +Addr getMem(n) /* Get some more memory */ +Int n; { + Addr newAddr = addrHw; + addrHw += n; + if (addrHw>=NUM_ADDRS) { + ERROR(0) "Program code storage space exhausted" + EEND; + } + return newAddr; +} + +/* -------------------------------------------------------------------------- + * Tycon storage: + * + * A Tycon represents a user defined type constructor. Tycons are indexed + * by Text values ... a very simple hash function is used to improve lookup + * times. Tycon entries with the same hash code are chained together, with + * the most recent entry at the front of the list. + * ------------------------------------------------------------------------*/ + +#define TYCONHSZ 256 /* Size of Tycon hash table */ +#define tHash(x) ((x)%TYCONHSZ) /* Tycon hash function */ +static Tycon tyconHw; /* next unused Tycon */ +static Tycon tyconHash[TYCONHSZ]; /* Hash table storage */ + +struct Tycon tabTycon[NUM_TYCON]; /* Tycon storage */ + +Tycon newTycon(t) /* add new tycon to tycon table */ +Text t; { + Int h = tHash(t); + + if (tyconHw-TYCMIN >= NUM_TYCON) { + ERROR(0) "Type constructor storage space exhausted" + EEND; + } + tycon(tyconHw).text = t; /* clear new tycon record */ + tycon(tyconHw).kind = NIL; + tycon(tyconHw).defn = NIL; + tycon(tyconHw).what = NIL; + tycon(tyconHw).nextTyconHash = tyconHash[h]; + tyconHash[h] = tyconHw; + + return tyconHw++; +} + +Tycon findTycon(t) /* locate Tycon in tycon table */ +Text t; { + Tycon tc = tyconHash[tHash(t)]; + + while (nonNull(tc) && tycon(tc).text!=t) + tc = tycon(tc).nextTyconHash; + return tc; +} + +Tycon addPrimTycon(s,kind,ar,what,defn) /* add new primitive type constr */ +String s; +Kind kind; +Int ar; +Cell what; +Cell defn; { + Tycon tc = newTycon(findText(s)); + tycon(tc).line = 0; + tycon(tc).kind = kind; + tycon(tc).what = what; + tycon(tc).defn = defn; + tycon(tc).arity = ar; + return tc; +} + +/* -------------------------------------------------------------------------- + * Name storage: + * + * A Name represents a top level binding of a value to an identifier. + * Such values may be any one of the following: + * CFUN constructor function + * MFUN member function in class + * NIL user defined (or machine generated) compiled function + * + * Names are indexed by Text values ... a very simple hash functions speeds + * access to the table of Names and Name entries with the same hash value + * are chained together, with the most recent entry at the front of the + * list. + * ------------------------------------------------------------------------*/ + +#define NAMEHSZ 256 /* Size of Name hash table */ +#define nHash(x) ((x)%NAMEHSZ) /* Name hash function :: Text->Int */ +static Name nameHw; /* next unused name */ +static Name nameHash[NAMEHSZ]; /* Hash table storage */ + +struct Name tabName[NUM_NAME]; /* Name table storage */ + +Name newName(t) /* add new name to name table */ +Text t; { + Int h = nHash(t); + + if (nameHw-NAMEMIN >= NUM_NAME) { + ERROR(0) "Name storage space exhausted" + EEND; + } + name(nameHw).text = t; /* clear new name record */ + name(nameHw).line = 0; + name(nameHw).arity = 0; + name(nameHw).number = 0; + name(nameHw).defn = NIL; + name(nameHw).type = NIL; + name(nameHw).primDef = 0; + name(nameHw).nextNameHash = nameHash[h]; + nameHash[h] = nameHw; + + return nameHw++; +} + +Name findName(t) /* locate name in name table */ +Text t; { + Name n = nameHash[nHash(t)]; + + while (nonNull(n) && name(n).text!=t) + n = name(n).nextNameHash; + return n; +} + +Void addPrim(l,n,s,ty) /* add primitive function value */ +Int l; +Name n; +String s; +Type ty; { + Int i; + + name(n).line = l; + name(n).defn = NIL; + name(n).type = ty; + + for (i=0; primitives[i].ref; ++i) + if (strcmp(s,primitives[i].ref)==0) { + name(n).arity = primitives[i].arity; + name(n).number = i; + name(n).primDef = primitives[i].imp; + return; + } + externalPrim(n,s); +} + +Name addPrimCfun(s,arity,no,type) /* add primitive constructor func. */ +String s; +Int arity; +Int no; +Cell type; { + Name n = newName(findText(s)); + name(n).arity = arity; + name(n).number = no; + name(n).defn = CFUN; + name(n).type = type; + name(n).primDef = 0; + return n; +} + +static List local insertName(nm,ns) /* insert name nm into sorted list */ +Name nm; /* ns */ +List ns; { + Cell prev = NIL; + Cell curr = ns; + String s = textToStr(name(nm).text); + + while (nonNull(curr) && strcmp(s,textToStr(name(hd(curr)).text))>=0) { + if (hd(curr)==nm) /* just in case we get duplicates! */ + return ns; + prev = curr; + curr = tl(curr); + } + if (nonNull(prev)) { + tl(prev) = cons(nm,curr); + return ns; + } + else + return cons(nm,curr); +} + +List addNamesMatching(pat,ns) /* Add names matching pattern pat */ +String pat; /* to list of names ns */ +List ns; { /* Null pattern matches every name */ + Name nm; + for (nm=NAMEMIN; nm= *str))) + + found = TRUE; + if (*pat != ']') + patternError("missing `]'"); + if (!found) + return FALSE; + pat++; + str++; + } + break; + + case '\\' : if (*++pat == '\0') + patternError("extra trailing `\\'"); + /*fallthru!*/ + default : if (*pat++ != *str++) + return FALSE; + break; + } +} + +/* -------------------------------------------------------------------------- + * Storage of type classes, instances etc...: + * ------------------------------------------------------------------------*/ + +static Class classHw; /* next unused class */ +static Inst instHw; /* next unused instance record */ +static Idx idxHw; /* next unused index tree record */ +static Dict dictHw; /* next unused dictionary slot */ + +struct Class tabClass[NUM_CLASSES]; /* table of class records */ +struct Inst far *tabInst; /* (pointer to) table of instances */ +struct Idx far *tabIndex; /* (pointer to) table of indices */ +Cell far *tabDict; /* (pointer to) table of dict slots */ + +Class newClass(t) /* add new class to class table */ +Text t; { + if (classHw-CLASSMIN >= NUM_CLASSES) { + ERROR(0) "Class storage space exhausted" + EEND; + } + class(classHw).text = t; + class(classHw).sig = NIL; + class(classHw).head = NIL; + class(classHw).supers = NIL; + class(classHw).members = NIL; + class(classHw).defaults = NIL; + class(classHw).instances = NIL; + class(classHw).dictIndex = NOIDX; + + return classHw++; +} + +Class findClass(t) /* look for named class in table */ +Text t; { + Class c; + + for (c=CLASSMIN; c= NUM_INSTS) { + ERROR(0) "Instance storage space exhausted" + EEND; + } + inst(instHw).head = NIL; + inst(instHw).specifics = NIL; + inst(instHw).implements = NIL; + + return instHw++; +} + +Idx newIdx(test) /* Add node to index tree, with */ +Cell test; { /* specified test value */ + if (idxHw >= NUM_INDEXES) { + ERROR(0) "Index storage space exhausted" + EEND; + } + idx(idxHw).test = test; + idx(idxHw).fail = NOIDX; + idx(idxHw).match = NODICT; + + return idxHw++; +} + +Dict newDict(dictSize) /* Allocate dictionary of given size*/ +Int dictSize; { + Dict dictStarts = dictHw; + + if ((dictHw+=dictSize) > NUM_DICTS) { + ERROR(0) "Dictionary storage space exhausted" + EEND; + } + return dictStarts; +} + +/* -------------------------------------------------------------------------- + * Control stack: + * + * Various parts of the system use a stack of cells. Most of the stack + * operations are defined as macros, expanded inline. + * ------------------------------------------------------------------------*/ + +Cell cellStack[NUM_STACK]; /* Storage for cells on stack */ +#ifndef GLOBALsp +StackPtr sp; /* stack pointer */ +#endif + +Void stackOverflow() { /* Report stack overflow */ + ERROR(0) "Control stack overflow" + EEND; +} + +/* -------------------------------------------------------------------------- + * Module storage: + * + * script files are read into the system one after another. The state of + * the stored data structures (except the garbage-collected heap) is recorded + * before reading a new script. In the event of being unable to read the + * script, or if otherwise requested, the system can be restored to its + * original state immediately before the file was read. + * ------------------------------------------------------------------------*/ + +typedef struct { /* record of storage state prior to */ + Text textHw; /* reading script/module */ + Text nextNewText; + Text nextNewDText; + Int syntaxHw; + Addr addrHw; + Tycon tyconHw; + Name nameHw; + Class classHw; + Inst instHw; + Idx idxHw; + Dict dictHw; +} module; + +static Module moduleHw; /* next unused module number */ +static module modules[NUM_MODULES]; /* storage for module records */ + +Module startNewModule() { /* start new module, keeping record */ + if (moduleHw >= NUM_MODULES) { /* of status for later restoration */ + ERROR(0) "Too many script/module files in use" + EEND; + } + modules[moduleHw].textHw = textHw; + modules[moduleHw].nextNewText = nextNewText; + modules[moduleHw].nextNewDText = nextNewDText; + modules[moduleHw].syntaxHw = syntaxHw; + modules[moduleHw].addrHw = addrHw; + modules[moduleHw].tyconHw = tyconHw; + modules[moduleHw].nameHw = nameHw; + modules[moduleHw].classHw = classHw; + modules[moduleHw].instHw = instHw; + modules[moduleHw].idxHw = idxHw; + modules[moduleHw].dictHw = dictHw; + return moduleHw++; +} + +Bool nameThisModule(n) /* Test if given name is defined in*/ +Name n; { /* current module */ + return moduleHw<1 || n>=modules[moduleHw-1].nameHw; +} + +Module moduleThisName(nm) /* find module number for name */ +Name nm; { + Module m; + + for (m=0; m=modules[m].nameHw; m++) + ; + if (m>=moduleHw) + internal("moduleThisName"); + return m; +} + +Void dropModulesFrom(mno) /* Restore storage to state prior */ +Module mno; { /* to reading module mno */ + if (mno=tyconHw) + tc = tycon(tc).nextTyconHash; + tyconHash[i] = tc; + } + + for (i=0; i=nameHw) + n = name(n).nextNameHash; + nameHash[i] = n; + } + + for (i=CLASSMIN; i=idxHw) + class(i).dictIndex = NOIDX; + + while (nonNull(in)) { + List temp = tl(in); + if (hd(in)=idxHw) + idx(i).fail = NOIDX; + + moduleHw = mno; + } +} + +/* -------------------------------------------------------------------------- + * Heap storage: + * Provides a garbage collectable heap for storage of expressions etc. + * ------------------------------------------------------------------------*/ + +Int heapSize = DEFAULTHEAP; /* number of cells in heap */ +Heap heapFst; /* array of fst component of pairs */ +Heap heapSnd; /* array of snd component of pairs */ +#ifndef GLOBALfst +Heap heapTopFst; +#endif +#ifndef GLOBALsnd +Heap heapTopSnd; +#endif +Long numCells; +Int numberGcs; /* number of garbage collections */ +Int cellsRecovered; /* number of cells recovered */ + +static Cell freeList; /* free list of unused cells */ + +Cell pair(l,r) /* Allocate pair (l, r) from */ +Cell l, r; { /* heap, garbage collecting first */ + Cell c = freeList; /* if necessary ... */ + + if (isNull(c)) { + garbageCollect(); + c = freeList; + } + freeList = snd(freeList); + fst(c) = l; + snd(c) = r; + numCells++; + return c; +} + +Void overwrite(dst,src) /* overwrite dst cell with src cell*/ +Cell dst, src; { /* both *MUST* be pairs */ + if (isPair(dst) && isPair(src)) { + fst(dst) = fst(src); + snd(dst) = snd(src); + } + else + internal("overwrite"); +} + +static Int *marks; +static Int marksSize; + +Cell markExpr(c) /* External interface to markCell */ +Cell c; { + return markCell(c); +} + +static Cell local markCell(c) /* Traverse part of graph marking */ +Cell c; { /* cells reachable from given root */ + +mc: if (!isPair(c)) + return c; + + if (fst(c)==INDIRECT) { + c = indirectChain(c); + goto mc; + } + + { register place = placeInSet(c); + register mask = maskInSet(c); + if (marks[place]&mask) + return c; + else + marks[place] |= mask; + } + + if (isPair(fst(c))) { + fst(c) = markCell(fst(c)); + markSnd(c); + } + else if (isNull(fst(c)) || fst(c)>=BCSTAG) + markSnd(c); + + return c; +} + +static Void local markSnd(c) /* Variant of markCell used to */ +Cell c; { /* update snd component of cell */ + Cell t; /* using tail recursion */ + +ma: t = snd(c); +mb: if (!isPair(t)) + return; + + if (fst(t)==INDIRECT) { + snd(c) = t = indirectChain(t); + goto mb; + } + c = snd(c) = t; + + { register place = placeInSet(c); + register mask = maskInSet(c); + if (marks[place]&mask) + return; + else + marks[place] |= mask; + } + + if (isPair(fst(c))) { + fst(c) = markCell(fst(c)); + goto ma; + } + else if (isNull(fst(c)) || fst(c)>=BCSTAG) + goto ma; + return; +} + +static Cell local indirectChain(c) /* Scan chain of indirections */ +Cell c; { /* Detecting loops of indirections */ + Cell is = c; /* Uses pointer reversal ... */ + c = snd(is); + snd(is) = NIL; + fst(is) = INDIRECT1; + + while (isPair(c) && fst(c)==INDIRECT) { + register Cell temp = snd(c); + snd(c) = is; + is = c; + c = temp; + fst(is) = INDIRECT1; + } + + if (isPair(c) && fst(c)==INDIRECT1) + c = nameBlackHole; + + do { + register Cell temp = snd(is); + fst(is) = INDIRECT; + snd(is) = c; + is = temp; + } while (nonNull(is)); + + return c; +} + +Void markWithoutMove(n) /* Garbage collect cell at n, as if*/ +Cell n; { /* it was a cell ref, but don't */ + /* move cell (i.e. retain INDIRECT */ + /* at top level) so we don't have */ + /* to modify the stored value of n */ + if (isGenPair(n)) { + if (fst(n)==INDIRECT) { /* special case for indirections */ + register place = placeInSet(n); + register mask = maskInSet(n); + marks[place] |= mask; + markSnd(n); + } + else + markCell(n); /* normal pairs don't move anyway */ + } +} + +Void garbageCollect() { /* Run garbage collector ... */ + Bool breakStat = breakOn(FALSE); /* disable break checking */ + Int i,j; + register Int mask; + register Int place; + Int recovered; + jmp_buf regs; /* save registers on stack */ + setjmp(regs); + + gcStarted(); + for (i=0; i=INTMIN) return INTCELL; + + if (c>=SELMIN) if (c>=CLASSMIN) if (c>=CHARMIN) return CHARCELL; + else return CLASS; + else if (c>=INSTMIN) return INSTANCE; + else return SELECT; + else if (c>=TYCMIN) if (c>=NAMEMIN) return NAME; + else return TYCON; + else if (c>=OFFMIN) return OFFSET; + else return TUPLE; + +/* if (c>=CHARMIN) return CHARCELL; + if (c>=CLASSMIN) return CLASS; + if (c>=INSTMIN) return INSTANCE; + if (c>=SELMIN) return SELECT; + if (c>=NAMEMIN) return NAME; + if (c>=TYCMIN) return TYCON; + if (c>=OFFMIN) return OFFSET; + if (c>=TUPMIN) return TUPLE; + return c;*/ +} + +Bool isVar(c) /* is cell a VARIDCELL/VAROPCELL ? */ +Cell c; { /* also recognises DICTVAR cells */ + return isPair(c) && + (fst(c)==VARIDCELL || fst(c)==VAROPCELL || fst(c)==DICTVAR); +} + +Bool isCon(c) /* is cell a CONIDCELL/CONOPCELL ? */ +Cell c; { + return isPair(c) && (fst(c)==CONIDCELL || fst(c)==CONOPCELL); +} + +Bool isInt(c) /* cell holds integer value? */ +Cell c; { + return isSmall(c) || (isPair(c) && fst(c)==INTCELL); +} + +Int intOf(c) /* find integer value of cell? */ +Cell c; { + return isPair(c) ? (Int)(snd(c)) : (Int)(c-INTZERO); +} + +Cell mkInt(n) /* make cell representing integer */ +Int n; { + return isSmall(INTZERO+n) ? INTZERO+n : pair(INTCELL,n); +} + +/* -------------------------------------------------------------------------- + * List operations: + * ------------------------------------------------------------------------*/ + +Int length(xs) /* calculate length of list xs */ +List xs; { + Int n = 0; + for (n=0; nonNull(xs); ++n) + xs = tl(xs); + return n; +} + +List appendOnto(xs,ys) /* Destructively prepend xs onto */ +List xs, ys; { /* ys by modifying xs ... */ + if (isNull(xs)) + return ys; + else { + List zs = xs; + while (nonNull(tl(zs))) + zs = tl(zs); + tl(zs) = ys; + return xs; + } +} + +List dupList(xs) /* Duplicate spine of list xs */ +List xs; { + List ys = NIL; + for (; nonNull(xs); xs=tl(xs)) + ys = cons(hd(xs),ys); + return rev(ys); +} + +List revOnto(xs,ys) /* Destructively reverse elements of*/ +List xs, ys; { /* list xs onto list ys... */ + Cell zs; + + while (nonNull(xs)) { + zs = tl(xs); + tl(xs) = ys; + ys = xs; + xs = zs; + } + return ys; +} + +Cell varIsMember(t,xs) /* Test if variable is a member of */ +Text t; /* given list of variables */ +List xs; { + for (; nonNull(xs); xs=tl(xs)) + if (t==textOf(hd(xs))) + return hd(xs); + return NIL; +} + +Cell cellIsMember(x,xs) /* Test for membership of specific */ +Cell x; /* cell x in list xs */ +List xs; { + for (; nonNull(xs); xs=tl(xs)) + if (x==hd(xs)) + return hd(xs); + return NIL; +} + +List copy(n,x) /* create list of n copies of x */ +Int n; +Cell x; { + List xs=NIL; + while (0=n) */ +Cell e; { /* nthArg n (f x0 x1 ... xm) = xn */ + for (n=numArgs(e)-n-1; n>0; n--) + e = fun(e); + return arg(e); +} + +Int numArgs(e) /* find number of arguments to expr */ +Cell e; { + Int n; + for (n=0; isAp(e); e=fun(e)) + n++; + return n; +} + +Cell applyToArgs(f,args) /* destructively apply list of args */ +Cell f; /* to function f */ +List args; { + while (nonNull(args)) { + Cell temp = tl(args); + tl(args) = hd(args); + hd(args) = f; + f = args; + args = temp; + } + return f; +} + +/* -------------------------------------------------------------------------- + * File operations: + * ------------------------------------------------------------------------*/ + +static FILE *infiles[NUM_FILES]; /* file pointers for input files */ + +Cell openFile(s) /* create FILECELL object for named*/ +String s; { /* input file */ + Int i; + + for (i=0; i=NUM_FILES) { /* if at first we don't */ + garbageCollect(); /* succeed, garbage collect*/ + for (i=0; i=NUM_FILES) { /* ... before we give up */ + ERROR(0) "Too many files open; cannot open %s", s + EEND; + } + + if (infiles[i]=fopen(s,"r")) + return ap(FILECELL,i); + else + return NIL; +} + +Void evalFile(f) /* read char from given */ +Cell f; { /* input file -- ensure */ + Int c; /* only 1 copy of FILECELL */ + if ((c = fgetc(infiles[intValOf(f)]))==EOF) { + closeFile(intValOf(f)); + fst(f) = INDIRECT; + snd(f) = nameNil; + } + else { + snd(f) = ap(FILECELL,intValOf(f)); + fst(f) = NIL; /* avoid having 2 copies of FILECELL, so that file */ + /* is not closed prematurely by garbage collector */ + fst(f) = consChar(c); + } +} + +static Void local closeFile(n) /* close input file n */ +Int n; { /* only permitted when the */ + if (0<=n && n to */ + +/* -------------------------------------------------------------------------- + * Tuple data/type constructors: + * ------------------------------------------------------------------------*/ + +#define TUPMIN 201 +#define isTuple(c) (TUPMIN<=(c) && (c)=NUM_STACK-n) stackOverflow() +#define push(c) chkStack(1); onto(c) +#define onto(c) stack(++sp)=(c) +#define pop() stack(sp--) +#define drop() sp-- +#define top() stack(sp) +#define pushed(n) stack(sp-(n)) + +extern Void stackOverflow Args((Void)); + +/* -------------------------------------------------------------------------- + * Module control: + * The implementation of `module' storage is hidden. + * ------------------------------------------------------------------------*/ + +extern Module startNewModule Args((Void)); +extern Bool nameThisModule Args((Name)); +extern Module moduleThisName Args((Name)); +extern Void dropModulesFrom Args((Module)); + +/*-------------------------------------------------------------------------*/ diff --git a/src/subst.c b/src/subst.c new file mode 100644 index 0000000..299dde5 --- /dev/null +++ b/src/subst.c @@ -0,0 +1,622 @@ +/* -------------------------------------------------------------------------- + * subst.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Part of type checker dealing with operations on current substitution. + * ------------------------------------------------------------------------*/ + +static Void local emptySubstitution() { /* clear current substitution */ + numTyvars = 0; +#if !FIXED_SUBST + if (maxTyvars!=NUM_TYVARS) { + maxTyvars = 0; + if (tyvars) { + free(tyvars); + tyvars = 0; + } + } +#endif + nextGeneric = 0; + genericVars = NIL; + typeIs = NIL; + predsAre = NIL; +} + +static Void local expandSubst(n) /* add further n type variables to */ +Int n; { /* current substituion */ +#if FIXED_SUBST + if (numTyvars+n>NUM_TYVARS) { + ERROR(0) "Too many type variables in type checker" + EEND; + } +#else + if (numTyvars+n>maxTyvars) { /* need to expand substitution */ + Int newMax = maxTyvars+NUM_TYVARS; + Tyvar *newTvs; + Int i; + + if (numTyvars+n>newMax) { /* safety precaution */ + ERROR(0) "Substitution expanding too quickly" + EEND; + } + + /* It would be better to realloc() here, but that isn't portable + * enough for calloc()ed arrays. The following code could cause + * a space leak if an interrupt occurs while we're copying the + * array ... we won't worry about this for the time being because + * we don't expect to have to go through this process much (if at + * all) in normal use of the type checker. + */ + + newTvs = (Tyvar *)calloc(newMax,sizeof(Tyvar)); + if (!newTvs) { + ERROR(0) "Too many variables (%d) in type checker", newMax + EEND; + } + for (i=0; i0; n--) { + tyvars[numTyvars-n].offs = UNUSED_GENERIC; + tyvars[numTyvars-n].bound = NIL; + tyvars[numTyvars-n].kind = STAR; +#ifdef DEBUG_TYPES + printf("new type variable: _%d ::: ",numTyvars-n); + printKind(stdout,tyvars[numTyvars-n].kind); + putchar('\n'); +#endif + } + return beta; +} + +static Int local newKindedVars(k) /* allocate new variables with */ +Kind k; { /* specified kinds */ + Int beta = numTyvars; /* if k = k0 -> k1 -> ... -> kn */ + for (; isAp(k); k=snd(k)) { /* then allocate n vars with kinds */ + expandSubst(1); /* k0, k1, ..., k(n-1) */ + tyvars[numTyvars].offs = UNUSED_GENERIC; + tyvars[numTyvars].bound = NIL; + tyvars[numTyvars].kind = fst(k); +#ifdef DEBUG_TYPES + printf("new type variable: _%d ::: ",numTyvars); + printKind(stdout,tyvars[numTyvars].kind); + putchar('\n'); +#endif + numTyvars++; + } + return beta; +} + +#define freeTypeVars(beta) numTyvars=beta + +#define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && tyv->bound) { \ + t = tyv->bound; \ + o = tyv->offs; \ + } + +static Tyvar *local getTypeVar(t,o) /* get number of type variable */ +Type t; /* represented by (t,o) [if any]. */ +Int o; { + switch (whatIs(t)) { + case INTCELL : return tyvar(intOf(t)); + case OFFSET : return tyvar(o+offsetOf(t)); + } + return ((Tyvar *)0); +} + +static Void local tyvarType(vn) /* load type held in type variable */ +Int vn; { /* vn into (typeIs,typeOff) */ + Tyvar *tyv; + + while ((tyv=tyvar(vn))->bound) + switch(whatIs(tyv->bound)) { + case INTCELL : vn = intOf(tyv->bound); + break; + + case OFFSET : vn = offsetOf(tyv->bound)+(tyv->offs); + break; + + default : typeIs = tyv->bound; + typeOff = tyv->offs; + return; + } + typeIs = var; + typeOff = vn; +} + +static Void local bindTv(vn,t,o) /* set type variable vn to (t,o) */ +Int vn; +Type t; +Int o; { + Tyvar *tyv = tyvar(vn); + tyv->bound = t; + tyv->offs = o; +#ifdef DEBUG_TYPES + printf("binding type variable: _%d to ",vn); + printType(stdout,debugType(t,o)); + putchar('\n'); +#endif +} + +static Void local expandSyn(h,ar,at,ao) /* Expand type synonym with: */ +Tycon h; /* head h */ +Int ar; /* ar args (NB. ar>=tycon(h).arity)*/ +Type *at; /* original expression (*at,*ao) */ +Int *ao; { /* expansion returned in (*at,*ao) */ + ar -= tycon(h).arity; /* calculate surplus arguments */ + if (ar==0) + expandSyn1(h,at,ao); + else { /* if there are more args than the */ + Type t = *at; /* arity, we have to do a little */ + Int o = *ao; /* bit of work to isolate args that*/ + Type args = NIL; /* will not be changed by expansion*/ + Int i = tycon(h).arity; + Kind k = tycon(h).kind; + while (i-- > 0) /* find kind of expanded part */ + k = snd(k); + while (ar-- > 0) { /* find part to expand, and the */ + Tyvar *tyv; /* unused arguments */ + args = cons(arg(t),args); + t = fun(t); + deRef(tyv,t,o); + } + expandSyn1(h,&t,&o); /* do the expansion */ + bindTv((i=newTyvars(1)),t,o); /* and embed the results back in */ + tyvar(i)->kind = getKind(t,o); /* (*at, *ao) as required */ + *at = applyToArgs(mkInt(i),args); + } +} + +static Void local expandSyn1(h,at,ao) /* Expand type synonym with: */ +Tycon h; /* head h, tycon(h).arity args, */ +Type *at; /* original expression (*at,*ao) */ +Int *ao; { /* expansion returned in (*at,*ao) */ + Int n = tycon(h).arity; + Type t = *at; + Int o = *ao; + Tyvar *tyv; + + *at = tycon(h).defn; + *ao = newKindedVars(tycon(h).kind); + for (; 0bound) { + t = tyv->bound; + o = tyv->offs; + } + else + break; + } + return t; +} + +/* -------------------------------------------------------------------------- + * Mark type expression, so that all variables are marked as unused generics + * ------------------------------------------------------------------------*/ + +static Void local clearMarks() { /* set all unbound type vars to */ + Int i; /* unused generic variables */ + for (i=0; i= n */ + Int i; + + if (n==0) /* reset generic variables list */ + genericVars = NIL; /* most common case: reset to zero */ + else + for (i=length(genericVars); i>n; i--) + genericVars = tl(genericVars); + + for (i=0; i=GENERIC+n) + tyvars[i].offs = UNUSED_GENERIC; + nextGeneric = n; +} + +static Void local markTyvar(vn) /* mark fixed vars in type bound to*/ +Int vn; { /* given type variable */ + Tyvar *tyv = tyvar(vn); + + if (tyv->bound) + markType(tyv->bound, tyv->offs); + else + (tyv->offs) = FIXED_TYVAR; +} + +static Void local markType(t,o) /* mark fixed vars in type (t,o) */ +Type t; +Int o; { + switch (whatIs(t)) { + case TYCON : + case TUPLE : + case UNIT : + case ARROW : + case LIST : return; + + case AP : markType(fst(t),o); + markType(snd(t),o); + return; + + case OFFSET : markTyvar(o+offsetOf(t)); + return; + + case INTCELL : markTyvar(intOf(t)); + return; + + default : internal("markType"); + } +} + +/* -------------------------------------------------------------------------- + * Copy type expression from substitution to make a single type expression: + * ------------------------------------------------------------------------*/ + +static Type local copyTyvar(vn) /* calculate most general form of */ +Int vn; { /* type bound to given type var */ + Tyvar *tyv = tyvar(vn); + + if (tyv->bound) + return copyType(tyv->bound,tyv->offs); + + switch (tyv->offs) { + case FIXED_TYVAR : return mkInt(vn); + + case UNUSED_GENERIC : (tyv->offs) = GENERIC + nextGeneric++; + if (nextGeneric>=NUM_OFFSETS) { + ERROR(0) + "Too many polymorphic type variables" + EEND; + } + genericVars = cons(mkInt(vn),genericVars); + + default : return mkOffset(tyv->offs - GENERIC); + } +} + +static Type local copyType(t,o) /* calculate most general form of */ +Type t; /* type expression (t,o) */ +Int o; { + switch (whatIs(t)) { + case AP : { Type l = copyType(fst(t),o); /* ensure correct */ + Type r = copyType(snd(t),o); /* eval. order */ + return ap(l,r); + } + case OFFSET : return copyTyvar(o+offsetOf(t)); + case INTCELL : return copyTyvar(intOf(t)); + } + + return t; +} + +#ifdef DEBUG_TYPES +static Type local debugTyvar(vn) /* expand type structure in full */ +Int vn; { /* detail */ + Tyvar *tyv = tyvar(vn); + + if (tyv->bound) + return debugType(tyv->bound,tyv->offs); + return mkInt(vn); +} + +static Type local debugType(t,o) +Type t; +Int o; { + switch (whatIs(t)) { + case AP : { Type l = debugType(fst(t),o); + Type r = debugType(snd(t),o); + return ap(l,r); + } + case OFFSET : return debugTyvar(o+offsetOf(t)); + case INTCELL : return debugTyvar(intOf(t)); + } + + return t; +} +#endif /*DEBUG_TYPES*/ + +/* -------------------------------------------------------------------------- + * Occurs check: + * ------------------------------------------------------------------------*/ + +static Tyvar *lookingFor; /* var to look for in occurs check */ + +static Bool local doesntOccurIn(t,o) /* Return TRUE if var lookingFor */ +Type t; /* isn't referenced in (t,o) */ +Int o; { + Tyvar *tyv; + + for (;;) { + deRef(tyv,t,o); + if (tyv) /* type variable */ + return tyv!=lookingFor; + else if (isAp(t)) { /* application */ + if (doesntOccurIn(snd(t),o)) + t = fst(t); + else + return FALSE; + } + else /* no variable found */ + break; + } + return TRUE; +} + +/* -------------------------------------------------------------------------- + * Unification algorithm: + * ------------------------------------------------------------------------*/ + +static char *unifyFails = 0; /* unification error message */ +static Bool matchMode = FALSE; /* set to TRUE to prevent binding */ + /* during matching process */ + +static Bool local varToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2 */ +Tyvar *tyv1, *tyv2; { + if (tyv1!=tyv2) + if (matchMode) + return FALSE; + else { + if (!eqKind(tyv1->kind,tyv2->kind)) { + unifyFails = "constructor variable kinds do not match"; + return FALSE; + } + tyv1->bound = var; + tyv1->offs = tyvNum(tyv2); +#ifdef DEBUG_TYPES + printf("vv binding tyvar: _%d to _%d\n",tyvNum(tyv1),tyvNum(tyv2)); +#endif + } + return TRUE; +} + +static Bool local varToTypeBind(tyv,t,o)/* Make binding tyv := (t,o) */ +Tyvar *tyv; +Type t; /* guaranteed not to be a v'ble or */ +Int o; { /* have synonym as outermost constr*/ + if (!matchMode) { + lookingFor = tyv; + if (doesntOccurIn(t,o)) { + if (!eqKind(tyv->kind,getKind(t,o))) { + unifyFails = "constructor variable kinds do not match"; + return FALSE; + } + tyv->bound = t; + tyv->offs = o; +#ifdef DEBUG_TYPES + printf("vt binding type variable: _%d to ",tyvNum(tyv)); + printType(stdout,debugType(t,o)); + putchar('\n'); +#endif + return TRUE; + } + } + unifyFails = "unification would give infinite type"; + return FALSE; /* INFINITE TYPE (or failed match in matchMode) */ +} + +static Bool local kvarToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2 */ +Tyvar *tyv1, *tyv2; { /* for kind variable bindings */ + if (tyv1!=tyv2) { + tyv1->bound = var; + tyv1->offs = tyvNum(tyv2); + } + return TRUE; +} + +static Bool local kvarToTypeBind(tyv,t,o)/* Make binding tyv := (t,o) */ +Tyvar *tyv; /* for kind variable bindings */ +Type t; /* guaranteed not to be a v'ble or */ +Int o; { /* have synonym as outermost constr*/ + lookingFor = tyv; + if (doesntOccurIn(t,o)) { + tyv->bound = t; + tyv->offs = o; + return TRUE; + } + unifyFails = "unification would give infinite kind"; + return FALSE; +} + +static Bool local unify(t1,o1,t2,o2) /* Main unification routine */ +Type t1,t2; /* unify (t1,o1) with (t2,o2) */ +Int o1,o2; { + Tyvar *tyv1, *tyv2; + + deRef(tyv1,t1,o1); + deRef(tyv2,t2,o2); + +un: if (tyv1) + if (tyv2) + return varToVarBind(tyv1,tyv2); /* t1, t2 variables */ + else { + Cell h2 = getDerefHead(t2,o2); /* t1 variable, t2 not */ + if (isSynonym(h2) && argCount>=tycon(h2).arity) { + expandSyn(h2,argCount,&t2,&o2); + deRef(tyv2,t2,o2); + goto un; + } + return varToTypeBind(tyv1,t2,o2); + } + else + if (tyv2) { + Cell h1 = getDerefHead(t1,o1); /* t2 variable, t1 not */ + if (isSynonym(h1) && argCount>=tycon(h1).arity) { + expandSyn(h1,argCount,&t1,&o1); + deRef(tyv1,t1,o1); + goto un; + } + return varToTypeBind(tyv2,t1,o1); + } + else { /* t1, t2 not vars */ + Type h1 = getDerefHead(t1,o1); + Int a1 = argCount; + Type h2 = getDerefHead(t2,o2); + Int a2 = argCount; + +#ifdef DEBUG_TYPES + printf("tt unifying types: "); + printType(stdout,debugType(t1,o1)); + printf(" with "); + printType(stdout,debugType(t2,o2)); + putchar('\n'); +#endif + + if (isOffset(h1) || isInt(h1)) h1=NIL; /* represent var by NIL*/ + if (isOffset(h2) || isInt(h2)) h2=NIL; + + if (nonNull(h1) && h1==h2) {/* Assuming well-formed types, both*/ + if (a1!=a2) { /* t1, t2 must have same no of args*/ + unifyFails = "incompatible constructors"; + return FALSE; + } + while (isAp(t1)) { + if (!unify(arg(t1),o1,arg(t2),o2)) + return FALSE; + t1 = fun(t1); + deRef(tyv1,t1,o1); + t2 = fun(t2); + deRef(tyv2,t2,o2); + } + unifyFails = 0; + return TRUE; + } + + /* Types do not match -- look for type synonyms to expand */ + + if (isSynonym(h1) && a1>=tycon(h1).arity) { + expandSyn(h1,a1,&t1,&o1); + deRef(tyv1,t1,o1); + goto un; + } + if (isSynonym(h2) && a2>=tycon(h2).arity) { + expandSyn(h2,a2,&t2,&o2); + deRef(tyv2,t2,o2); + goto un; + } + + if ((isNull(h1) && a1<=a2) || /* last attempt -- maybe */ + (isNull(h2) && a2<=a1)) { /* one head is a variable? */ + for (;;) { + deRef(tyv1,t1,o1); + deRef(tyv2,t2,o2); + + if (tyv1) /* unify heads! */ + if (tyv2) + return varToVarBind(tyv1,tyv2); + else + return varToTypeBind(tyv1,t2,o2); + else if (tyv2) + return varToTypeBind(tyv2,t1,o1); + + /* at this point, neither t1 nor t2 is a variable. In */ + /* addition, they must both be APs unless one of the */ + /* head variables has been bound during unification of */ + /* the arguments. */ + + if (!isAp(t1) || !isAp(t2)) { /* might not be APs*/ + unifyFails = 0; + return t1==t2; + } + if (!unify(arg(t1),o1,arg(t2),o2)) /* o/w must be APs */ + return FALSE; + t1 = fun(t1); + t2 = fun(t2); + } + } + } + unifyFails = 0; + return FALSE; +} + +static Bool local sameType(t1,o1,t2,o2)/* Compare types without binding */ +Type t1,t2; +Int o1,o2; { + Bool result; + matchMode = TRUE; + result = unify(t1,o1,t2,o2); + matchMode = FALSE; + return result; +} + +Bool typeMatches(type,mt) /* test if type matches monotype mt*/ +Type type, mt; { + Bool result; + if (isPolyType(type) || whatIs(type)==QUAL) + return FALSE; + typeChecker(RESET); + matchMode = TRUE; + result = unify(mt,0,type,0); + matchMode = FALSE; + typeChecker(RESET); + return result; +} + +/* -------------------------------------------------------------------------- + * Unify kind expressions: + * ------------------------------------------------------------------------*/ + +static Bool local kunify(k1,o1,k2,o2) /* Unify kind expr (k1,o1) with */ +Kind k1,k2; /* (k2,o2) */ +Int o1,o2; { + Tyvar *kyv1, *kyv2; + + deRef(kyv1,k1,o1); + deRef(kyv2,k2,o2); + + if (kyv1) + if (kyv2) + return kvarToVarBind(kyv1,kyv2); /* k1, k2 variables */ + else + return kvarToTypeBind(kyv1,k2,o2); /* k1 variable, k2 not */ + else + if (kyv2) + return kvarToTypeBind(kyv2,k1,o1); /* k2 variable, k1 not */ + else + if (k1==STAR && k2==STAR) /* k1, k2 not vars */ + return TRUE; + else if (isAp(k1) && isAp(k2)) + return kunify(fst(k1),o1,fst(k2),o2) && + kunify(snd(k1),o1,snd(k2),o2); + unifyFails = 0; + return FALSE; +} + +/*-------------------------------------------------------------------------*/ diff --git a/src/timer.c b/src/timer.c new file mode 100644 index 0000000..fe64e54 --- /dev/null +++ b/src/timer.c @@ -0,0 +1,47 @@ +/* This file provides a simple mechanism for measuring elapsed time + * on Unix based machines (more precisely, on any machine with a + * rusage() function). + * + * It is included in the Gofer distribution for the purpose of + * benchmarking the Gofer interpreter, comparing its performance + * across a variety of different machines, and with other systems + * for similar languages. + * + * To make use of these functions, simply add -DWANT_TIMER to the + * CFLAGS line in the Makefile, before compiling Gofer. + * + * It would be somewhat foolish to try to use the timings produced + * in this way for anything other than the purpose described above. + * In particular, using timings to compare the performance of different + * versions of an algorithm is likely to give very misleading results. + * The current implementation of Gofer as an interpreter, without any + * significant optimizations, means that there are much more significant + * overheads than can be accounted for by small variations in Gofer + * code. + */ + +#include +#include + +long userElapsed, systElapsed; + +void updateTimers() { + static long lastUser = 0; + static long lastSyst = 0; + long curr; + struct rusage ruse; + getrusage(RUSAGE_SELF,&ruse); + + curr = ruse.ru_utime.tv_sec*1000000L + ruse.ru_utime.tv_usec; + userElapsed = curr - lastUser; + lastUser = curr; + + curr = ruse.ru_stime.tv_sec*1000000L + ruse.ru_stime.tv_usec; + systElapsed = curr - lastSyst; + lastSyst = curr; +} + +long millisecs(t) +long t; { + return (t+500)/1000; +} diff --git a/src/twospace.c b/src/twospace.c new file mode 100644 index 0000000..989a0a5 --- /dev/null +++ b/src/twospace.c @@ -0,0 +1,240 @@ +/* -------------------------------------------------------------------------- + * twospace.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * Two space copying GC, optionally used for gofc runtime system. + * ------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Simple twospace copying collector: + * ------------------------------------------------------------------------*/ + +static Void heapInit Args((Void)); +static Void markPhase Args((Void)); +static Cell forward Args((Cell)); +static Cell copyCell Args((Cell)); +static Cell copyArray Args((Cell)); + +Int heapSize = DEFAULTHEAP; /* number of cells in heap */ +static Heap space1,space2; /* the two heap spaces */ +#ifndef GLOBALcar +Heap from; /* (top of) current from space */ +#endif +static Heap to; /* (top of) current to space */ +#ifndef GLOBALcdr +Cell hp; /* current heap pointer */ +#endif +static Bool fileUsed[NUM_FILES]; /* file in use flags */ +#define mark(c) c=forward(c) /* mark graph and save new pointer */ + +static Void heapInit() { /* initialise heap storage */ + space1 = (Heap)(farCalloc(heapSize,sizeof(Cell))); + space2 = (Heap)(farCalloc(heapSize,sizeof(Cell))); + if (space1==(Heap)0 || space2==(Heap)0) + abandon("Cannot allocate heap storage"); + from = space1 + heapSize; + to = space2 + heapSize; + hp = -heapSize-1; +} + +#if !INLINE_ALLOC /* allocation (not inlined) gives */ +Cell pair(l,r) /* smaller object code size, but */ +Cell l,r; { /* with a small hit on speed. */ + from[++hp] = l; + from[++hp] = r; + return (hp-1); +} +#endif + +Void garbageCollect() { /* garbage collector */ + register Cell toIn = -heapSize-1; + Heap swap; + Int i; + hp = toIn; + + for (i=0; i0; --n) { + ++toIn; + to[toIn] = forward(to[toIn]); + } + } + else if (isPair(tag)) { /* must be application node */ + to[toIn] = forward(tag); + ++toIn; /* to another cell */ + to[toIn] = forward(to[toIn]); + } + else if (tag>MAXBOXTAG) { /* application of unboxed value */ + ++toIn; /* to another cell */ + to[toIn] = forward(to[toIn]); + } + else /* tagged cell - value already */ + ++toIn; /* copied across */ + } + if (hp+1000>=0) + abandon("Garbage collection fails to reclaim sufficient space"); + + for (i=0; i tospace */ +Cell c; { +#if SMALL_GOFER + to[++hp] = from[c]; /* not worth the trouble of a reg */ + from[c] = FORWARD; /* assignment for far pointers */ + to[++hp] = from[c+1]; + from[c+1] = hp-1; + return hp-1; +#else + register Cell *fp = from+c; + to[++hp] = *fp; /* don't need to check for heap */ + *fp++ = FORWARD; /* overflow since no halfspace can */ + to[++hp] = *fp; /* be bigger that the other! */ + return (*fp = hp-1); +#endif +} + +static Cell copyArray(c) /* copy array fromspace --> tospace*/ +Cell c; { + Cell fc; + Int n; +#if SMALL_GOFER + to[++hp] = ARRAY; /* not worth the trouble of a reg */ + from[c] = FORWARD; /* assignment for far pointers */ + fc = hp; + n = /* get length of array */ + to[++hp] = from[c+1]; + from[c+1] = fc; + while (n-- > 0) + to[++hp] = from[c+1+n]; +#else + register Cell *fp = from+c; + to[++hp] = ARRAY; /* don't need to check for heap */ + *fp++ = FORWARD; /* overflow since no halfspace can */ + fc = hp; /* be bigger that the other! */ + n = + to[++hp] = *fp; + *fp++ = fc; + while (n-- > 0) + to[++hp] = *fp++; +#endif + return fc; +} + +/* -------------------------------------------------------------------------- + * Arrays (implemented by contiguous arrays of cells): + * ------------------------------------------------------------------------*/ + +#if HASKELL_ARRAYS +Void allocArray(n,bds,z) /* allocate array of cells */ +Int n; /* n = length of array (assume>=0) */ +Cell bds; /* bds = bounds */ +Cell z; { /* z = default value */ + heap((n+3)); /* currently checks for twice the */ + /* actual requirement ... */ + from[++hp] = ARRAY; + push(hp); + from[++hp] = n+1; + from[++hp] = bds; + for (; n>0; --n) + from[++hp] = z; +} + +Void dupArray(a) /* duplicate array */ +Cell a; { + Int n = from[++a]; + heap((n+2)); /* also checks for twice as much */ + /* as is strictly necessary */ + from[++hp] = ARRAY; + push(hp); + from[++hp] = n; + for (; n>0; --n) + from[++hp] = from[++a]; +} + +#endif + +/*-------------------------------------------------------------------------*/ diff --git a/src/type.c b/src/type.c new file mode 100644 index 0000000..07043f1 --- /dev/null +++ b/src/type.c @@ -0,0 +1,2003 @@ +/* -------------------------------------------------------------------------- + * type.c: Copyright (c) Mark P Jones 1991-1994. All rights reserved. + * See goferite.h for details and conditions of use etc... + * Gofer version 2.30 March 1994 + * + * This is the Gofer type checker: Based on the extended algorithm in my + * PRG technical report PRG-TR-10-91, supporting the use of qualified types + * in the form of multi-parameter type classes, according to my `new + * approach' to type classes posted to the Haskell mailing list. + * This program uses the optimisations for constant and locally-constant + * overloading. + * ------------------------------------------------------------------------*/ + +#include "prelude.h" +#include "storage.h" +#include "connect.h" +#include "errors.h" + +/*#define DEBUG_TYPES*/ +/*#define DEBUG_KINDS*/ + +Bool coerceNumLiterals = FALSE; /* TRUE => insert fromInteger calls*/ + /* etc for numeric literals*/ +Bool catchAmbigs = FALSE; /* TRUE => functions with ambig. */ + /* types produce error */ +Bool overSingleton = TRUE; /* TRUE => overload singleton list */ + /* notation, [x] */ + +Type typeString, typeBool; /* Important primitive types */ +Type typeInt, typeChar; +Type typeFloat; + +Name nameTrue, nameFalse; /* primitive boolean constructors */ +Name nameNil, nameCons; /* primitive list constructors */ + +#if IO_DIALOGUE +Type typeDialogue; +Name nameReadFile, nameWriteFile; /* I/O name primitives */ +Name nameAppendFile, nameReadChan; +Name nameAppendChan, nameEcho; +Name nameGetArgs, nameGetProgName; +Name nameGetEnv; +Name nameSuccess, nameStr; +Name nameFailure, nameStrList; +Name nameWriteError; +Name nameReadError, nameSearchError; +Name nameFormatError, nameOtherError; +#endif + +#if IO_MONAD +Type typeIO, typeProgIO; /* for the IO monad, IO and IO () */ +Type typeWorld, typeST; /* built on top of IO = ST World */ +Type typeMutVar; +#if HASKELL_ARRAYS +Type typeMutArr; +#endif +#endif + +#if HASKELL_ARRAYS +Type typeArray; +#endif + +#ifdef LAMBDAVAR +static Type typeProc, typeVar; /* primitive Proc and Var types */ +Name nameVar; /* primitive Var constructor */ +Type typeProg; /* program Proc () */ +#endif + +#ifdef LAMBDANU +static Type typeCmd, typeTag; /* primitive Cmd and Tag types */ +Name nameTag; /* primitive Tag constructor */ +Type typeLnProg; /* program Cmd a () */ +#endif + +/* -------------------------------------------------------------------------- + * Data structures for storing a substitution: + * + * For various reasons, this implementation uses structure sharing, instead of + * a copying approach. In principal, this is fast and avoids the need to + * build new type expressions. Unfortunately, this implementation will not + * be able to handle *very* large expressions. + * + * The substitution is represented by an array of type variables each of + * which is a triple: + * bound a (skeletal) type expression, or NIL if the variable + * is not bound. + * offs offset of skeleton in bound. If isNull(bound), then offs is + * used to indicate whether that variable is generic (i.e. free + * in the current assumption set) or fixed (i.e. bound in the + * current assumption set). Generic variables are assigned + * offset numbers whilst copying type expressions (t,o) to + * obtain their most general form. + * kind kind of value bound to type variable (`type variable' is + * rather inaccurate -- `constructor variable' would be better). + * ------------------------------------------------------------------------*/ + +typedef struct { /* Each type variable contains: */ + Type bound; /* A type skeleton (unbound==NIL) */ + Int offs; /* Offset for skeleton */ + Kind kind; /* kind annotation */ +} Tyvar; + +static Int numTyvars; /* no. type vars currently in use */ +#if FIXED_SUBST +static Tyvar tyvars[NUM_TYVARS]; /* storage for type variables */ +#else +static Tyvar *tyvars = 0; /* storage for type variables */ +static Int maxTyvars = 0; +#endif +static Int typeOff; /* offset of result type */ +static Type typeIs; /* skeleton of result type */ +static List predsAre; /* list of predicates in type */ +#define tyvar(n) (tyvars+(n)) /* nth type variable */ +#define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */ +static Int nextGeneric; /* number of generics found so far */ +static List genericVars; /* list of generic vars */ + + /* offs values when isNull(bound): */ +#define FIXED_TYVAR 0 /* fixed in current assumption */ +#define UNUSED_GENERIC 1 /* not fixed, not yet encountered */ +#define GENERIC 2 /* GENERIC+n==nth generic var found*/ + +/* -------------------------------------------------------------------------- + * Local function prototypes: + * ------------------------------------------------------------------------*/ + +static Void local emptySubstitution Args((Void)); +static Void local expandSubst Args((Int)); +static Int local newTyvars Args((Int)); +static Int local newKindedVars Args((Kind)); +static Tyvar *local getTypeVar Args((Type,Int)); +static Void local tyvarType Args((Int)); +static Void local bindTv Args((Int,Type,Int)); +static Void local expandSyn Args((Tycon, Int, Type *, Int *)); +static Void local expandSyn1 Args((Tycon, Type *, Int *)); +static Cell local getDerefHead Args((Type,Int)); + +static Void local clearMarks Args((Void)); +static Void local resetGenericsFrom Args((Int)); +static Void local markTyvar Args((Int)); +static Void local markType Args((Type,Int)); + +static Type local copyTyvar Args((Int)); +static Type local copyType Args((Type,Int)); +#ifdef DEBUG_TYPES +static Type local debugTyvar Args((Int)); +static Type local debugType Args((Type,Int)); +#endif + +static Bool local doesntOccurIn Args((Type,Int)); + +static Bool local varToVarBind Args((Tyvar *,Tyvar *)); +static Bool local varToTypeBind Args((Tyvar *,Type,Int)); +static Bool local kvarToVarBind Args((Tyvar *,Tyvar *)); +static Bool local kvarToTypeBind Args((Tyvar *,Type,Int)); +static Bool local unify Args((Type,Int,Type,Int)); +static Bool local sameType Args((Type,Int,Type,Int)); +static Bool local kunify Args((Kind,Int,Kind,Int)); + +static Void local kindError Args((Int,Constr,Constr,String,Kind,Int)); +static Void local kindConstr Args((Int,Constr)); +static Kind local kindAtom Args((Constr)); +static Void local kindPred Args((Int,Cell)); +static Void local kindType Args((Int,String,Type)); +static Void local fixKinds Args((Void)); + +static Void local initTCKind Args((Cell)); +static Void local kindTC Args((Cell)); +static Void local genTC Args((Cell)); +static Kind local copyKindvar Args((Int)); +static Kind local copyKind Args((Kind,Int)); + +static Bool local eqKind Args((Kind,Kind)); +static Kind local getKind Args((Cell,Int)); + +static Kind local makeSimpleKind Args((Int)); +static Kind local simpleKind Args((Int)); +static Kind local makeVarKind Args((Int)); +static Void local varKind Args((Int)); + +static Void local emptyAssumption Args((Void)); +static Void local enterBindings Args((Void)); +static Void local leaveBindings Args((Void)); +static Void local markAssumList Args((List)); +static Cell local findAssum Args((Text)); +static Pair local findInAssumList Args((Text,List)); +static Int local newVarsBind Args((Cell)); +static Void local newDefnBind Args((Cell,Type)); +static Void local instantiate Args((Type)); + +static Void local typeError Args((Int,Cell,Cell,String,Type,Int)); +static Void local reportTypeError Args((Int,Cell,Cell,String,Type,Type)); +static Cell local typeExpr Args((Int,Cell)); +static Cell local varIntro Args((Cell,Type)); +static Void local typeEsign Args((Int,Cell)); +static Void local typeCase Args((Int,Int,Cell)); +static Void local typeComp Args((Int,Type,Cell,List)); +static Void local typeMonadComp Args((Int,Cell)); +static Cell local compZero Args((List,Int)); +static Cell local typeFreshPat Args((Int,Cell)); + +static Cell local typeAp Args((Int,Cell)); +static Void local typeAlt Args((Cell)); +static Int local funcType Args((Int)); + +static Void local typeTuple Args((Cell)); +static Type local makeTupleType Args((Int)); + +static Void local typeBindings Args((List)); +static Void local removeTypeSigs Args((Cell)); + +static Void local noOverloading Args((List)); +static Void local restrictedBindAss Args((Cell)); +static Void local restrictedAss Args((Int,Cell,Type)); + +static Void local explicitTyping Args((List)); +static List local gotoExplicit Args((List)); +static List local explPreds Args((Text,List,List)); + +static Void local implicitTyping Args((List)); +static Void local addEvidParams Args((List,Cell)); + +static Void local typeInstDefn Args((Inst)); +static Void local typeClassDefn Args((Class)); +static Void local typeMembers Args((String,List,List,Cell,Kind)); +static Void local typeMember Args((String,Name,Name,Cell,Kind)); + +static Void local typeBind Args((Cell)); +static Void local typeDefAlt Args((Int,Cell,Pair)); +static Cell local typeRhs Args((Cell)); +static Void local guardedType Args((Int,Cell)); + +static Void local generaliseBind Args((Int,List,Cell)); +static Void local generaliseAss Args((Int,List,Cell)); +static Type local generalise Args((List,Type)); + +static Void local checkBindSigs Args((Cell)); +static Void local checkTypeSig Args((Int,Cell,Type)); +static Void local tooGeneral Args((Int,Cell,Type,Type)); + +static Bool local equalSchemes Args((Type,Type)); +static Bool local equalQuals Args((List,List)); +static Bool local equalTypes Args((Type,Type)); + +static Void local typeDefnGroup Args((List)); + +#if IO_DIALOGUE +static Void local initIOtypes Args((Void)); +#endif + +/* -------------------------------------------------------------------------- + * Frequently used type skeletons: + * ------------------------------------------------------------------------*/ + +static Type var; /* mkOffset(0) */ +static Type arrow; /* mkOffset(0) -> mkOffset(1) */ +static Type typeList; /* [ mkOffset(0) ] */ +static Type typeUnit; /* () */ +static Type typeIntToInt; /* Int -> Int */ +#if IO_MONAD +static Type typeSTab; /* ST a b */ +#endif + +static Name nameFromInt; /* fromInteger function */ +static Class classNum; /* class Num */ +static Cell predNum; /* Num (mkOffset(0)) */ +static Class classMonad; /* class Monad */ +static Cell predMonad; /* Monad (mkOffset(0)) */ +static Class classMonad0; /* class Monad0 */ +static Cell predMonad0; /* Monad0 (mkOffset(0)) */ +static Kind starToStar; /* Type -> Type */ +static Kind monadSig; /* [Type -> Type] */ + +/* -------------------------------------------------------------------------- + * Basic operations on current substitution: + * ------------------------------------------------------------------------*/ + +#include "subst.c" + +/* -------------------------------------------------------------------------- + * Kind expressions: + * + * In the same way that values have types, type constructors (and more + * generally, expressions built from such constructors) have kinds. + * The syntax of kinds in the current implementation is very simple: + * + * kind ::= STAR -- the kind of types + * | kind => kind -- constructors + * | variables -- either INTCELL or OFFSET + * + * ------------------------------------------------------------------------*/ + +#include "kind.c" + +/* -------------------------------------------------------------------------- + * Assumptions: + * + * A basic typing statement is a pair (Var,Type) and an assumption contains + * an ordered list of basic typing statements in which the type for a given + * variable is given by the most recently added assumption about that var. + * + * In practice, the assumption set is split between a pair of lists, one + * holding assumptions for vars defined in bindings, the other for vars + * defined in patterns/binding parameters etc. The reason for this + * separation is that vars defined in bindings may be overloaded (with the + * overloading being unknown until the whole binding is typed), whereas the + * vars defined in patterns have no overloading. A form of dependency + * analysis (at least as far as calculating dependents within the same group + * of value bindings) is required to implement this. Where it is known that + * no overloaded values are defined in a binding (i.e. when the `dreaded + * monomorphism restriction' strikes), the list used to record dependents + * is flagged with a NODEPENDS tag to avoid gathering dependents at that + * level. + * + * To interleave between vars for bindings and vars for patterns, we use + * a list of lists of typing statements for each. These lists are always + * the same length. The implementation here is very similar to that of the + * dependency analysis used in the static analysis component of this system. + * ------------------------------------------------------------------------*/ + +static List defnBounds; /*::[[(Var,Type)]] possibly ovrlded*/ +static List varsBounds; /*::[[(Var,Type)]] not overloaded */ +static List depends; /*::[?[Var]] dependents/NODEPENDS */ + +#define saveVarsAssump() List saveAssump = hd(varsBounds) +#define restoreVarsAss() hd(varsBounds) = saveAssump + +static Void local emptyAssumption() { /* set empty type assumption */ + defnBounds = NIL; + varsBounds = NIL; + depends = NIL; +} + +static Void local enterBindings() { /* Add new level to assumption sets */ + defnBounds = cons(NIL,defnBounds); + varsBounds = cons(NIL,varsBounds); + depends = cons(NIL,depends); +} + +static Void local leaveBindings() { /* Drop one level of assumptions */ + defnBounds = tl(defnBounds); + varsBounds = tl(varsBounds); + depends = tl(depends); +} + +static Void local markAssumList(as) /* Mark all types in assumption set */ +List as; { /* :: [(Var, Type)] */ + for (; nonNull(as); as=tl(as)) /* No need to mark generic types; */ + if (!isPolyType(snd(hd(as)))) /* the only free variables in those */ + markType(snd(hd(as)),0); /* must have been free earlier too */ +} + +static Cell local findAssum(t) /* Find most recent assumption about*/ +Text t; { /* variable named t, if any */ + List defnBounds1 = defnBounds; /* return translated variable, with */ + List varsBounds1 = varsBounds; /* type in typeIs */ + List depends1 = depends; + + while (nonNull(defnBounds1)) { + Pair ass = findInAssumList(t,hd(varsBounds1));/* search varsBounds */ + if (nonNull(ass)) { + typeIs = snd(ass); + return fst(ass); + } + + ass = findInAssumList(t,hd(defnBounds1)); /* search defnBounds */ + if (nonNull(ass)) { + Cell v = fst(ass); + typeIs = snd(ass); + + if (hd(depends1)!=NODEPENDS && /* save dependent? */ + isNull(v=varIsMember(t,hd(depends1)))) + /* N.B. make new copy of variable and store this on list of*/ + /* dependents, and in the assumption so that all uses of */ + /* the variable will be at the same node, if we need to */ + /* overwrite the call of a function with a translation... */ + hd(depends1) = cons(v=mkVar(t),hd(depends1)); + + return v; + } + + defnBounds1 = tl(defnBounds1); /* look in next level*/ + varsBounds1 = tl(varsBounds1); /* of assumption set */ + depends1 = tl(depends1); + } + return NIL; +} + +static Pair local findInAssumList(t,as)/* Search for assumption for var */ +Text t; /* named t in list of assumptions as*/ +List as; { + for (; nonNull(as); as=tl(as)) + if (textOf(fst(hd(as)))==t) + return hd(as); + return NIL; +} + +#define findTopBinding(v) findInAssumList(textOf(v),hd(defnBounds)) + +static Int local newVarsBind(v) /* make new assump for pattern var */ +Cell v; { + Int beta = newTyvars(1); + hd(varsBounds) = cons(pair(v,mkInt(beta)), hd(varsBounds)); +#ifdef DEBUG_TYPES + printf("variable, assume "); + printExp(stdout,v); + printf(" :: _%d\n",beta); +#endif + return beta; +} + +static Void local newDefnBind(v,type) /* make new assump for defn var */ +Cell v; /* and set type if given (nonNull) */ +Type type; { + Int beta = newTyvars(1); + hd(defnBounds) = cons(pair(v,mkInt(beta)), hd(defnBounds)); + instantiate(type); +#ifdef DEBUG_TYPES + printf("definition, assume "); + printExp(stdout,v); + printf(" :: _%d\n",beta); +#endif + bindTv(beta,typeIs,typeOff); /* Bind beta to new type skeleton */ +} + +static Void local instantiate(type) /* instantiate type expr, if nonNull*/ +Type type; { + predsAre = NIL; + typeIs = type; + typeOff = 0; + + if (nonNull(typeIs)) { /* instantiate type expression ? */ + + if (isPolyType(typeIs)) { /* Polymorphic type scheme ? */ + typeOff = newKindedVars(polySigOf(typeIs)); + typeIs = monoTypeOf(typeIs); + } + + if (whatIs(typeIs)==QUAL) { /* Qualified type? */ + predsAre = fst(snd(typeIs)); + typeIs = snd(snd(typeIs)); + } + } +} + +/* -------------------------------------------------------------------------- + * Predicate sets: + * + * A predicate set is represented by a list of triples (C t, o, used) + * which indicates that type (t,o) must be an instance of class C, with + * evidence required at the node pointed to by used. Note that the `used' + * node may need to be overwritten at a later stage if this evidence is + * to be derived from some other predicates by entailment. + * ------------------------------------------------------------------------*/ + +#include "preds.c" + +/* -------------------------------------------------------------------------- + * Type errors: + * ------------------------------------------------------------------------*/ + +static Void local typeError(l,e,in,wh,t,o) +Int l; /* line number near type error */ +String wh; /* place in which error occurs */ +Cell e; /* source of error */ +Cell in; /* context if any (NIL if not) */ +Type t; /* should be of type (t,o) */ +Int o; { /* type inferred is (typeIs,typeOff) */ + + clearMarks(); /* types printed here are monotypes */ + /* use marking to give sensible names*/ +#ifdef DEBUG_KINDS +{ List vs = genericVars; + for (; nonNull(vs); vs=tl(vs)) { + Int v = intOf(hd(vs)); + printf("%c :: ", ('a'+tyvar(v)->offs)); + printKind(stdout,tyvar(v)->kind); + putchar('\n'); + } +} +#endif + + reportTypeError(l,e,in,wh,copyType(typeIs,typeOff),copyType(t,o)); +} + +static Void local reportTypeError(l,e,in,wh,inft,expt) +Int l; /* error printing part of typeError*/ +Cell e, in; /* separated out for the benefit of*/ +String wh; /* typing runST */ +Type inft, expt; { + ERROR(l) "Type error in %s", wh ETHEN + if (nonNull(in)) { + ERRTEXT "\n*** expression : " ETHEN ERREXPR(in); + } + ERRTEXT "\n*** term : " ETHEN ERREXPR(e); + ERRTEXT "\n*** type : " ETHEN ERRTYPE(inft); + ERRTEXT "\n*** does not match : " ETHEN ERRTYPE(expt); + if (unifyFails) { + ERRTEXT "\n*** because : %s", unifyFails ETHEN + } + ERRTEXT "\n" + EEND; +} + +#define shouldBe(l,e,in,where,t,o) if (!unify(typeIs,typeOff,t,o)) \ + typeError(l,e,in,where,t,o); +#define check(l,e,in,where,t,o) e=typeExpr(l,e); shouldBe(l,e,in,where,t,o) +#define inferType(t,o) typeIs=t; typeOff=o + +/* -------------------------------------------------------------------------- + * Typing of expressions: + * ------------------------------------------------------------------------*/ + +#define EXPRESSION 0 /* type checking expression */ +#define NEW_PATTERN 1 /* pattern, introducing new vars */ +#define OLD_PATTERN 2 /* pattern, involving bound vars */ +static int tcMode = EXPRESSION; + +#ifdef DEBUG_TYPES +static Cell local mytypeExpr Args((Int,Cell)); +static Cell local typeExpr(l,e) +Int l; +Cell e; { + static int number = 0; + Cell retv; + int mynumber = number++; + printf("%d) to check: ",mynumber); + printExp(stdout,e); + putchar('\n'); + retv = mytypeExpr(l,e); + printf("%d) result: ",mynumber); + printType(stdout,debugType(typeIs,typeOff)); + putchar('\n'); + return retv; +} +static Cell local mytypeExpr(l,e) /* Determine type of expr/pattern */ +#else +static Cell local typeExpr(l,e) /* Determine type of expr/pattern */ +#endif +Int l; +Cell e; { + static String cond = "conditional"; + static String list = "list"; + static String discr = "case discriminant"; + static String aspat = "as (@) pattern"; + + switch (whatIs(e)) { + + /* The following cases can occur in either pattern or expr. mode */ + + case AP : return typeAp(l,e); + + case NAME : if (isNull(name(e).type)) + internal("typeExpr1"); + else { + Cell tt = varIntro(e,name(e).type); + return (name(e).defn==CFUN) ? e : tt; + } + + case TUPLE : typeTuple(e); + break; + + case INTCELL : if (tcMode==EXPRESSION && coerceNumLiterals + && nonNull(predNum)) { + Int alpha = newTyvars(1); + inferType(var,alpha); + return ap(ap(nameFromInt, + assumeEvid(predNum,alpha)), + e); + } + else { + inferType(typeInt,0); + } + break; + + case FLOATCELL : inferType(typeFloat,0); + break; + + case STRCELL : inferType(typeString,0); + break; + + case UNIT : inferType(typeUnit,0); + break; + + case CHARCELL : inferType(typeChar,0); + break; + + case VAROPCELL : + case VARIDCELL : if (tcMode!=NEW_PATTERN) { + Cell a = findAssum(textOf(e)); + if (nonNull(a)) + return varIntro(a,typeIs); + else { + a = findName(textOf(e)); + if (isNull(a) || isNull(name(a).type)) + internal("typeExpr2"); + return varIntro(a,name(a).type); + } + } + else { + inferType(var,newVarsBind(e)); + } + break; + + /* The following cases can only occur in expr mode */ + + case COND : { Int beta = newTyvars(1); + check(l,fst3(snd(e)),e,cond,typeBool,0); + check(l,snd3(snd(e)),e,cond,var,beta); + check(l,thd3(snd(e)),e,cond,var,beta); + tyvarType(beta); + } + break; + + case LETREC : enterBindings(); + mapProc(typeBindings,fst(snd(e))); + snd(snd(e)) = typeExpr(l,snd(snd(e))); + leaveBindings(); + break; + + case FINLIST : if (tcMode==EXPRESSION && nonNull(nameResult) + && isNull(tl(snd(e))) + && overSingleton) + typeMonadComp(l,e); + else { + Int beta = newTyvars(1); + List xs; + for (xs=snd(e); nonNull(xs); xs=tl(xs)) { + check(l,hd(xs),e,list,var,beta); + } + inferType(typeList,beta); + } + break; + +#if DO_COMPS + case DOCOMP : if (isNull(nameResult)) { + ERROR(l) + "Prelude does not support do {...} notation" + EEND; + } + typeMonadComp(l,e); + break; +#endif + + case COMP : if (nonNull(nameResult)) + typeMonadComp(l,e); + else { + Int beta = newTyvars(1); + typeComp(l,typeList,snd(e),snd(snd(e))); + bindTv(beta,typeIs,typeOff); + inferType(typeList,beta); + fst(e) = LISTCOMP; + } + break; + +#if IO_MONAD + case RUNST : { Int beta = newTyvars(2); + static String enc = "encapsulation"; + check(l,snd(e),e,enc,typeSTab,beta); + clearMarks(); + mapProc(markAssumList,defnBounds); + mapProc(markAssumList,varsBounds); + mapProc(markPred,preds); + markTyvar(beta+1); + tyvarType(beta); + if (typeIs!=var + || tyvar(typeOff)->offs==FIXED_TYVAR) { + Int alpha = newTyvars(2); + bindTv(alpha+1,var,beta+1); + reportTypeError(l,snd(e),e,enc, + copyType(typeSTab,beta), + copyType(typeSTab,alpha)); + } + tyvarType(beta+1); + } + break; +#endif + + case ESIGN : typeEsign(l,e); + return fst(snd(e)); + + case CASE : { Int beta = newTyvars(2); /* discr result */ + check(l,fst(snd(e)),NIL,discr,var,beta); + map2Proc(typeCase,l,beta,snd(snd(e))); + tyvarType(beta+1); + } + break; + + case LAMBDA : typeAlt(snd(e)); + break; + + /* The remaining cases can only occur in pattern mode: */ + + case WILDCARD : inferType(var,newTyvars(1)); + break; + + case ASPAT : { Int beta = newTyvars(1); + snd(snd(e)) = typeExpr(l,snd(snd(e))); + bindTv(beta,typeIs,typeOff); + check(l,fst(snd(e)),e,aspat,var,beta); + tyvarType(beta); + } + break; + + case LAZYPAT : snd(e) = typeExpr(l,snd(e)); + break; + +#if NPLUSK + case ADDPAT : + case MULPAT : inferType(typeIntToInt,0); + break; +#endif + + default : internal("typeExpr3"); + } + + return e; +} + +static Cell local varIntro(v,type) /* make translation of var v with */ +Cell v; /* given type adding any extra dict*/ +Type type; { /* params required */ + /* N.B. In practice, v will either be a NAME or a VARID/OPCELL */ + for (instantiate(type); nonNull(predsAre); predsAre=tl(predsAre)) + v = ap(v,assumeEvid(hd(predsAre),typeOff)); + return v; +} + +static Void local typeEsign(l,e) /* Type check expression type sig */ +Int l; +Cell e; { + static String typeSig = "type signature expression"; + List savePreds = preds; + Int alpha = newTyvars(1); + List expPreds; /* explicit preds in type sig */ + List qs; /* qualifying preds in infered type*/ + Type nt; /* complete infered type */ + + preds = NIL; + instantiate(snd(snd(e))); + bindTv(alpha,typeIs,typeOff); + expPreds = makeEvidArgs(predsAre,typeOff); + check(l,fst(snd(e)),NIL,typeSig,var,alpha); + + clearMarks(); + mapProc(markAssumList,defnBounds); + mapProc(markAssumList,varsBounds); + mapProc(markPred,savePreds); + + savePreds = elimConstPreds(l,typeSig,e,savePreds); + + explicitProve(l,typeSig,fst(snd(e)),expPreds,preds); + + resetGenericsFrom(0); + qs = copyPreds(expPreds); + nt = generalise(qs,copyTyvar(alpha)); + + if (!equalSchemes(nt,snd(snd(e)))) + tooGeneral(l,fst(snd(e)),snd(snd(e)),nt); + + tyvarType(alpha); + preds = revOnto(expPreds,savePreds); +} + +static Void local typeCase(l,beta,c) /* type check case: pat -> rhs */ +Int l; /* (case given by c == (pat,rhs)) */ +Int beta; /* need: pat :: (var,beta) */ +Cell c; { /* rhs :: (var,beta+1) */ + static String casePat = "case pattern"; + static String caseExpr = "case expression"; + + saveVarsAssump(); + + fst(c) = typeFreshPat(l,fst(c)); + shouldBe(l,fst(c),NIL,casePat,var,beta); + snd(c) = typeRhs(snd(c)); + shouldBe(l,rhsExpr(snd(c)),NIL,caseExpr,var,beta+1); + + restoreVarsAss(); +} + +static Void local typeComp(l,m,e,qs) /* type check comprehension */ +Int l; +Type m; /* monad (mkOffset(0)) */ +Cell e; +List qs; { + static String boolQual = "boolean qualifier"; + static String genQual = "generator"; + + if (isNull(qs)) /* no qualifiers left */ + fst(e) = typeExpr(l,fst(e)); + else { + Cell q = hd(qs); + List qs1 = tl(qs); + switch (whatIs(q)) { + case BOOLQUAL : check(l,snd(q),NIL,boolQual,typeBool,0); + typeComp(l,m,e,qs1); + break; + + case QWHERE : enterBindings(); + mapProc(typeBindings,snd(q)); + typeComp(l,m,e,qs1); + leaveBindings(); + break; + + case FROMQUAL : { Int beta = newTyvars(1); + saveVarsAssump(); + check(l,snd(snd(q)),NIL,genQual,m,beta); + fst(snd(q)) = typeFreshPat(l,fst(snd(q))); + shouldBe(l,fst(snd(q)),NIL,genQual,var,beta); + typeComp(l,m,e,qs1); + restoreVarsAss(); + } + break; + + case DOQUAL : check(l,snd(q),NIL,genQual,m,newTyvars(1)); + typeComp(l,m,e,qs1); + break; + } + } +} + +static Void local typeMonadComp(l,e) /* type check a monad comprehension*/ +Int l; +Cell e; { + Int alpha = newTyvars(1); + Int beta = newKindedVars(monadSig); + Cell mon = ap(mkInt(beta),var); + Cell m = assumeEvid(predMonad,beta); + typeComp(l,mon,snd(e),snd(snd(e))); +#if DO_COMPS + if (fst(e)==DOCOMP) { + static String finGen = "final generator"; + shouldBe(l,fst(snd(e)),NIL,finGen,mon,alpha); + } + else +#endif + { + bindTv(alpha,typeIs,typeOff); + inferType(mon,alpha); + fst(e) = MONADCOMP; + } + snd(e) = pair(pair(m,compZero(snd(snd(e)),beta)),snd(e)); +} + +static Cell local compZero(qs,beta) /* return evidence for Monad0 beta */ +List qs; /* if needed for qualifiers qs */ +Int beta; { + for (; nonNull(qs); qs=tl(qs)) + switch (whatIs(hd(qs))) { + case FROMQUAL : if (!refutable(fst(snd(hd(qs))))) + break; + /* intentional fall-thru */ + case BOOLQUAL : return assumeEvid(predMonad0,beta); + } + return NIL; +} + +static Cell local typeFreshPat(l,p) /* find type of pattern, assigning */ +Int l; /* fresh type variables to each var */ +Cell p; { /* bound in the pattern */ + tcMode = NEW_PATTERN; + p = typeExpr(l,p); + tcMode = EXPRESSION; + return p; +} + +/* -------------------------------------------------------------------------- + * Note the pleasing duality in the typing of application and abstraction:-) + * ------------------------------------------------------------------------*/ + +static Cell local typeAp(l,e) /* Type check application */ +Int l; +Cell e; { + static String app = "application"; + Cell h = getHead(e); /* e = h e1 e2 ... en */ + Int n = argCount; /* save no. of arguments */ + Int beta = funcType(n); + Cell p = NIL; /* points to previous AP node */ + Cell a = e; /* points to current AP node */ + Int i; + + check(l,h,e,app,var,beta); /* check h::t1->t2->...->tn->rn+1 */ + for (i=n; i>0; --i) { /* check e_i::t_i for each i */ + check(l,arg(a),e,app,var,beta+2*i-1); + p = a; + a = fun(a); + } + fun(p) = h; /* replace head with translation */ + tyvarType(beta+2*n); /* inferred type is r_n+1 */ + return e; +} + +static Void local typeAlt(a) /* Type check abstraction (Alt) */ +Cell a; { /* a = ( [p1, ..., pn], rhs ) */ + List ps = fst(a); + Int n = length(ps); + Int beta = funcType(n); + Int l = rhsLine(snd(a)); + Int i; + + saveVarsAssump(); + + for (i=0; i r_i+1 */ + for (i=0; i=MAXTUPCON) + typeIs = makeTupleType(n); + else if (tupleConTypes[n]) + typeIs = tupleConTypes[n]; + else + typeIs = tupleConTypes[n] = makeTupleType(n); +} + +static Type local makeTupleType(n) /* construct type for tuple constr. */ +Int n; { /* t1 -> ... -> tn -> (t1,...,tn) */ + Type h = mkTuple(n); + Int i; + + for (i=0; ikind,k); + t = mkPolyType(k,t); +#ifdef DEBUG_KINDS +printf("Generalised type: "); +printType(stdout,t); +printf(" ::: "); +printKind(stdout,k); +printf("\n"); +#endif + } + return t; +} + +/* -------------------------------------------------------------------------- + * Compare declared type schemes with inferred type schemes: + * ------------------------------------------------------------------------*/ + +static Void local checkBindSigs(b) /* check explicit type signature in */ +Cell b; { /* binding with inferred type */ + if (nonNull(fst(snd(b)))) { + if (isVar(fst(b))) /* function-binding? */ + checkTypeSig(rhsLine(snd(hd(snd(snd(b))))), + fst(b), + fst(snd(b))); + else { /* pattern-binding? */ + List vs = fst(b); + List ts = fst(snd(b)); + Int line = rhsLine(snd(snd(b))); + + while (nonNull(vs) && nonNull(ts)) { + if (nonNull(hd(ts))) + checkTypeSig(line,hd(vs),hd(ts)); + vs = tl(vs); + ts = tl(ts); + } + } + } +} + +static Void local checkTypeSig(l,v,t) /* Compare explicit type scheme t */ +Int l; /* declared for v with generalised */ +Cell v; /* type in current assumption */ +Type t; { + Cell ass = findTopBinding(v); + + if (isNull(ass)) + internal("checkTypeSig"); + + if (nonNull(t) && !equalSchemes(t,snd(ass))) + tooGeneral(l,v,t,snd(ass)); +} + +static Void local tooGeneral(l,e,dt,it) /* explicit type sig. too general */ +Int l; +Cell e; +Type dt, it; { + ERROR(l) "Declared type too general" ETHEN + ERRTEXT "\n*** Expression : " ETHEN ERREXPR(e); + ERRTEXT "\n*** Declared type : " ETHEN ERRTYPE(dt); + ERRTEXT "\n*** Inferred type : " ETHEN ERRTYPE(it); + ERRTEXT "\n" + EEND; +} + +/* -------------------------------------------------------------------------- + * Compare type schemes: + * ------------------------------------------------------------------------*/ + +static Bool local equalSchemes(s1,s2) /* Compare type schemes for equality*/ +Type s1, s2; { + Bool b1 = isPolyType(s1); + Bool b2 = isPolyType(s2); + if (b1 || b2) { + if (b1 && b2 && eqKind(polySigOf(s1),polySigOf(s2))) { + s1 = monoTypeOf(s1); + s2 = monoTypeOf(s2); + } + else + return FALSE; + } + + b1 = (whatIs(s1)==QUAL); + b2 = (whatIs(s2)==QUAL); + if (b1 && b2 && equalQuals(fst(snd(s1)),fst(snd(s2)))) { + s1 = snd(snd(s1)); + s2 = snd(snd(s2)); + } + else if (b1 && !b2 && isNull(fst(snd(s1)))) /* maybe somebody gave an */ + s1 = snd(snd(s1)); /* explicitly null context? */ + else if (!b1 && b2 && isNull(fst(snd(s2)))) + s2 = snd(snd(s2)); + else if (b1 || b2) + return FALSE; + + return equalTypes(s1,s2); +} + +static Bool local equalQuals(qs1,qs2) /* Compare lists of qualifying preds*/ +List qs1, qs2; { + while (nonNull(qs1) && nonNull(qs2)) { /* loop thru lists */ + Cell q1 = hd(qs1); + Cell q2 = hd(qs2); + + while (isAp(q1) && isAp(q2)) { /* loop thru args */ + if (!equalTypes(arg(q1),arg(q2))) + return FALSE; + q1 = fun(q1); + q2 = fun(q2); + } + if (q1!=q2) /* compare classes */ + return FALSE; + qs1 = tl(qs1); + qs2 = tl(qs2); + } + return isNull(qs1) && isNull(qs2); /* compare lengths */ +} + +static Bool local equalTypes(t1,t2) /* Compare simple types for equality*/ +Type t1, t2; { + +et: if (whatIs(t1)!=whatIs(t2)) + return FALSE; + + switch (whatIs(t1)) { + case TYCON : + case OFFSET : + case TUPLE : return t1==t2; + + case INTCELL : return intOf(t1)!=intOf(t2); + + case UNIT : + case ARROW : + case LIST : return TRUE; + + case AP : if (equalTypes(fun(t1),fun(t2))) { + t1 = arg(t1); + t2 = arg(t2); + goto et; + } + return FALSE; + + default : internal("equalTypes"); + } + + return TRUE;/*NOTREACHED*/ +} + +/* -------------------------------------------------------------------------- + * Entry points to type checker: + * ------------------------------------------------------------------------*/ + +Type typeCheckExp() { /* Type check top level expression */ + Type type; + List qs; + + typeChecker(RESET); + enterBindings(); + + inputExpr = typeExpr(0,inputExpr); + clearMarks(); + type = copyType(typeIs,typeOff); + if (nonNull(elimConstPreds(0,"expression",inputExpr,NIL))) + internal("typeCheckExp"); + preds = simplify(preds); + qs = copyPreds(preds); + type = generalise(qs,type); + if (nonNull(preds)) { /* qualify input expression with */ + if (whatIs(inputExpr)!=LAMBDA) /* additional dictionary params */ + inputExpr = ap(LAMBDA,pair(NIL,pair(mkInt(0),inputExpr))); + qualify(preds,snd(inputExpr)); + } + typeChecker(RESET); + return type; +} + +Void typeCheckDefns() { /* Type check top level bindings */ + Target t = length(valDefns) + length(instDefns) + length(classDefns); + Target i = 0; + List gs; + + typeChecker(RESET); + enterBindings(); + setGoal("Type checking",t); + + for (gs=valDefns; nonNull(gs); gs=tl(gs)) { + typeDefnGroup(hd(gs)); + soFar(i++); + } + clearTypeIns(); + for (gs=instDefns; nonNull(gs); gs=tl(gs)) { + typeInstDefn(hd(gs)); + soFar(i++); + } + for (gs=classDefns; nonNull(gs); gs=tl(gs)) { + typeClassDefn(hd(gs)); + soFar(i++); + } + + typeChecker(RESET); + done(); +} + +static Void local typeDefnGroup(bs) /* type check group of value defns */ +List bs; { /* (one top level scc) */ + List as; + + emptySubstitution(); + hd(defnBounds) = NIL; + preds = NIL; + setTypeIns(bs); + typeBindings(bs); /* find types for vars in bindings */ + + if (nonNull(preds)) { /* look for unresolved overloading */ + Cell b = hd(bs); + Cell ass; + Int line; + Cell v; + + preds = simplify(preds); /* Simplify context first ... */ + + if (isVar(fst(b))) { /* determine var name & line no. */ + v = fst(b); + line = rhsLine(snd(hd(snd(b)))); + } + else { + v = hd(fst(b)); + line = rhsLine(snd(snd(b))); + } + ass = findInAssumList(textOf(v),hd(varsBounds)); + + ERROR(line) "Unresolved top-level overloading" ETHEN + ERRTEXT "\n*** Binding : %s", textToStr(textOf(v)) + ETHEN + if (nonNull(ass)) { + ERRTEXT "\n*** Inferred type : " ETHEN ERRTYPE(snd(ass)); + } + ERRTEXT "\n*** Outstanding context : " ETHEN + ERRCONTEXT(copyPreds(preds)); + ERRTEXT "\n" + EEND; + } + + for (as=hd(varsBounds); nonNull(as); as=tl(as)) { + Cell a = hd(as); /* add infered types to environment*/ + Name n = findName(textOf(fst(a))); + + if (isNull(n)) + internal("typeDefnGroup"); + if (catchAmbigs && isAmbiguous(snd(a))) + ambigError(name(n).line,"inferred type",n,snd(a)); + name(n).type = snd(a); + } + hd(varsBounds) = NIL; +} + +/* -------------------------------------------------------------------------- + * Type checker control: + * ------------------------------------------------------------------------*/ + +Void typeChecker(what) +Int what; { + Int i; + + switch (what) { + case RESET : tcMode = EXPRESSION; + matchMode = FALSE; + predProve = NIL; + instPred = NIL; + instExpr = NIL; + unkindTypes = NIL; + emptySubstitution(); + emptyAssumption(); + preds = NIL; + break; + + case MARK : for (i=0; i=, > +infix 4 `elem`, `notElem` +infixr 3 && +infixr 2 || +infixr 0 $ + +-- Standard combinators: ---------------------------------------------------- + +primitive strict "primStrict" :: (a -> b) -> a -> b + +const :: a -> b -> a +const k x = k + +id :: a -> a +id x = x + +curry :: ((a,b) -> c) -> a -> b -> c +curry f a b = f (a,b) + +uncurry :: (a -> b -> c) -> (a,b) -> c +uncurry f (a,b) = f a b + +fst :: (a,b) -> a +fst (x,_) = x + +snd :: (a,b) -> b +snd (_,y) = y + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +thd3 :: (a,b,c) -> c +thd3 (_,_,x) = x + +(.) :: (b -> c) -> (a -> b) -> (a -> c) +(f . g) x = f (g x) + +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +($) :: (a -> b) -> a -> b -- pronounced as `apply' elsewhere +f $ x = f x + +-- Boolean functions: ------------------------------------------------------- + +(&&), (||) :: Bool -> Bool -> Bool +False && x = False +True && x = x + +False || x = x +True || x = True + +not :: Bool -> Bool +not True = False +not False = True + +and, or :: [Bool] -> Bool +and = foldr (&&) True +or = foldr (||) False + +any, all :: (a -> Bool) -> [a] -> Bool +any p = or . map p +all p = and . map p + +otherwise :: Bool +otherwise = True + +-- Character functions: ----------------------------------------------------- + +primitive ord "primCharToInt" :: Char -> Int +primitive chr "primIntToChar" :: Int -> Char + +isAscii, isControl, isPrint, isSpace :: Char -> Bool +isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool + +isAscii c = ord c < 128 + +isControl c = c < ' ' || c == '\DEL' + +isPrint c = c >= ' ' && c <= '~' + +isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' || + c == '\f' || c == '\v' + +isUpper c = c >= 'A' && c <= 'Z' +isLower c = c >= 'a' && c <= 'z' + +isAlpha c = isUpper c || isLower c +isDigit c = c >= '0' && c <= '9' +isAlphanum c = isAlpha c || isDigit c + + +toUpper, toLower :: Char -> Char + +toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A') + | otherwise = c + +toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a') + | otherwise = c + +minChar, maxChar :: Char +minChar = chr 0 +maxChar = chr 255 + +-- Standard type classes: --------------------------------------------------- + +class Eq a where + (==), (/=) :: a -> a -> Bool + x /= y = not (x == y) + +class Eq a => Ord a where + (<), (<=), (>), (>=) :: a -> a -> Bool + max, min :: a -> a -> a + + x < y = x <= y && x /= y + x >= y = y <= x + x > y = y < x + + max x y | x >= y = x + | y >= x = y + min x y | x <= y = x + | y <= x = y + +class Ord a => Ix a where + range :: (a,a) -> [a] + index :: (a,a) -> a -> Int + inRange :: (a,a) -> a -> Bool + +class Ord a => Enum a where + enumFrom :: a -> [a] -- [n..] + enumFromThen :: a -> a -> [a] -- [n,m..] + enumFromTo :: a -> a -> [a] -- [n..m] + enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m] + + enumFromTo n m = takeWhile (m>=) (enumFrom n) + enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m) + (enumFromThen n n') + +class (Eq a, Text a) => Num a where -- simplified numeric class + (+), (-), (*), (/) :: a -> a -> a + negate :: a -> a + fromInteger :: Int -> a + +-- Type class instances: ---------------------------------------------------- + +primitive primEqInt "primEqInt", + primLeInt "primLeInt" :: Int -> Int -> Bool +primitive primPlusInt "primPlusInt", + primMinusInt "primMinusInt", + primDivInt "primDivInt", + primMulInt "primMulInt" :: Int -> Int -> Int +primitive primNegInt "primNegInt" :: Int -> Int + +instance Eq () where () == () = True +instance Ord () where () <= () = True + +instance Eq Int where (==) = primEqInt + +instance Ord Int where (<=) = primLeInt + +instance Ix Int where + range (m,n) = [m..n] + index b@(m,n) i + | inRange b i = i - m + | otherwise = error "index out of range" + inRange (m,n) i = m <= i && i <= n + +instance Enum Int where + enumFrom n = iterate (1+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Int where + (+) = primPlusInt + (-) = primMinusInt + (*) = primMulInt + (/) = primDivInt + negate = primNegInt + fromInteger x = x + +{- PC version off -} +primitive primEqFloat "primEqFloat", + primLeFloat "primLeFloat" :: Float -> Float -> Bool +primitive primPlusFloat "primPlusFloat", + primMinusFloat "primMinusFloat", + primDivFloat "primDivFloat", + primMulFloat "primMulFloat" :: Float -> Float -> Float +primitive primNegFloat "primNegFloat" :: Float -> Float +primitive primIntToFloat "primIntToFloat" :: Int -> Float + +instance Eq Float where (==) = primEqFloat + +instance Ord Float where (<=) = primLeFloat + +instance Enum Float where + enumFrom n = iterate (1.0+) n + enumFromThen n m = iterate ((m-n)+) n + +instance Num Float where + (+) = primPlusFloat + (-) = primMinusFloat + (*) = primMulFloat + (/) = primDivFloat + negate = primNegFloat + fromInteger = primIntToFloat + +primitive sin "primSinFloat", asin "primAsinFloat", + cos "primCosFloat", acos "primAcosFloat", + tan "primTanFloat", atan "primAtanFloat", + log "primLogFloat", log10 "primLog10Float", + exp "primExpFloat", sqrt "primSqrtFloat" :: Float -> Float +primitive atan2 "primAtan2Float" :: Float -> Float -> Float +primitive truncate "primFloatToInt" :: Float -> Int + +pi :: Float +pi = 3.1415926535 + +{- PC version on -} + +primitive primEqChar "primEqChar", + primLeChar "primLeChar" :: Char -> Char -> Bool + +instance Eq Char where (==) = primEqChar -- c == d = ord c == ord d + +instance Ord Char where (<=) = primLeChar -- c <= d = ord c <= ord d + +instance Ix Char where + range (c,c') = [c..c'] + index b@(m,n) i + | inRange b i = ord i - ord m + | otherwise = error "index out of range" + inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci + +instance Enum Char where + enumFrom c = map chr [ord c .. ord maxChar] + enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar] + where lastChar = if c' < c then minChar else maxChar + +instance Eq a => Eq [a] where + [] == [] = True + [] == (y:ys) = False + (x:xs) == [] = False + (x:xs) == (y:ys) = x==y && xs==ys + +instance Ord a => Ord [a] where + [] <= _ = True + (_:_) <= [] = False + (x:xs) <= (y:ys) = x Eq (a,b) where + (x,y) == (u,v) = x==u && y==v + +instance (Ord a, Ord b) => Ord (a,b) where + (x,y) <= (u,v) = x Int -> Int + +subtract :: Num a => a -> a -> a +subtract = flip (-) + +even, odd :: Int -> Bool +even x = x `rem` 2 == 0 +odd = not . even + +gcd :: Int -> Int -> Int +gcd x y = gcd' (abs x) (abs y) + where gcd' x 0 = x + gcd' x y = gcd' y (x `rem` y) + +lcm :: Int -> Int -> Int +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` gcd x y) * y) + +(^) :: Num a => a -> Int -> a +x ^ 0 = fromInteger 1 +x ^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n`quot`2) + | otherwise = f x (n-1) (x*y) + +abs :: (Num a, Ord a) => a -> a +abs x | x>=fromInteger 0 = x + | otherwise = -x + +signum :: (Num a, Ord a) => a -> Int +signum x + | x==fromInteger 0 = 0 + | x> fromInteger 0 = 1 + | otherwise = -1 + +sum, product :: Num a => [a] -> a +sum = foldl' (+) (fromInteger 0) +product = foldl' (*) (fromInteger 1) + +sums, products :: Num a => [a] -> [a] +sums = scanl (+) (fromInteger 0) +products = scanl (*) (fromInteger 1) + +-- Standard list processing functions: -------------------------------------- + +head :: [a] -> a +head (x:_) = x + +last :: [a] -> a +last [x] = x +last (_:xs) = last xs + +tail :: [a] -> [a] +tail (_:xs) = xs + +init :: [a] -> [a] +init [x] = [] +init (x:xs) = x : init xs + +(++) :: [a] -> [a] -> [a] -- append lists. Associative with +[] ++ ys = ys -- left and right identity []. +(x:xs) ++ ys = x:(xs++ys) + +genericLength :: Num a => [b] -> a +genericLength = foldl' (\n _ -> n + fromInteger 1) (fromInteger 0) + +length :: [a] -> Int -- calculate length of list +length = foldl' (\n _ -> n+1) 0 + +(!!) :: [a] -> Int -> a -- xs!!n selects the nth element of +(x:_) !! 0 = x -- the list xs (first element xs!!0) +(_:xs) !! (n+1) = xs !! n -- for any n < length xs. + +iterate :: (a -> a) -> a -> [a] -- generate the infinite list +iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ... + +repeat :: a -> [a] -- generate the infinite list +repeat x = xs where xs = x:xs -- [x, x, x, x, ... + +cycle :: [a] -> [a] -- generate the infinite list +cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ... + +copy :: Int -> a -> [a] -- make list of n copies of x +copy n x = take n xs where xs = x:xs + +nub :: Eq a => [a] -> [a] -- remove duplicates from list +nub [] = [] +nub (x:xs) = x : nub (filter (x/=) xs) + +reverse :: [a] -> [a] -- reverse elements of list +reverse = foldl (flip (:)) [] + +elem, notElem :: Eq a => a -> [a] -> Bool +elem = any . (==) -- test for membership in list +notElem = all . (/=) -- test for non-membership + +maximum, minimum :: Ord a => [a] -> a +maximum = foldl1 max -- max element in non-empty list +minimum = foldl1 min -- min element in non-empty list + +concat :: [[a]] -> [a] -- concatenate list of lists +concat = foldr (++) [] + +transpose :: [[a]] -> [[a]] -- transpose list of lists +transpose = foldr + (\xs xss -> zipWith (:) xs (xss ++ repeat [])) + [] + +-- null provides a simple and efficient way of determining whether a given +-- list is empty, without using (==) and hence avoiding a constraint of the +-- form Eq [a]. + +null :: [a] -> Bool +null [] = True +null (_:_) = False + +-- (\\) is used to remove the first occurrence of each element in the second +-- list from the first list. It is a kind of inverse of (++) in the sense +-- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs. + +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl del + where [] `del` _ = [] + (x:xs) `del` y + | x == y = xs + | otherwise = x : xs `del` y + + +-- map f xs applies the function f to each element of the list xs returning +-- the corresponding list of results. filter p xs returns the sublist of xs +-- containing those elements which satisfy the predicate p. + +map :: (a -> b) -> [a] -> [b] +map f [] = [] +map f (x:xs) = f x : map f xs + +filter :: (a -> Bool) -> [a] -> [a] +filter _ [] = [] +filter p (x:xs) + | p x = x : xs' + | otherwise = xs' + where xs' = filter p xs + +-- Fold primitives: The foldl and scanl functions, variants foldl1 and +-- scanl1 for non-empty lists, and strict variants foldl' scanl' describe +-- common patterns of recursion over lists. Informally: +-- +-- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn +-- = (...((a `f` x1) `f` x2)...) `f` xn +-- etc... +-- +-- The functions foldr, scanr and variants foldr1, scanr1 are duals of these +-- functions: +-- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs. + +foldl :: (a -> b -> a) -> a -> [b] -> a +foldl f z [] = z +foldl f z (x:xs) = foldl f (f z x) xs + +foldl1 :: (a -> a -> a) -> [a] -> a +foldl1 f (x:xs) = foldl f x xs + +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' f a [] = a +foldl' f a (x:xs) = strict (foldl' f) (f a x) xs + +scanl :: (a -> b -> a) -> a -> [b] -> [a] +scanl f q xs = q : (case xs of + [] -> [] + x:xs -> scanl f (f q x) xs) + +scanl1 :: (a -> a -> a) -> [a] -> [a] +scanl1 f (x:xs) = scanl f x xs + +scanl' :: (a -> b -> a) -> a -> [b] -> [a] +scanl' f q xs = q : (case xs of + [] -> [] + x:xs -> strict (scanl' f) (f q x) xs) + +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +foldr1 :: (a -> a -> a) -> [a] -> a +foldr1 f [x] = x +foldr1 f (x:xs) = f x (foldr1 f xs) + +scanr :: (a -> b -> b) -> b -> [a] -> [b] +scanr f q0 [] = [q0] +scanr f q0 (x:xs) = f x q : qs + where qs@(q:_) = scanr f q0 xs + +scanr1 :: (a -> a -> a) -> [a] -> [a] +scanr1 f [x] = [x] +scanr1 f (x:xs) = f x q : qs + where qs@(q:_) = scanr1 f xs + +-- List breaking functions: +-- +-- take n xs returns the first n elements of xs +-- drop n xs returns the remaining elements of xs +-- splitAt n xs = (take n xs, drop n xs) +-- +-- takeWhile p xs returns the longest initial segment of xs whose +-- elements satisfy p +-- dropWhile p xs returns the remaining portion of the list +-- span p xs = (takeWhile p xs, dropWhile p xs) +-- +-- takeUntil p xs returns the list of elements upto and including the +-- first element of xs which satisfies p + +take :: Int -> [a] -> [a] +take 0 _ = [] +take _ [] = [] +take (n+1) (x:xs) = x : take n xs + +drop :: Int -> [a] -> [a] +drop 0 xs = xs +drop _ [] = [] +drop (n+1) (_:xs) = drop n xs + +splitAt :: Int -> [a] -> ([a], [a]) +splitAt 0 xs = ([],xs) +splitAt _ [] = ([],[]) +splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile p [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil p [] = [] +takeUntil p (x:xs) + | p x = [x] + | otherwise = x : takeUntil p xs + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile p [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + +span, break :: (a -> Bool) -> [a] -> ([a],[a]) +span p [] = ([],[]) +span p xs@(x:xs') + | p x = let (ys,zs) = span p xs' in (x:ys,zs) + | otherwise = ([],xs) +break p = span (not . p) + +-- Text processing: +-- lines s returns the list of lines in the string s. +-- words s returns the list of words in the string s. +-- unlines ls joins the list of lines ls into a single string +-- with lines separated by newline characters. +-- unwords ws joins the list of words ws into a single string +-- with words separated by spaces. + +lines :: String -> [String] +lines "" = [] +lines s = l : (if null s' then [] else lines (tail s')) + where (l, s') = break ('\n'==) s + +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w,s'') = break isSpace s' + +unlines :: [String] -> String +unlines = concat . map (\l -> l ++ "\n") + +unwords :: [String] -> String +unwords [] = [] +unwords ws = foldr1 (\w s -> w ++ ' ':s) ws + +-- Merging and sorting lists: + +merge :: Ord a => [a] -> [a] -> [a] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x <= y = x : merge xs (y:ys) + | otherwise = y : merge (x:xs) ys + +sort :: Ord a => [a] -> [a] +sort = foldr insert [] + +insert :: Ord a => a -> [a] -> [a] +insert x [] = [x] +insert x (y:ys) + | x <= y = x:y:ys + | otherwise = y:insert x ys + +qsort :: Ord a => [a] -> [a] +qsort [] = [] +qsort (x:xs) = qsort [ u | u<-xs, u=x ] + +-- zip and zipWith families of functions: + +zip :: [a] -> [b] -> [(a,b)] +zip = zipWith (\a b -> (a,b)) + +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +zip3 = zipWith3 (\a b c -> (a,b,c)) + +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] +zip4 = zipWith4 (\a b c d -> (a,b,c,d)) + +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] +zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e)) + +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] +zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) + +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] +zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) + + +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith z (a:as) (b:bs) = z a b : zipWith z as bs +zipWith _ _ _ = [] + +zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith3 z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] + +zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] + +zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +zipWith6 :: (a->b->c->d->e->f->g) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +zipWith7 :: (a->b->c->d->e->f->g->h) + -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +unzip :: [(a,b)] -> ([a],[b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], []) + +-- Formatted output: -------------------------------------------------------- + +primitive primPrint "primPrint" :: Int -> a -> String -> String + +show' :: a -> String +show' x = primPrint 0 x [] + +cjustify, ljustify, rjustify :: Int -> String -> String + +cjustify n s = space halfm ++ s ++ space (m - halfm) + where m = n - length s + halfm = m `div` 2 +ljustify n s = s ++ space (n - length s) +rjustify n s = space (n - length s) ++ s + +space :: Int -> String +space n = copy n ' ' + +layn :: [String] -> String +layn = lay 1 where lay _ [] = [] + lay n (x:xs) = rjustify 4 (show n) ++ ") " + ++ x ++ "\n" ++ lay (n+1) xs + +-- Miscellaneous: ----------------------------------------------------------- + +until :: (a -> Bool) -> (a -> a) -> a -> a +until p f x | p x = x + | otherwise = until p f (f x) + +until' :: (a -> Bool) -> (a -> a) -> a -> [a] +until' p f = takeUntil p . iterate f + +primitive error "primError" :: String -> a + +undefined :: a +undefined | False = undefined + +asTypeOf :: a -> a -> a +x `asTypeOf` _ = x + +-- A trimmed down version of the Haskell Text class: ------------------------ + +type ShowS = String -> String + +class Text a where + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + + showsPrec = primPrint + showList [] = showString "[]" + showList (x:xs) = showChar '[' . shows x . showl xs + where showl [] = showChar ']' + showl (x:xs) = showChar ',' . shows x . showl xs + +shows :: Text a => a -> ShowS +shows = showsPrec 0 + +show :: Text a => a -> String +show x = shows x "" + +showChar :: Char -> ShowS +showChar = (:) + +showString :: String -> ShowS +showString = (++) + +instance Text () where + showsPrec d () = showString "()" + +instance Text Bool where + showsPrec d True = showString "True" + showsPrec d False = showString "False" + +primitive primShowsInt "primShowsInt" :: Int -> Int -> String -> String +instance Text Int where showsPrec = primShowsInt + +{- PC version off -} +primitive primShowsFloat "primShowsFloat" :: Int -> Float -> String -> String +instance Text Float where showsPrec = primShowsFloat +{- PC version on -} + +instance Text Char where + showsPrec p c = showString [q, c, q] where q = '\'' + showList cs = showChar '"' . showl cs + where showl "" = showChar '"' + showl ('"':cs) = showString "\\\"" . showl cs + showl (c:cs) = showChar c . showl cs + -- Haskell has showLitChar c . showl cs + +instance Text a => Text [a] where + showsPrec p = showList + +instance (Text a, Text b) => Text (a,b) where + showsPrec p (x,y) = showChar '(' . shows x . showChar ',' . + shows y . showChar ')' + +-- I/O functions and definitions: ------------------------------------------- + +stdin = "stdin" +stdout = "stdout" +stderr = "stderr" +stdecho = "stdecho" + +{- The Dialogue, Request, Response and IOError datatypes are now builtin: +data Request = -- file system requests: + ReadFile String + | WriteFile String String + | AppendFile String String + -- channel system requests: + | ReadChan String + | AppendChan String String + -- environment requests: + | Echo Bool + | GetArgs + | GetProgName + | GetEnv String + +data Response = Success + | Str String + | Failure IOError + | StrList [String] + +data IOError = WriteError String + | ReadError String + | SearchError String + | FormatError String + | OtherError String + +type Dialogue = [Response] -> [Request] +-} + +type SuccCont = Dialogue +type StrCont = String -> Dialogue +type StrListCont = [String] -> Dialogue +type FailCont = IOError -> Dialogue + +done :: Dialogue +readFile :: String -> FailCont -> StrCont -> Dialogue +writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue +appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue +readChan :: String -> FailCont -> StrCont -> Dialogue +appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue +echo :: Bool -> FailCont -> SuccCont -> Dialogue +getArgs :: FailCont -> StrListCont -> Dialogue +getProgName :: FailCont -> StrCont -> Dialogue +getEnv :: String -> FailCont -> StrCont -> Dialogue + +done resps = [] +readFile name fail succ resps = + (ReadFile name) : strDispatch fail succ resps +writeFile name contents fail succ resps = + (WriteFile name contents) : succDispatch fail succ resps +appendFile name contents fail succ resps = + (AppendFile name contents) : succDispatch fail succ resps +readChan name fail succ resps = + (ReadChan name) : strDispatch fail succ resps +appendChan name contents fail succ resps = + (AppendChan name contents) : succDispatch fail succ resps +echo bool fail succ resps = + (Echo bool) : succDispatch fail succ resps +getArgs fail succ resps = + GetArgs : strListDispatch fail succ resps +getProgName fail succ resps = + GetProgName : strDispatch fail succ resps +getEnv name fail succ resps = + (GetEnv name) : strDispatch fail succ resps + +strDispatch fail succ (resp:resps) = + case resp of Str val -> succ val resps + Failure msg -> fail msg resps + +succDispatch fail succ (resp:resps) = + case resp of Success -> succ resps + Failure msg -> fail msg resps + +strListDispatch fail succ (resp:resps) = + case resp of StrList val -> succ val resps + Failure msg -> fail msg resps + +abort :: FailCont +abort err = done + +exit :: FailCont +exit err = appendChan stderr msg abort done + where msg = case err of ReadError s -> s + WriteError s -> s + SearchError s -> s + FormatError s -> s + OtherError s -> s + +print :: Text a => a -> Dialogue +print x = appendChan stdout (show x) exit done + +prints :: Text a => a -> String -> Dialogue +prints x s = appendChan stdout (shows x s) exit done + +interact :: (String -> String) -> Dialogue +interact f = readChan stdin exit + (\x -> appendChan stdout (f x) exit done) + +run :: (String -> String) -> Dialogue +run f = echo False exit (interact f) + +primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a + +openfile :: String -> String +openfile f = primFopen f (error ("can't open file "++f)) id + +-- End of Gofer standard prelude: --------------------------------------------