module OOPParser where {

import Data.Char(isLower);
import Text.ParserCombinators.Parsec;
import Text.ParserCombinators.Parsec.Expr;
import Token;

import OOPType;

parseExpr = buildExpressionParser table parseFactor <?> "expression";

op2 name = \ x y -> App (App (Var name) x) y;

table = [
       	 [ Infix (do { try (reservedOp "*"); return (op2 "*")}) AssocLeft,
	   Infix (do { try (reservedOp "/"); return (op2 "/")}) AssocLeft,
	   Infix (do { try (reservedOp "%"); return (op2 "%")}) AssocLeft
	 ],
	 [ Infix (do { try (reservedOp "+"); return (op2 "+")}) AssocLeft,
	   Infix (do { try (reservedOp "-"); return (op2 "-")}) AssocLeft
	 ],
	 [ Infix (do { try (reservedOp "++"); return (op2 "++")}) AssocLeft ],
	 (map (\ op -> Infix (do { try (reservedOp op); return (op2 op)})
	                     AssocNone)
	  ["==", "/=", "<", "<=", ">=", ">"]),
	 [ Infix (do { try (reservedOp "&&");
		       return (\ x y -> If x y (Const (Bool False))) })
	   AssocRight
	 ],
	 [ Infix (do { try (reservedOp "||");
		       return (\ x y -> If x (Const (Bool True)) y) })
	   AssocRight
	 ]
	];


parseFactor = do {
		  es <- many1 parseAtomic;
		  return (foldl1 App es)
		 }
;

parseAtomic = parens parseExpr
              <|>
              (do { t <- naturalOrFloat;
		    return (case t of { Left i -> Const (Num (fromInteger i));
					Right d -> Const (Num d) })
		  })
	      <|>
	      (do {t <- stringLiteral;
		   return (Const (Str t))
		  })
	      <|>
              (do { t <- identifier; return (Var t) })
	      <|>
	      (do { reserved "let";
--		    decls <- parseDecls;
		    decl <- parseDecl;
		    reserved "in";
		    expr  <- parseExpr;
--		    return (Let decls expr)
		    return (Let decl expr)
		  })
	      <|>
	      (do { reserved "letrec";
--		    decls <- parseDecls;
		    decl <- parseDecl;
		    reserved "in";
		    expr  <- parseExpr;
		    return (Letrec decl expr)
		  })
	      <|>
	      (do { (reserved "fn" <|> reservedOp "\\");
		    id <- identifier;
		    reservedOp "->";
		    e <- parseExpr;
		    return (Lambda id e)
		  })
	      <|>
	      (do {
		   reserved "if";
		   e1 <- parseExpr;
		   reserved "then";
		   e2 <- parseExpr;
		   reserved "else";
		   e3 <- parseExpr;
		   return (If e1 e2 e3)
		  })
;

parseDecls = sepBy1 parseDecl semi;
parseDecl = do {
		i <- identifier;
                ps <- many identifier;
		reservedOp "=";
		e <- parseExpr;
		return ((i, ps), e)
	       }
;

parseCPat = do {
                 x <- identifier;
                 return (x, [])
            } 
            <|>
            do { 
         	x:xs <- parens (many1 identifier);
                return (x, xs)
	    }
;

parseExtPat = do {
                x <- identifier;
                if isLower (head x) then
                  do {
                     reservedOp "@";
                     c <- parseCPat;
                     return (AsPat x c)
                  }
                 <|>
                 return (SimplePat x)
               else  return (ConsPat (x, []))
              }
              <|>
              do {
                (c, is) <- parseCPat;
                return (ConsPat (c, is))
              }
;

parseExtPats = many parseExtPat;

parseMethodDecl = do {
                    x  <- identifier;
                    ps <- parseExtPats;
                    reservedOp "=" ;
                    e  <- parseExpr;
                    return ((x, ps), e);
                  }
;
parseMethodDecls = sepBy1 parseMethodDecl semi;

parseGlobalDecl = do {
                    reserved "let";
                    d <- parseDecl;
                    reserved "in";
                    e  <- parseGlobalDecl;
                    return (LetG d e);
                  }
                  <|>
                  do {
                    reserved "letrec";
                    d <- parseDecl;
                    reserved "in";
                    e  <- parseGlobalDecl;
                    return (LetrecG d e);
                  }
                  <|>
                  do {
                    reserved "class";
                    ds <- parseDecls;
                    reserved "in";
                    e  <- parseGlobalDecl;
                    return (ClassG ds e);
                  } 
                  <|>
                  do {
                    reserved "method";
                    ds <- parseMethodDecls;
                    reserved "in";
                    e  <- parseGlobalDecl;
                    return (MethodG ds e);
                  }
                  <|>
                  do {
                    p <- parseExpr;
                    return (ExprG p);
                  }
;

myParse :: String -> Global;
myParse str = case
	        (parse (do {whiteSpace; s<- parseGlobalDecl; eof; return s }) "" str)
	      of {
                Left err -> ExprG (Const (Str ("parse error at " ++ show err)));
	        Right x  -> x
	      }
;

}