Commit 70e9ee75 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-02-06 17:15:50 by simonpj]

-------------------------------------
  Fix parsing of floating-point constants in External Core
	-------------------------------------

This fix accidentally made it into the previous (unrelated) commit,
so it's really the *previous* change to LexCore you should look
at.

The fix updates LexCore so that it can parse literals in scientific
notation (e.g. 4.3e-3)
parent e2971311
...@@ -426,12 +426,10 @@ repE (HsLam m) = repLambda m ...@@ -426,12 +426,10 @@ repE (HsLam m) = repLambda m
repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b} repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
repE (OpApp e1 op fix e2) = repE (OpApp e1 op fix e2) =
case op of do { arg1 <- repE e1;
HsVar op -> do { arg1 <- repE e1; arg2 <- repE e2;
arg2 <- repE e2; the_op <- repE op ;
the_op <- lookupOcc op ; repInfixApp arg1 the_op arg2 }
repInfixApp arg1 the_op arg2 }
_ -> panic "DsMeta.repE: Operator is not a variable"
repE (NegApp x nm) = do repE (NegApp x nm) = do
a <- repE x a <- repE x
negateVar <- lookupOcc negateName >>= repVar negateVar <- lookupOcc negateName >>= repVar
...@@ -930,14 +928,14 @@ repListExp (MkC es) = rep2 listExpName [es] ...@@ -930,14 +928,14 @@ repListExp (MkC es) = rep2 listExpName [es]
repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr) repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t] repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
repInfixApp :: Core M.Expr -> Core String -> Core M.Expr -> DsM (Core M.Expr) repInfixApp :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z] repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr) repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
repSectionL (MkC x) (MkC y) = rep2 infixAppName [x,y] repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr) repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
repSectionR (MkC x) (MkC y) = rep2 infixAppName [x,y] repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
------------ Right hand sides (guarded expressions) ---- ------------ Right hand sides (guarded expressions) ----
repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs) repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
......
...@@ -168,10 +168,10 @@ cvt (Comp ss) = HsDo ListComp (cvtstmts ss) [] void loc0 ...@@ -168,10 +168,10 @@ cvt (Comp ss) = HsDo ListComp (cvtstmts ss) [] void loc0
cvt (ArithSeq dd) = ArithSeqIn (cvtdd dd) cvt (ArithSeq dd) = ArithSeqIn (cvtdd dd)
cvt (ListExp xs) = ExplicitList void (map cvt xs) cvt (ListExp xs) = ExplicitList void (map cvt xs)
cvt (Infix (Just x) s (Just y)) cvt (Infix (Just x) s (Just y))
= HsPar (OpApp (cvt x) (HsVar(vName s)) undefined (cvt y)) = HsPar (OpApp (cvt x) (cvt s) undefined (cvt y))
cvt (Infix Nothing s (Just y)) = SectionR (HsVar(vName s)) (cvt y) cvt (Infix Nothing s (Just y)) = SectionR (cvt s) (cvt y)
cvt (Infix (Just x) s Nothing ) = SectionL (cvt x) (HsVar(vName s)) cvt (Infix (Just x) s Nothing ) = SectionL (cvt x) (cvt s)
cvt (Infix Nothing s Nothing ) = HsVar(vName s) -- Can I indicate this is an infix thing? cvt (Infix Nothing s Nothing ) = cvt s -- Can I indicate this is an infix thing?
cvt (SigExp e t) = ExprWithTySig (cvt e) (cvtType t) cvt (SigExp e t) = ExprWithTySig (cvt e) (cvtType t)
cvtdecs :: [Meta.Dec] -> HsBinds RdrName cvtdecs :: [Meta.Dec] -> HsBinds RdrName
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment