Permalink
Browse files

Move the base modules under src/

and tests under tests/ and remove tests modules
which are testing now non-existant modules.

darcs-hash:20080620140132-adfee-ce9d030c6068f9cf670b9c27b932d06d9c56bb14
  • Loading branch information...
dcoutts committed Jun 20, 2008
1 parent 450577a commit 3a72adb1d0dd0256209fea2dca44bfc7c9d3a93b
File renamed without changes.
File renamed without changes.
@@ -1,151 +0,0 @@
--- test `Parsers'
---
-
-module Main
-where
-
-import Position
-import UNames
-import Errors
-import Attributes
-import Parsers
-import State
-
-{- for Hugs
-type Attrs = ()
-newAttrs _ _ = ()
-type PreCST e s a = IO a
-type Name = Int
-getNameSupply :: IO Int
-getNameSupply = return 1
-names :: Int -> [Int]
-names x = [x..]
-putStrCIO = putStr
-run _ _ m = m
-printCIO :: Show a => a -> IO ()
-printCIO = print
--}
-
-data CharTok = CharTok Char Position
-
-instance Pos CharTok where
- posOf (CharTok _ pos) = pos
-
-instance Eq CharTok where
- (CharTok c1 _) == (CharTok c2 _) = c1 == c2
-
-instance Show CharTok where
- showsPrec _ (CharTok c _) = showString [c]
-
-instance Token CharTok
-
-stringToCharToks :: String -> [CharTok]
-stringToCharToks s =
- cts 1 s
- where
- cts _ [] = []
- cts n (c:cs) = CharTok c ("<string>", -1, n) : cts (n + 1) cs
-
-instance Show Attrs where
- showsPrec _ _ = showString "<attrs>"
-
--- simple expression grammar
---
-data Expr = Var String Attrs
- | Add Expr Expr Attrs
- | Mul Expr Expr Attrs
- deriving (Show)
-
-{-
-expr = prod *> expr' `action` glueExp
-expr' = chars '+' -*> prod *> expr' `action` (Just . glueExp)
- `opt` Nothing
-
-glueExp (p, e') = (mapMaybe (\e -> Add p e) p) e'
-
-prod = prim *> prod' `action` glueProd
-prod' = chars '*' -*> prim *> prod' `action` (Just . glueProd)
- `opt` Nothing
-
-glueProd (r, p') = (mapMaybe (\p -> Mul r p) r) p'
-
--}
-
-expr = sep1 (\l a r -> Add l r a) (chara '+') prod
-
-prod = sep1 (\l a r -> Mul l r a) (chara '*') prim
-
-prim = var
- <|> chars '(' -*> expr *-> chars ')'
-
---var = list1 alphaNum `action` Var
-var = alpha' *> many (:) [] alphaNum `action` \((c, at), cs) -> Var (c:cs) at
- where
- alpha' = alpha *> meta getName
- `action` \(CharTok c pos, n) -> (c, newAttrs pos n)
--- `action` \(CharTok c pos) -> (c, newAttrsOnlyPos pos)
-
-alpha = foldr1 (<|>) (map char0 (['a'..'z']))
-alphaNum = foldr1 (<|>) (map char (['a'..'z'] ++ ['0'..'9']))
-
---char c = const c $> skip (CharTok c nopos)
---chars c = skip (CharTok c nopos)
-char0 c = token (CharTok c nopos)
-char c = const c $> token (CharTok c nopos)
-
-chara c = token (CharTok c nopos) *> meta getName
- `action` \(CharTok _ pos, n) -> newAttrs pos n
--- `action` \(CharTok _ pos) -> newAttrsOnlyPos pos
-
-chars c = const () $> token (CharTok c nopos)
-
-mapMaybe f e Nothing = e
-mapMaybe f e (Just x) = f x
-
-getName (n:ns) = (ns, n)
-
---vars = many (const (1+)) 0 (char 'x')
---vars = sep1 (++) (token (CharTok '-' nopos)) ((\c -> [c]) $> char 'x')
---vars = seplist1 (token (CharTok '-' undefined)) (token (CharTok 'x' undefined))
-
-{-
-testparse :: String -> IO ()
-testparse cs = let (tree, errs) = (execParser expr . stringToCharToks) cs
---testparse cs = let (tree, errs) = (execParser vars . stringToCharToks) cs
- in do
- print tree
- mapM (putStr . showError) errs
- return ()
- -}
-
-
-parse :: Parser [Name] CharTok t -> String -> PreCST e s (t, [CharTok])
-parse p cs =
- do
- nsupp <- getNameSupply
- let ns = names nsupp
- (tree, errs, r) = (execParser p ns . stringToCharToks) cs
- mapM (putStrCIO . showError) errs
- return (tree, r)
-
-
-main :: IO ()
-main = run ("parser test", "", "") undefined doIt
-
-doIt :: PreCST e s ()
-doIt = let cs = "a+b*(xy+abcdefg)"
- in do
- putStrCIO "Parsers test...\n"
- putStrCIO "===============\n"
- (tree, _) <- parse expr cs
- printCIO tree
- putStrCIO "Should output: \
- \Mul (Var \"a\" <attrs>) (Add (Var \"b\" <attrs>) \
- \(Mul (Var \"xy\" <attrs>) (Var \"abcdefg\" <attrs>) \
- \<attrs>) <attrs>) <attrs>\n\n"
- ((abc, dot), rest) <- parse (list alpha *> char0 '.') "abc.junk"
- let stringify = concat . map show
- putStrCIO ("`list alpha *> char0 '.'' accepts from `abc.junk' \
- \the prefix `" ++ stringify (abc ++ [dot])
- ++ "',\nand the rest is `" ++ stringify rest
- ++ "'.\n")
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.

0 comments on commit 3a72adb

Please sign in to comment.