gistfile1.hs

module Experiment where


       import Text.Parsec
       import Text.Parsec.Token
       import Text.Parsec.Language


       data Expr = ScSymbol String
                   | ScString String
                   | ScNumber Integer
                   | ScDouble Double 
                   | ScCons Expr Expr
                   | ScNil
                   | ScBool Bool
                   | ScQuote Expr
            deriving Show
       

       idSymbol = oneOf ":!$%&*+./<=>?@\\^|-~"

       mydef :: LanguageDef st
       mydef = emptyDef { 
                          commentLine = ";;"
                          , identStart = letter <|> idSymbol
                          , identLetter = alphaNum <|> idSymbol
                          , opStart = parserZero
                          , opLetter = parserZero

                        }

       mytparser = makeTokenParser mydef

       TokenParser {
          identifier = idParser,
          reservedOp = opParser,
          stringLiteral = stringLiteralParser,
          parens = parParser,
          lexeme = lexParser,
          naturalOrFloat = naturalOrFloatParser
       } = mytparser 

       boolLiteral = lexParser (
                        do 
                          char '#'
                          val <- (char 't') <|> (char 'f')
                          return $ ScBool $ val == 't'
                    )

       quoteParser = lexParser (
                        do 
                          char '\''
                          val <- scExprParser
                          return $ ScQuote val
                    )


--       atom:: Parser Expr
       atom =
          (do 
             id <- idParser
             return $ ScSymbol id)
          <|>
          (do 
             fnumber <- naturalOrFloatParser
             return $ case fnumber of
                       Left x -> ScNumber x
                       Right x -> ScDouble x)
          <|>        

          (do str <- stringLiteralParser
              return $ ScString str)
          <|>
          boolLiteral
          <|>
          quoteParser

       comp = 
          do exprs <- parParser (many scExprParser)
             return $ foldr ScCons ScNil exprs

       scExprParser =
            atom <|> comp
            

       doIt input = parse scExprParser "" input