diff options
Diffstat (limited to 'testsuite/tests/ghc-regress/programs/lex/lex.stdin')
| -rw-r--r-- | testsuite/tests/ghc-regress/programs/lex/lex.stdin | 170 |
1 files changed, 0 insertions, 170 deletions
diff --git a/testsuite/tests/ghc-regress/programs/lex/lex.stdin b/testsuite/tests/ghc-regress/programs/lex/lex.stdin deleted file mode 100644 index dcd009c41b..0000000000 --- a/testsuite/tests/ghc-regress/programs/lex/lex.stdin +++ /dev/null @@ -1,170 +0,0 @@ -module Graph where - -import Parse -import StdLib -import PSlib -import GRIP - -paperX = 280::Int -paperY = 190::Int - -fromInt :: Num a => Int -> a -fromInt = fromInteger . toInteger - -gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n" -postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n" - -ePostscript (reqdx,reqdy) str = initialise (stdheader++ - "%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n" - ++ "%%EndComments\n") - ++ scale (fromInt reqdx*10/fromInt paperX) (fromInt reqdy*10/fromInt paperY) ++ str ++ - showpage - -initGraph title pedata (topX,topY) (xlabel,ylabel) keys = - drawBox (Pt 0 0) paperX paperY ++ - drawBox (Pt 1 1) (paperX-2) 5 ++ - drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++ - setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++ - setfont "NORM" ++ - placePEs pedata ++ - translate 20 25 ++ - newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++ - moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++ - setfont "SMALL" ++ - markXAxis dimX topX++ - markYAxis dimY topY++ - moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++ - moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++ - setfont "NORM" ++ - dokeys dimX keys - -placePEs (pes,on) | checkPEs (tail pes) on = - showActive (length pes) (length used) ++ - showUsed pes used ++ setfont "NORM" - where used = if on==[] then tail pes else on - - -cms2pts :: Int -> Int -cms2pts x = round (28.4584 * fromInt x) - -plotCurve :: Int -> [Point] -> Postscript -plotCurve x pts = setgray x ++ fillObject pts - -plot :: [Point] -> Postscript -plot points = plotCurve 5 (Pt 0 0:points) - -dokeys left keys = concat (map2 format (places 0) keys) - where - format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3)) - ++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++ - inv col ++ setfont "BOLD" ++ cjustify (pc) ++ - stroke ++ setfont "NORM" ++ setgray 10 - no=left `div` length keys - places n | n == no = [] - places n = (Pt (n*no) (-17)):places (n+1) - -showActive t f = - setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++ - setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++ - setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++ - setfont "NORM" - -showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++ - dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke - where - f pe | elem pe on = ("SMALLBOLD",showPE pe) - | otherwise = ("SMALL",showPE pe) - -dopes left pes = concat (map2 format (places 0) pes) - where - format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt ++ text tex ++ stroke - no=left `div` ((length pes*2)+1) - f x = (no*((x*2)+1)) + 27 - places n | n>2*no = [] - places n = (Pt (f n) 2):places (n+1) - - - -checkPEs pes [] = True -checkPEs pes (p:ps) | elem p pes = checkPEs pes ps - | otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p) - -showPE :: PElement -> String -showPE (PE str no) = str++"."++show no - -inv x | x>=5 = setgray 0 - | otherwise = setgray 10 - -dimX = paperX-30 -dimY = paperY-40 - -markXAxis :: Int -> Int -> Postscript -markXAxis dimX maxX = label 10 ++ markOnX 100 - where - label 0 = "" - label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++ - moveto (Pt (notch x) (-5)) ++ - cjustify (printFloat (t x)) ++ stroke ++ label (x-1) - t x = fromInt x*(fromInt maxX / fromInt 10) - notch x = x*(dimX `div` 10) - -markOnX n = mapcat notches [1..n] ++ stroke - where - notches n = movetofloat (m*fromInt n) 0 ++ (rlineto 0 (-1)) ++ stroke - m = fromInt dimX/fromInt n - - -markYAxis :: Int -> Int -> Postscript -markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY) - where - label 0 = "" - label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++ - moveto (Pt (-3) (notch x)) ++ - rjustify (printFloat (t x)) ++ stroke ++ label (x-1) - t x = fromInt x*(fromInt maxY / fromInt 10) - notch x = x*(dimY `div` 10) - -calibrate x | x<=1 = 1 - | x<=100 = x - | otherwise = calibrate (x `div` 10) - -markOnY n = mapcat notches [1..n] ++ stroke - where - notches n = movetofloat 0 (m*fromInt n) ++ (rlineto (-1) 0) - m = fromInt dimY/fromInt n - -movetofloat x y = show x ++ " " ++ show y ++ " moveto\n" - - -determineScale :: [Point] -> (Int,Int) -determineScale pts = (axisScale x, axisScale y) - where (min,Pt x y) = minandmax pts - -axisScale :: Int -> Int -axisScale x = axisScale' x 1 -axisScale' x m | x <= m = m - | x <= m*2 = m*2 - | x <= m*5 = m*5 - | x <= m*10 = m*10 - | otherwise = axisScale' x (m*10) - -minandmax :: [Point] -> (Point,Point) -minandmax [] = error "No points" -minandmax (p:ps) = f (p,p) ps - where - f p [] = p - f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps - where minx' = min x minx - miny' = min y miny - maxx' = max x maxx - maxy' = max y maxy - - -printFloat :: Float -> String -printFloat x = f (show (round (x*10))) - where - f "0" = "0" - f r | x<1 = "0."++r - f (r:"0") | x<10 = [r] - f (r:m) | x<10 = r:'.':m - f _ = show (round x) |