Merge branch 'master' of uhsure.com:webapps/git/bang
This commit is contained in:
@@ -25,7 +25,7 @@ export length(ls :: [a]) :: Int
|
||||
{
|
||||
case ls of
|
||||
[] -> 0
|
||||
_:rest -> length rest
|
||||
_:rest -> length(rest)
|
||||
};
|
||||
|
||||
export reverse(ls :: [a]) :: [a]
|
||||
@@ -33,10 +33,10 @@ export reverse(ls :: [a]) :: [a]
|
||||
helper(xs,acc) = {
|
||||
case xs of
|
||||
[] -> acc
|
||||
(a:rest) -> helper rest (a:acc)
|
||||
(a:rest) -> helper(rest, (a:acc))
|
||||
}
|
||||
|
||||
helper ls [];
|
||||
helper(ls, []);
|
||||
};
|
||||
|
||||
export restrict(Eq a) find(f :: a -> Bool, ls :: [a]) :: Maybe a
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
module Syntax.AST where
|
||||
|
||||
import Syntax.ParserCore
|
||||
|
||||
data Show a => Module a = Module {
|
||||
modName :: QualifiedName
|
||||
, modImports :: [Import]
|
||||
@@ -13,6 +15,11 @@ data QualifiedName = QualifiedName {
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
gensym :: Parser QualifiedName
|
||||
gensym = do
|
||||
name <- genstr
|
||||
return (QualifiedName [] name)
|
||||
|
||||
data Import = Import {
|
||||
imName :: QualifiedName
|
||||
, imQualified :: Bool
|
||||
@@ -31,7 +38,7 @@ data Show a => Decl a =
|
||||
| DeclNewtype a [Type]
|
||||
| DeclClass a [Type]
|
||||
| DeclInstance a [Type]
|
||||
| DeclValue a [Type] Type QualifiedName [Stmt a]
|
||||
| DeclValue a [Type] Type (Expr a)
|
||||
| DeclExport a (Decl a)
|
||||
deriving (Show)
|
||||
|
||||
@@ -41,7 +48,7 @@ addTypeRestrictions rs (DeclType s _) = DeclType s rs
|
||||
addTypeRestrictions rs (DeclNewtype s _) = DeclNewtype s rs
|
||||
addTypeRestrictions rs (DeclClass s _) = DeclClass s rs
|
||||
addTypeRestrictions rs (DeclInstance s _) = DeclInstance s rs
|
||||
addTypeRestrictions rs (DeclValue s _ a b c) = DeclValue s rs a b c
|
||||
addTypeRestrictions rs (DeclValue s _ a b) = DeclValue s rs a b
|
||||
addTypeRestrictions rs (DeclExport s d) =
|
||||
DeclExport s (addTypeRestrictions rs d)
|
||||
|
||||
@@ -51,16 +58,32 @@ data DataClause a = DataClause a QualifiedName [Maybe QualifiedName] [Type]
|
||||
data Show a => Expr a =
|
||||
Const a ConstVal
|
||||
| VarRef a QualifiedName
|
||||
| Cond a (Expr a) (Expr a)
|
||||
| App a (Expr a) (Expr a)
|
||||
| Block a [Expr a]
|
||||
| Cond a (Expr a) (Expr a) (Expr a)
|
||||
| App a (Expr a) [Expr a]
|
||||
| Block a [Stmt a]
|
||||
| Lambda a [QualifiedName] (Expr a)
|
||||
deriving (Show)
|
||||
|
||||
getSpecial :: Show a => Expr a -> a
|
||||
getSpecial (Const a _) = a
|
||||
getSpecial (VarRef a _) = a
|
||||
getSpecial (Cond a _ _ _) = a
|
||||
getSpecial (App a _ _) = a
|
||||
getSpecial (Block a _) = a
|
||||
getSpecial (Lambda a _ _) = a
|
||||
|
||||
data Show a => Stmt a =
|
||||
SExpr a (Expr a)
|
||||
| SBind a QualifiedName (Stmt a)
|
||||
| SCase a
|
||||
| SCase a (Expr a) [(Pattern,Maybe (Expr a),Expr a)]
|
||||
deriving (Show)
|
||||
|
||||
data Pattern =
|
||||
ListNull
|
||||
| PConst ConstVal
|
||||
| PVar QualifiedName
|
||||
| PNamed QualifiedName Pattern
|
||||
| PAp Pattern Pattern
|
||||
deriving (Show)
|
||||
|
||||
data Kind = Star | KFun Kind Kind
|
||||
|
||||
@@ -58,6 +58,7 @@ $escape_char = [abfnrtv'\"\\]
|
||||
"|" { emitT Bar }
|
||||
";" { emitT Semi }
|
||||
"," { emitT Comma }
|
||||
"`" { emitT BTick }
|
||||
|
||||
{
|
||||
|
||||
|
||||
@@ -34,7 +34,7 @@ import qualified Codec.Binary.UTF8.Generic as UTF8
|
||||
-- symbols
|
||||
'=' { Lexeme $$ (TokOpIdent "=") }
|
||||
'->' { Lexeme $$ (TokOpIdent "->") }
|
||||
'=>' { Lexeme $$ (TokOpIdent "=>") }
|
||||
'@' { Lexeme $$ (TokOpIdent "@") }
|
||||
'::' { Lexeme $$ (TokOpIdent "::") }
|
||||
'\\' { Lexeme $$ (TokOpIdent "\\") }
|
||||
'(' { Lexeme $$ LParen }
|
||||
@@ -46,17 +46,18 @@ import qualified Codec.Binary.UTF8.Generic as UTF8
|
||||
'|' { Lexeme $$ Bar }
|
||||
';' { Lexeme $$ Semi }
|
||||
',' { Lexeme $$ Comma }
|
||||
'`' { Lexeme $$ BTick }
|
||||
|
||||
-- identifiers
|
||||
TYPE_IDENT { Lexeme _ (TokTypeIdent $$) }
|
||||
VAL_IDENT { Lexeme _ (TokValIdent $$) }
|
||||
OP_IDENT { Lexeme _ (TokOpIdent $$) }
|
||||
TYPE_IDENT { Lexeme _ (TokTypeIdent _) }
|
||||
VAL_IDENT { Lexeme _ (TokValIdent _) }
|
||||
OP_IDENT { Lexeme _ (TokOpIdent _) }
|
||||
|
||||
-- values
|
||||
INTVAL { Lexeme _ (TokInt $$) }
|
||||
FLOATVAL { Lexeme _ (TokFloat $$) }
|
||||
CHARVAL { Lexeme _ (TokChar $$) }
|
||||
STRVAL { Lexeme _ (TokString $$) }
|
||||
INTVAL { Lexeme _ (TokInt _) }
|
||||
FLOATVAL { Lexeme _ (TokFloat _) }
|
||||
CHARVAL { Lexeme _ (TokChar _) }
|
||||
STRVAL { Lexeme _ (TokString _) }
|
||||
|
||||
%monad { Parser } { (>>=) } { return }
|
||||
%name parseModule top_module
|
||||
@@ -164,7 +165,9 @@ data_clauses :: { [DataClause Position] }
|
||||
| data_clauses '|' data_clause { $1 ++ [$3] }
|
||||
|
||||
data_clause :: { DataClause Position }
|
||||
: constructor_name '(' constructor_args ')'
|
||||
: constructor_name '(' ')'
|
||||
{ DataClause $2 $1 [] [] }
|
||||
| constructor_name '(' constructor_args ')'
|
||||
{ DataClause $2 $1 (map fst $3) (map snd $3) }
|
||||
|
||||
constructor_name :: { QualifiedName }
|
||||
@@ -202,7 +205,9 @@ instance_decl :: { Decl Position }
|
||||
-- Value Declaration --------------------------------------------------------
|
||||
|
||||
value_decl :: { Decl Position }
|
||||
: value_ident optional_args optional_type { undefined }
|
||||
: value_ident optional_args optional_type value_body
|
||||
{% postProcessDeclVal $1 $2 $3 $4 }
|
||||
|
||||
|
||||
optional_args :: { Maybe [(QualifiedName, Maybe Type)] }
|
||||
: '(' optional_args2 ')' { Just $2 }
|
||||
@@ -223,147 +228,156 @@ value_ident :: { QualifiedName }
|
||||
: VAL_IDENT { makeQualified $1 }
|
||||
| '(' OP_IDENT ')' { makeQualified $2 }
|
||||
|
||||
value_body :: { (Position, Expr Position) }
|
||||
: '=' expression { ($1, $2) }
|
||||
| '{' statements '}' { ($1, Block $1 $2) }
|
||||
|
||||
-- Types in Bang ------------------------------------------------------------
|
||||
|
||||
bang_type :: { Type }
|
||||
primary_type :: { Type }
|
||||
: TYPE_IDENT { TVar (makeQualified $1) Star }
|
||||
| VAL_IDENT { TVar (makeQualified $1) Star }
|
||||
| '(' bang_type ')' { $2 }
|
||||
|
||||
--
|
||||
-- data_decl :: { Decl Position }
|
||||
-- : 'datatype' mqualifiers TYPE_IDENT data_args dataclauses
|
||||
-- { DeclData $2 (makeQualified $3) $4 $5 }
|
||||
--
|
||||
-- mqualifiers :: { [Type] }
|
||||
-- : { [] }
|
||||
-- | '(' tqualifiers ')' '=>' { $2 }
|
||||
--
|
||||
-- tqualifiers :: { [Type] }
|
||||
-- : tqualifier { [$1] }
|
||||
-- | tqualifiers ',' tqualifier { $1 ++ [$3] }
|
||||
--
|
||||
-- tqualifier :: { Type }
|
||||
-- : TYPE_IDENT VAL_IDENT
|
||||
-- { TAp (TCon (makeQualified $1) Star) (TVar (makeQualified $2) Star) }
|
||||
-- | tqualifier VAL_IDENT
|
||||
-- { TAp $1 (TVar (makeQualified $2) Star) }
|
||||
--
|
||||
-- data_args :: { [QualifiedName] }
|
||||
-- : { [] }
|
||||
-- | data_args VAL_IDENT { $1 ++ [makeQualified $2] }
|
||||
--
|
||||
-- dataclauses :: { [DataClause] }
|
||||
-- : '=' dataclause { [$2] }
|
||||
-- | dataclauses '|' dataclause { $1 ++ [$3] }
|
||||
--
|
||||
-- dataclause :: { DataClause }
|
||||
-- : constructor_id { DataClause $1 [] }
|
||||
-- | dataclause bangtype3 { let DataClause name items = $1
|
||||
-- in DataClause name (items ++ [$2]) }
|
||||
--
|
||||
-- constructor_id :: { QualifiedName }
|
||||
-- : TYPE_IDENT { makeQualified $1 }
|
||||
-- | '(' OP_IDENT ')' { makeQualified $2 }
|
||||
--
|
||||
-- -- Type alias Declarations --------------------------------------------------
|
||||
--
|
||||
-- type_decl :: { Decl Position }
|
||||
-- : 'type' { DeclType }
|
||||
--
|
||||
-- -- Newtype Declarations -----------------------------------------------------
|
||||
--
|
||||
-- newtype_decl :: { Decl Position }
|
||||
-- : 'newtype' { DeclNewtype }
|
||||
--
|
||||
-- -- Type class Declarations --------------------------------------------------
|
||||
--
|
||||
-- class_decl :: { Decl Position }
|
||||
-- : 'class' { DeclClass }
|
||||
--
|
||||
-- -- Instance Declarations ----------------------------------------------------
|
||||
--
|
||||
-- instance_decl :: { Decl Position }
|
||||
-- : 'instance' { DeclInstance }
|
||||
--
|
||||
-- -- Data value Declarations --------------------------------------------------
|
||||
--
|
||||
-- value_decl :: { Decl Position }
|
||||
-- : value_name '=' expr { DeclValue Nothing $1 (Just $3) }
|
||||
--
|
||||
-- value_name :: { QualifiedName }
|
||||
-- : VAL_IDENT { makeQualified $1 }
|
||||
-- | '(' OP_IDENT ')' { makeQualified $2 }
|
||||
--
|
||||
-- -- Data value type Declarations ---------------------------------------------
|
||||
--
|
||||
-- vtype_decl :: {Decl Position }
|
||||
-- : value_name '::' bangtype { DeclValue (Just $3) $1 Nothing }
|
||||
--
|
||||
-- -- Types --------------------------------------------------------------------
|
||||
--
|
||||
-- bangtype :: { Type }
|
||||
-- : bangtype1 { $1 }
|
||||
--
|
||||
-- bangtype1 :: { Type }
|
||||
-- : bangtype1 VAL_IDENT { TAp $1 (TVar (makeQualified $2) Star) }
|
||||
-- | bangtype2 { $1 }
|
||||
--
|
||||
-- bangtype2 :: { Type }
|
||||
-- : bangtype2 '->' bangtype3
|
||||
-- { TAp (TAp (TCon (QualifiedName [] "->") Star) $1) $3 }
|
||||
-- | bangtype3 { $1 }
|
||||
--
|
||||
-- bangtype3 :: { Type }
|
||||
-- : '[' bangtype3 ']'
|
||||
-- { TAp (TVar (QualifiedName ["Data","List"] "List") Star) $2 }
|
||||
-- | bangtype4 { $1 }
|
||||
--
|
||||
-- bangtype4 :: { Type }
|
||||
-- : TYPE_IDENT { TVar (makeQualified $1) Star }
|
||||
-- | '(' bangtype ')' { $2 }
|
||||
--
|
||||
-- -- Statements ---------------------------------------------------------------
|
||||
--
|
||||
-- statement :: { Statement }
|
||||
-- : expr ';' { }
|
||||
-- | 'case' expr 'of' { }
|
||||
--
|
||||
-- -- Expressions --------------------------------------------------------------
|
||||
--
|
||||
-- expr :: { Expr Position }
|
||||
-- : '\\' arglist '->' expr1 { Lambda Position $2 $4 }
|
||||
-- | expr1 { $1 }
|
||||
--
|
||||
-- arglist :: { [QualifiedName] }
|
||||
-- : VAL_IDENT { [makeQualified $1] }
|
||||
-- | arglist VAL_IDENT { $1 ++ [makeQualified $2] }
|
||||
--
|
||||
-- expr1 :: { Expr Position }
|
||||
-- : '{' exprs '}' { Block Position $2 }
|
||||
-- | expr2 { $1 }
|
||||
--
|
||||
-- exprs :: { [Expr Position] }
|
||||
-- : expr ';' { [$1] }
|
||||
-- | exprs expr ';' { $1 ++ [$2] }
|
||||
--
|
||||
-- expr2 :: { Expr Position }
|
||||
-- : '[' list_exprs ']' { unwindList $2 }
|
||||
-- | expr3 { $1 }
|
||||
--
|
||||
-- list_exprs :: { [Expr Position] }
|
||||
-- : { [] }
|
||||
-- | list_exprs ',' expr3 { $1 ++ [$3] }
|
||||
--
|
||||
-- expr3 :: { Expr Position }
|
||||
-- : bottom_expr { $1 }
|
||||
--
|
||||
-- bottom_expr :: { Expr Position }
|
||||
-- : INTVAL { let (b,v) = $1 in Const () (ConstInteger b v) }
|
||||
-- | FLOATVAL { Const Position (ConstFloat $1) }
|
||||
-- | CHARVAL { Const Position (ConstChar $1) }
|
||||
-- | STRVAL { Const Position (ConstString $1) }
|
||||
-- | VAL_IDENT { VarRef Position (makeQualified $1) }
|
||||
-- | '[' ']' { VarRef () (QualifiedName ["Data","List"] "Null") }
|
||||
-- | '(' expr ')' { $2 }
|
||||
type_application_type :: { Type }
|
||||
: type_application_type primary_type
|
||||
{ TAp $1 $2 }
|
||||
| primary_type
|
||||
{ $1 }
|
||||
|
||||
function_type :: { Type }
|
||||
: function_type '->' type_application_type
|
||||
{ TAp (TVar (QualifiedName ["--INTERNAL--"] "->") Star) $3 }
|
||||
| type_application_type
|
||||
{ $1 }
|
||||
|
||||
list_type :: { Type }
|
||||
: '[' list_type ']'
|
||||
{ TAp (TVar (QualifiedName ["Data","List"] "List") Star) $2 }
|
||||
| function_type
|
||||
{ $1 }
|
||||
|
||||
bang_type :: { Type }
|
||||
: list_type { $1 }
|
||||
|
||||
-- Statements in bang
|
||||
|
||||
statements :: { [Stmt Position] }
|
||||
: { [] }
|
||||
| statements statement { $1 ++ [$2] }
|
||||
|
||||
statement :: { Stmt Position }
|
||||
: assignment_statement ';' { $1 }
|
||||
| case_statement ';' { $1 }
|
||||
| expression ';' { SExpr $2 $1 }
|
||||
|
||||
assignment_statement :: { Stmt Position }
|
||||
: value_ident '=' expression -- FIXME: Too restrictive!
|
||||
{ SBind $2 $1 (SExpr $2 $3) }
|
||||
|
||||
case_statement :: { Stmt Position }
|
||||
: 'case' expression 'of' case_items
|
||||
{ SCase $1 $2 $4 }
|
||||
|
||||
case_items :: { [(Pattern,Maybe (Expr Position),(Expr Position))] }
|
||||
: case_item { [$1] }
|
||||
| case_items case_item { $1 ++ [$2] }
|
||||
|
||||
case_item :: { (Pattern, Maybe (Expr Position), (Expr Position)) }
|
||||
: pattern mguard '->' expression { ($1, $2, $4) }
|
||||
|
||||
mguard :: { Maybe (Expr Position) }
|
||||
: { Nothing }
|
||||
| '|' expression { Just $2 }
|
||||
|
||||
-- Patterns for pattern matching
|
||||
|
||||
infix_operator :: { QualifiedName }
|
||||
: OP_IDENT { makeQualified $1 }
|
||||
| '`' VAL_IDENT '`' { makeQualified $2 }
|
||||
|
||||
pattern_primary :: { Pattern }
|
||||
: TYPE_IDENT { PVar (makeQualified $1) }
|
||||
| VAL_IDENT { PVar (makeQualified $1) }
|
||||
| '[' ']' { PVar (QualifiedName ["Data","List"] "NULL") }
|
||||
| INTVAL { let (Lexeme _ (TokInt (base, val))) = $1
|
||||
in PConst (ConstInteger base val) }
|
||||
| FLOATVAL { let (Lexeme _ (TokFloat val)) = $1
|
||||
in PConst (ConstFloat val) }
|
||||
| CHARVAL { let (Lexeme _ (TokChar val)) = $1
|
||||
in PConst (ConstChar val) }
|
||||
| STRVAL { let (Lexeme _ (TokString val)) = $1
|
||||
in PConst (ConstString val) }
|
||||
| '(' pattern ')' { $2 }
|
||||
|
||||
pattern_infix :: { Pattern }
|
||||
: pattern_infix infix_operator pattern_primary { PAp (PAp $1 (PVar $2)) $3 }
|
||||
| pattern_primary { $1 }
|
||||
|
||||
pattern_ap :: { Pattern }
|
||||
: pattern_ap pattern_infix { PAp $1 $2 }
|
||||
| pattern_infix { $1 }
|
||||
|
||||
pattern_name :: { Pattern }
|
||||
: value_ident '@' pattern_name { PNamed $1 $3 }
|
||||
| pattern_ap { $1 }
|
||||
|
||||
pattern :: { Pattern }
|
||||
: pattern_name { $1 }
|
||||
|
||||
-- Expressions in bang
|
||||
|
||||
primary_expression :: { Expr Position }
|
||||
: '(' expression ')' { $2 }
|
||||
| '[' ']' { VarRef $1 (QualifiedName ["Data","List"] "NULL") }
|
||||
| INTVAL { let (Lexeme src (TokInt (base, val))) = $1
|
||||
in Const src (ConstInteger base val) }
|
||||
| FLOATVAL { let (Lexeme src (TokFloat val)) = $1
|
||||
in Const src (ConstFloat val) }
|
||||
| CHARVAL { let (Lexeme src (TokChar val)) = $1
|
||||
in Const src (ConstChar val) }
|
||||
| STRVAL { let (Lexeme src (TokString val)) = $1
|
||||
in Const src (ConstString val) }
|
||||
| VAL_IDENT { let l@(Lexeme src (TokValIdent name)) = $1
|
||||
in VarRef src (makeQualified l) }
|
||||
|
||||
conditional_expression :: { Expr Position }
|
||||
: primary_expression { $1 }
|
||||
|
||||
infix_expression :: { Expr Position }
|
||||
: infix_expression infix_operator conditional_expression
|
||||
{ App (getSpecial $1) (VarRef (getSpecial $1) $2) [$1, $3] }
|
||||
| conditional_expression
|
||||
{ $1 }
|
||||
|
||||
lambda_expression :: { Expr Position }
|
||||
: '\\' arguments '->' infix_expression
|
||||
{ Lambda $1 $2 $4 }
|
||||
| infix_expression
|
||||
{ $1 }
|
||||
|
||||
arguments :: { [QualifiedName] }
|
||||
: value_ident { [$1] }
|
||||
| arguments ',' value_ident { $1 ++ [$3] }
|
||||
|
||||
application_expression :: { Expr Position }
|
||||
: application_expression '(' app_args ')'
|
||||
{ App $2 $1 $3 }
|
||||
| application_expression '(' ')'
|
||||
{ App $2 $1 [] }
|
||||
| lambda_expression
|
||||
{ $1 }
|
||||
|
||||
app_args :: { [Expr Position] }
|
||||
: expression { [$1] }
|
||||
| app_args ',' expression { $1 ++ [$3] }
|
||||
|
||||
block_expression :: { Expr Position }
|
||||
: '{' statements '}' { Block $1 $2 }
|
||||
| application_expression { $1 }
|
||||
|
||||
expression :: { Expr Position }
|
||||
: block_expression { $1 }
|
||||
|
||||
{
|
||||
lexer :: (Lexeme -> Parser a) -> Parser a
|
||||
@@ -375,8 +389,14 @@ happyError = raiseP "Parse Error"
|
||||
pappend :: ([a],[b]) -> ([a],[b]) -> ([a],[b])
|
||||
pappend (a,b) (c,d) = (a++c,b++d)
|
||||
|
||||
makeQualified :: String -> QualifiedName
|
||||
makeQualified str = QualifiedName prefixes name
|
||||
makeQualified :: Lexeme -> QualifiedName
|
||||
makeQualified (Lexeme _ (TokTypeIdent str)) = makeQualified' str
|
||||
makeQualified (Lexeme _ (TokValIdent str)) = makeQualified' str
|
||||
makeQualified (Lexeme _ (TokOpIdent str)) = makeQualified' str
|
||||
makeQualified _ = error "makeQualified bad arg"
|
||||
|
||||
makeQualified' :: String -> QualifiedName
|
||||
makeQualified' str = QualifiedName prefixes name
|
||||
where
|
||||
(prefixes,name) = loop str
|
||||
loop val =
|
||||
@@ -385,5 +405,26 @@ makeQualified str = QualifiedName prefixes name
|
||||
then ([], pre)
|
||||
else let (pres, name) = loop rest
|
||||
in (pre:pres, name)
|
||||
|
||||
postProcessDeclVal :: QualifiedName ->
|
||||
Maybe [(QualifiedName, Maybe Type)] ->
|
||||
Maybe Type ->
|
||||
(Position, Expr Position) ->
|
||||
Parser (Decl Position)
|
||||
postProcessDeclVal name margs mrettype (src, body) = do
|
||||
final_type <- case mrettype of
|
||||
Nothing -> do
|
||||
name <- gensym
|
||||
return (TVar name Star)
|
||||
Just x ->
|
||||
return x
|
||||
case margs of
|
||||
Nothing ->
|
||||
return (DeclValue src [] final_type body)
|
||||
Just [] ->
|
||||
fail "Need to figure out empty arg items."
|
||||
Just args ->
|
||||
fail "Need to figure out non-empty arg items."
|
||||
|
||||
}
|
||||
|
||||
|
||||
@@ -37,7 +37,7 @@ pprtPosition p = posFile p ++ ":" ++ show (posLine p) ++ ":" ++ show (posCol p)
|
||||
data Token = LParen | RParen
|
||||
| LSquare | RSquare
|
||||
| LBrace | RBrace
|
||||
| Bar | Semi | Comma
|
||||
| Bar | Semi | Comma | BTick
|
||||
| TokTypeIdent String
|
||||
| TokValIdent String
|
||||
| TokOpIdent String
|
||||
@@ -90,6 +90,7 @@ data ParserState = ParserState {
|
||||
, psChar :: !Char
|
||||
, psPos :: !Position
|
||||
, psLexCode :: !Int
|
||||
, psGenNum :: !Int
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@@ -99,6 +100,7 @@ initParserState path bs = ParserState {
|
||||
, psChar = '\n'
|
||||
, psPos = initPosition path
|
||||
, psLexCode = 0
|
||||
, psGenNum = 0
|
||||
}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
@@ -138,3 +140,9 @@ runParser path bs (Parser m) =
|
||||
Right (a,_) -> Right a
|
||||
Left err -> Left err
|
||||
|
||||
genstr :: Parser String
|
||||
genstr = do
|
||||
st <- get
|
||||
set st{ psGenNum = psGenNum st + 1 }
|
||||
return $ "--gen" ++ show (psGenNum st)
|
||||
|
||||
|
||||
@@ -22,7 +22,7 @@ cmd_ghc_d_hs = $(GHC) $(GHC_FLAGS) -M -dep-makefile $@ $<
|
||||
quiet_cmd_ghc_d_hs = DEPEND $(notdir $@)
|
||||
%.d : %.hs
|
||||
$(call cmd,ghc_d_hs)
|
||||
@$(SED) -i"" "s|: hsrc|: $(TOPDIR)/hsrc|g" $@
|
||||
@$(SED) -i"" -e "s|: hsrc|: $(TOPDIR)/hsrc|g" $@
|
||||
|
||||
# ghc-ld
|
||||
cmd_ghc_ld = $(GHC) -o $@ $^
|
||||
|
||||
Reference in New Issue
Block a user