Skip to content

Commit

Permalink
work on grin
Browse files Browse the repository at this point in the history
  • Loading branch information
@atzedijkstra
atzedijkstra committed Nov 14, 2004
1 parent 7c19619 commit 92e9bd0
Show file tree
Hide file tree
Showing 11 changed files with 518 additions and 213 deletions.
20 changes: 6 additions & 14 deletions EHC/EHC.chs
View file
Expand Up @@ -32,10 +32,10 @@
main :: IO ()
main
= do { args <- getArgs
; let oo@(o,n,errs) = getOpt Permute cmdLineOpts args
; let oo@(o,n,errs) = getOpt Permute ehcCmdLineOpts args
opts = foldr ($) defaultEHCOpts o
; if ehcoptHelp opts
then putStrLn (usageInfo "Usage: ehc [options] [file]\n\noptions:" cmdLineOpts)
then putStrLn (usageInfo "Usage: ehc [options] [file]\n\noptions:" ehcCmdLineOpts)
else if null errs
then doCompileRun (if null n then "" else head n) opts
else putStr (head errs)
Expand All @@ -46,10 +46,10 @@ main
main :: IO ()
main
= do { args <- getArgs
; let oo@(o,n,errs) = getOpt Permute cmdLineOpts args
; let oo@(o,n,errs) = getOpt Permute ehcCmdLineOpts args
opts = foldr ($) defaultEHCOpts o
; if ehcoptHelp opts
then do { putStrLn (usageInfo "Usage ehc [options] [file]\n\noptions:" cmdLineOpts)
then do { putStrLn (usageInfo "Usage ehc [options] [file]\n\noptions:" ehcCmdLineOpts)
; putStrLn ("Transformations:\n" ++ (unlines . map (\(n,t) -> " " ++ n ++ ": " ++ t) $ cmdLineTrfs))
}
else if null errs
Expand Down Expand Up @@ -427,19 +427,11 @@ crCompileOrderedCUs modNmLL = crSeq (map (crCompileCU . head) modNmLL)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%[8.doCompile -1.doCompile
mkTopLevelFPath :: String -> FPath
mkTopLevelFPath fn
= let fpNoSuff = mkFPath fn
in maybe (fpathSetSuff "eh" fpNoSuff) (const fpNoSuff) . fpathMbSuff $ fpNoSuff

mkSearchPath :: FPath -> [String]
mkSearchPath fp = maybe [] (:[]) (fpathMbDir fp) ++ [""]

doCompileRun :: String -> EHCOpts -> IO ()
doCompileRun fn opts
= do { let fp = mkTopLevelFPath fn
= do { let fp = mkTopLevelFPath "eh" fn
topModNm = HNm (fpathBase fp)
searchPath = mkSearchPath fp
searchPath = mkInitSearchPath fp
opts' = opts { ehcoptSearchPath = searchPath ++ ehcoptSearchPath opts }
p1ib = Inh_AGItf {baseName_Inh_AGItf = fpathBase fp, gUniq_Inh_AGItf = uidStart, opts_Inh_AGItf = opts'}
aSetup cr = crHandle1
Expand Down
24 changes: 12 additions & 12 deletions EHC/EHCommon.chs
View file
Expand Up @@ -18,7 +18,7 @@
%%[1 import(UU.Pretty, List) export(PP_DocL, ppListSep, ppCommaList, ppListSepFill, ppSpaced, ppAppTop, ppCon, ppCmt)
%%]

%%[1 import(GetOpt) export(EHCOpts(..), defaultEHCOpts, cmdLineOpts)
%%[1 import(GetOpt) export(EHCOpts(..), defaultEHCOpts, ehcCmdLineOpts)
%%]

%%[1 export(MkConAppAlg, mkApp, mkConApp, mkArrow)
Expand Down Expand Up @@ -531,8 +531,8 @@ defaultEHCOpts = EHCOptions { ehcoptDumpPP = Just "pp"
, ehcoptTrf = []
%%]

%%[cmdLineOptsA.1
cmdLineOpts
%%[ehcCmdLineOptsA.1
ehcCmdLineOpts
= [ Option "p" ["pretty"] (OptArg oPretty "pp|ast|no")
"do output pretty printed version of src, default=pp"
, Option "d" ["debug"] (NoArg oDebug)
Expand All @@ -543,7 +543,7 @@ cmdLineOpts
"output this help"
%%]

%%[cmdLineOptsA.8
%%[ehcCmdLineOptsA.8
, Option "c" ["code"] (OptArg oCode "java|grin")
"dump code (java->.java, grin->.grin) on file, default=core (-> .core)"
, Option "" ["trf"] (ReqArg oTrf ("([+|-][" ++ concat (intersperse "|" (assocLKeys cmdLineTrfs)) ++ "])*"))
Expand All @@ -552,7 +552,7 @@ cmdLineOpts
"be verbose, 0=quiet 1=normal 2=noisy, default=1"
%%]

%%[cmdLineOptsB.1
%%[ehcCmdLineOptsB.1
where oPretty ms o = case ms of
Just "no" -> o { ehcoptDumpPP = Nothing }
Just p -> o { ehcoptDumpPP = Just p }
Expand All @@ -564,7 +564,7 @@ cmdLineOpts
oDebug o = o { ehcoptDebug = True }
%%]

%%[cmdLineOptsB.8
%%[ehcCmdLineOptsB.8
oCode ms o = case ms of
Just "java" -> o { ehcoptCoreJava = True }
Just "grin" -> o { ehcoptCoreGrin = True }
Expand Down Expand Up @@ -595,9 +595,9 @@ cmdLineOpts
%%@defaultEHCOpts.1
}

%%@cmdLineOptsA.1
%%@ehcCmdLineOptsA.1
]
%%@cmdLineOptsB.1
%%@ehcCmdLineOptsB.1
%%]

%%[8.Options -1.Options
Expand All @@ -609,11 +609,11 @@ cmdLineOpts
%%@defaultEHCOpts.8
}

%%@cmdLineOptsA.1
%%@cmdLineOptsA.8
%%@ehcCmdLineOptsA.1
%%@ehcCmdLineOptsA.8
]
%%@cmdLineOptsB.1
%%@cmdLineOptsB.8
%%@ehcCmdLineOptsB.1
%%@ehcCmdLineOptsB.8
%%]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Expand Down
173 changes: 73 additions & 100 deletions EHC/EHParser.chs
View file
Expand Up @@ -28,66 +28,85 @@
%%% Scanner
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%[1.commonScannerConfig
specialChars = "();,[]{}"
opChars = "!#$%&*+/<=>?@\\^|-:.~"
%%[1.ScanOpts
data ScanOpts
= ScanOpts
{ scoKeywordsTxt :: [String]
, scoKeywordsOps :: [String]
, scoSpecChars :: String
, scoOpChars :: String
}
%%]

%%[1.keywordsText
keywordsText = [ "in" ] ++ offsideTrigs
%%[1.scanOpts
scanOpts :: ScanOpts
scanOpts
%%]

%%[4.keywordsText -1.keywordsText
keywordsText = [ "in", "forall", "exists" ] ++ offsideTrigs
%%[1.defaultScanOpts
= ScanOpts
%%]

%%[5.keywordsText -4.keywordsText
keywordsText = [ "in", "forall", "exists", "data"
, "case", "if", "then", "else"
] ++ offsideTrigs
%%[7 -1.defaultScanOpts
= defaultScanOpts
%%]

%%[8.keywordsText -5.keywordsText
keywordsText = [ "in", "forall", "exists", "data"
, "case", "if", "then", "else"
, "foreign", "import", "jazy"
] ++ offsideTrigs
%%[1
{ scoKeywordsTxt =
[ "in"
%%]

%%[9.keywordsText -8.keywordsText
keywordsText = [ "in", "forall", "exists", "data"
, "case", "if", "then", "else"
, "foreign", "import", "jazy"
, "class", "instance"
] ++ offsideTrigs
%%[4
, "forall", "exists"
%%]

%%[1.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@" ]
%%[5
, "data", "case", "if", "then", "else"
%%]

%%[2.keywordsOps -1.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "..." ]
%%[8
, "foreign", "import", "jazy"
%%]

%%[4.keywordsOps -2.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "...", "." ]
%%[9
, "class", "instance"
%%]

%%[5.keywordsOps -4.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "...", ".", "|" ]
%%[1
] ++ offsideTrigs
, scoKeywordsOps =
[ "=", "\\", show hsnArrow, "::", "@"
%%]

%%[6.keywordsOps -5.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "...", ".", "|", "*" ]
%%[2
, "..."
%%]

%%[7.keywordsOps -6.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "...", ".", "|", "*", ":=" ]
%%[4
, "."
%%]

%%[9.keywordsOps -7.keywordsOps
keywordsOps = [ "=", "\\", show hsnArrow, "::", "@", "...", ".", "|", "*", ":=", "=>", "<:" ]
%%[5
, "|"
%%]
%%[6
, "*"
%%]
%%[7
, ":="
%%]
%%[9
, "=>", "<:"
%%]
%%[1
]
, scoSpecChars =
"();,[]{}"
, scoOpChars =
"!#$%&*+/<=>?@\\^|-:.~"
%%]
%%[7 -1.ScanOpts
, scoSpecPairs =
[ show hsnORow, show hsnCRow
, show hsnOSum, show hsnCSum
%%]
%%[9
, show hsnOImpl, show hsnCImpl
%%]
%%[7
]
%%]
%%[1
}
%%]

%%[1.offsideTrigs
Expand All @@ -102,45 +121,20 @@ offsideTrigs = [ "let", "of" ]
offsideTrigs = [ "let", "of", "where" ]
%%]

%%[7.specPairs
specPairs = [ show hsnORow, show hsnCRow
, show hsnOSum, show hsnCSum
]
%%]

%%[9.specPairs -7.specPairs
specPairs = [ show hsnORow, show hsnCRow
, show hsnOSum, show hsnCSum
, show hsnOImpl, show hsnCImpl
]
%%]

%%[1.scanHandle
scanHandle :: [String] -> [String] -> String -> String -> FilePath -> Handle -> IO [Token]
scanHandle keywordstxt keywordsops specchars opchars fn fh
scanHandle :: ScanOpts -> FilePath -> Handle -> IO [Token]
scanHandle opts fn fh
= do { txt <- hGetContents fh
; return (scan keywordstxt keywordsops specchars opchars (initPos fn) txt)
}

offsideScanHandle fn fh
= do { tokens <- scanHandle keywordsText keywordsOps specialChars opChars fn fh
; return (scanOffside moduleT oBrace cBrace triggers tokens)
; return (scan (scoKeywordsTxt opts) (scoKeywordsOps opts) (scoSpecChars opts) (scoOpChars opts) (initPos fn) txt)
}
where moduleT = reserved "let" noPos
oBrace = reserved "{" noPos
cBrace = reserved "}" noPos
triggers = [ reserved x noPos | x <- offsideTrigs ]
%%]

%%[7.scanHandle -1.scanHandle
scanHandle :: [String] -> [String] -> String -> String -> [String] -> FilePath -> Handle -> IO [Token]
scanHandle keywordstxt keywordsops specchars opchars specpairs fn fh
= do { txt <- hGetContents fh
; return (scan keywordstxt keywordsops specchars opchars specpairs (initPos fn) txt)
}
%%[7 -1.scanHandle
%%]

%%[1.offsideScanHandle
offsideScanHandle fn fh
= do { tokens <- scanHandle keywordsText keywordsOps specialChars opChars specPairs fn fh
= do { tokens <- scanHandle scanOpts fn fh
; return (scanOffside moduleT oBrace cBrace triggers tokens)
}
where moduleT = reserved "let" noPos
Expand Down Expand Up @@ -855,24 +849,3 @@ pDeclInstance = pKey "instance"
)
%%]


pDeclInstance = pKey "instance"
*> ( (\ne -> uncurry (sem_Decl_Instance ne))
<$> ((\n e -> Just (n,e)) <$> pVar <*> (True <$ pKey "<:" <|> False <$ pKey "::") `opt` Nothing)
<*> pClassHead
<* pKey "where" <*> pDecls
<|> sem_Decl_InstanceIntro <$> pVar <* pKey "<:" <*> pPrExprClass
)


pDeclInstance = (\ne -> uncurry (sem_Decl_Instance ne))
<$ pKey "instance" <*> ((\n e -> Just (n,e)) <$> pVar <*> (True <$ pKey "<:" <|> False <$ pKey "::") `opt` Nothing)
<*> pClassHead
<* pKey "where" <*> pDecls

pDeclInstance = pKey "instance"
*> ( (\mbNe (cp,p) d -> maybe () () mb)
<$> ((\n e -> Just (n,e)) <$> pVar <*> (True <$ pKey "<:" <|> False <$ pKey "::") `opt` Nothing)
<*> pClassHead
<* pKey "where" <*> pDecls
)

0 comments on commit 92e9bd0

Please sign in to comment.