acw/bang
1
0
Fork 0
Code Issues Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Changed my mind on the basic syntax; less Haskell, more C.

Browse Source
This commit is contained in:
Adam Wick
2011-01-06 23:37:31 -08:00
parent 3f14f02eb3
commit 29a358a76a
6 changed files with 301 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
hsrc/Syntax/AST.hs
View File

@@ -26,14 +26,25 @@ data ImportName = ImportNamed QualifiedName
deriving (Show)
data Show a => Decl a =
DeclData [Type] QualifiedName [QualifiedName] [DataClause]
| DeclType
| DeclNewtype
| DeclClass
| DeclInstance
| DeclValue Type QualifiedName (Expr a)
DeclData a [Type] QualifiedName [QualifiedName] [DataClause]
| DeclType a [Type]
| DeclNewtype a [Type]
| DeclClass a [Type]
| DeclInstance a [Type]
| DeclValue a [Type] Type QualifiedName [Stmt a]
| DeclExport a (Decl a)
deriving (Show)
addTypeRestrictions :: Show a => [Type] -> Decl a -> Decl a
addTypeRestrictions rs (DeclData s _ a b c) = DeclData s rs a b c
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 (DeclExport s d) =
DeclExport s (addTypeRestrictions rs d)
data DataClause = DataClause QualifiedName [Type]
deriving (Show)
@@ -46,6 +57,12 @@ data Show a => Expr a =
| Lambda a [QualifiedName] (Expr a)
deriving (Show)
data Show a => Stmt a =
SExpr a (Expr a)
| SBind a QualifiedName (Stmt a)
| SCase a
deriving (Show)
data Kind = Star | KFun Kind Kind
deriving (Eq,Show)

352
hsrc/Syntax/Parser.y
View File

@@ -17,21 +17,25 @@ import qualified Codec.Binary.UTF8.Generic as UTF8
%token
-- reserved words
'module' { Lexeme $$ (TokValIdent "module" ) }
'export' { Lexeme $$ (TokValIdent "export" ) }
'import' { Lexeme $$ (TokValIdent "import" ) }
'data' { Lexeme $$ (TokValIdent "data" ) }
'type' { Lexeme $$ (TokValIdent "type" ) }
'newtype' { Lexeme $$ (TokValIdent "newtype" ) }
'class' { Lexeme $$ (TokValIdent "class" ) }
'instance' { Lexeme $$ (TokValIdent "instance") }
'qualified' { Lexeme $$ (TokValIdent "instance") }
'as' { Lexeme $$ (TokValIdent "instance") }
'module' { Lexeme $$ (TokValIdent "module" ) }
'export' { Lexeme $$ (TokValIdent "export" ) }
'import' { Lexeme $$ (TokValIdent "import" ) }
'datatype' { Lexeme $$ (TokValIdent "datatype") }
'type' { Lexeme $$ (TokValIdent "type" ) }
'newtype' { Lexeme $$ (TokValIdent "newtype" ) }
'class' { Lexeme $$ (TokValIdent "class" ) }
'instance' { Lexeme $$ (TokValIdent "instance") }
'qualified' { Lexeme $$ (TokValIdent "qualified") }
'as' { Lexeme $$ (TokValIdent "as") }
'case' { Lexeme $$ (TokValIdent "case") }
'of' { Lexeme $$ (TokValIdent "of") }
'restrict' { Lexeme $$ (TokValIdent "restrict") }
-- symbols
'=' { Lexeme $$ (TokOpIdent "=") }
'->' { Lexeme $$ (TokOpIdent "->") }
'=>' { Lexeme $$ (TokOpIdent "=>") }
'::' { Lexeme $$ (TokOpIdent "::") }
'\\' { Lexeme $$ (TokOpIdent "\\") }
'(' { Lexeme $$ LParen }
')' { Lexeme $$ RParen }
@@ -62,73 +66,20 @@ import qualified Codec.Binary.UTF8.Generic as UTF8
%%
top_module :: { Module () } : 'module' TYPE_IDENT module_decls {
top_module :: { Module Position } : 'module' TYPE_IDENT module_decls {
let (imports,items) = $3
in Module (makeQualified $2) imports items
}
module_decls :: { ([Import], [Decl ()]) }
module_decls :: { ([Import], [Decl Position]) }
: module_decls module_decl { $1 `pappend` $2 }
| module_decl { $1 }
module_decl :: { ([Import], [Decl ()]) }
: data_decl { ([], [$1]) }
| type_decl { ([], [$1]) }
| newtype_decl { ([], [$1]) }
| class_decl { ([], [$1]) }
| instance_decl { ([], [$1]) }
| value_decl { ([], [$1]) }
| import_decl { ([$1], [] ) }
module_decl :: { ([Import], [Decl Position]) }
: import_decl ';' { ([$1], []) }
| decl ';' { ([], [$1]) }
-- Data Declarations --------------------------------------------------------
data_decl :: { Decl () }
: 'data' 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 }
: TYPE_IDENT { DataClause (makeQualified $1) [] }
| dataclause bangtype { let DataClause name items = $1
in DataClause name (items ++ [$2]) }
-- Type alias Declarations --------------------------------------------------
type_decl :: { Decl () }
: 'type' { DeclType }
newtype_decl :: { Decl () }
: 'newtype' { DeclNewtype }
class_decl :: { Decl () }
: 'class' { DeclClass }
instance_decl :: { Decl () }
: 'instance' { DeclInstance }
value_decl :: { Decl () }
: VAL_IDENT '=' expr { DeclValue undefined (makeQualified $1) $3 }
-- Import Declarations ------------------------------------------------------
import_decl :: { Import }
: 'import' mqualified TYPE_IDENT mimport_list mas
@@ -159,60 +110,235 @@ either_ident :: { QualifiedName }
: TYPE_IDENT { makeQualified $1 }
| VAL_IDENT { makeQualified $1 }
-- Types --------------------------------------------------------------------
-- Actual Declarations ------------------------------------------------------
bangtype :: { Type }
: bangtype1 { $1 }
-- A declaration starts with an optional export flag and an optional type
-- restriction flag, and then has the declaration. We apply the restrictions /
-- exports post-hoc because we're lazy.
decl :: { Decl Position }
: optional_decl_flags decl2 { $1 $2 }
bangtype1 :: { Type }
: bangtype1 VAL_IDENT { TAp $1 (TVar (makeQualified $2) Star) }
| bangtype2 { $1 }
optional_decl_flags :: { Decl Position -> Decl Position }
: { id }
| opt_export { $1 }
| opt_restrict { $1 }
| opt_export opt_restrict { $1 . $2 }
| opt_restrict opt_export { $1 . $2 }
bangtype2 :: { Type }
: bangtype2 '->' bangtype3
{ TAp (TAp (TCon (QualifiedName [] "->") Star) $1) $3 }
| bangtype3 { $1 }
opt_export :: { Decl Position -> Decl Position }
: 'export' { DeclExport $1 }
bangtype3 :: { Type }
: TYPE_IDENT { TVar (makeQualified $1) Star }
| '(' bangtype ')' { $2 }
opt_restrict :: { Decl Position -> Decl Position }
: 'restrict' '(' type_restrictions ')' { addTypeRestrictions $3 }
-- Expressions --------------------------------------------------------------
type_restrictions :: { [Type] }
: type_restriction { [$1] }
| type_restrictions ',' type_restriction { $1 ++ [$3] }
expr :: { Expr () }
: '\\' arglist '->' expr1 { Lambda () $2 $4 }
| expr1 { $1 }
type_restriction :: { Type }
: TYPE_IDENT VAL_IDENT
{ TAp (TVar (makeQualified $1) Star) (TVar (makeQualified $2) Star) }
| type_restriction VAL_IDENT
{ TAp $1 (TVar (makeQualified $2) Star) }
arglist :: { [QualifiedName] }
: VAL_IDENT { [makeQualified $1] }
| arglist VAL_IDENT { $1 ++ [makeQualified $2] }
decl2 :: { Decl Position }
: data_decl { $1 }
| type_decl { $1 }
| newtype_decl { $1 }
| class_decl { $1 }
| instance_decl { $1 }
| value_decl { $1 }
expr1 :: { Expr () }
: '{' exprs '}' { Block () $2 }
| expr2 { $1 }
-- Data Declarations --------------------------------------------------------
exprs :: { [Expr ()] }
: expr ';' { [$1] }
| exprs expr ';' { $1 ++ [$2] }
data_decl :: { Decl Position }
: 'datatype' { undefined }
expr2 :: { Expr () }
: '[' list_exprs ']' { unwindList $2 }
| expr3 { $1 }
-- Type Declarations --------------------------------------------------------
list_exprs :: { [Expr ()] }
: { [] }
| list_exprs ',' expr3 { $1 ++ [$3] }
type_decl :: { Decl Position }
: 'type' { undefined }
expr3 :: { Expr () }
: bottom_expr { $1 }
-- Newtype Declarations -----------------------------------------------------
bottom_expr :: { Expr () }
: INTVAL { let (b,v) = $1 in Const () (ConstInteger b v) }
| FLOATVAL { Const () (ConstFloat $1) }
| CHARVAL { Const () (ConstChar $1) }
| STRVAL { Const () (ConstString $1) }
| VAL_IDENT { VarRef () (makeQualified $1) }
| '(' expr ')' { $2 }
newtype_decl :: { Decl Position }
: 'newtype' { undefined }
-- Class Declarations -------------------------------------------------------
class_decl :: { Decl Position }
: 'class' { undefined }
-- Instance Declarations ----------------------------------------------------
instance_decl :: { Decl Position }
: 'instance' { undefined }
-- Value Declaration --------------------------------------------------------
value_decl :: { Decl Position }
: value_ident optional_args optional_type { undefined }
optional_args :: { Maybe [(QualifiedName, Maybe Type)] }
: '(' optional_args2 ')' { Just $2 }
| { Nothing }
optional_args2 :: { [(QualifiedName, Maybe Type)] }
: optional_arg { [$1] }
| optional_args2 ',' optional_arg { $1 ++ [$3] }
optional_arg :: { (QualifiedName, Maybe Type) }
: value_ident optional_type { ($1, $2) }
optional_type :: { Maybe Type }
: { Nothing }
| '::' bang_type { Just $2 }
value_ident :: { QualifiedName }
: VAL_IDENT { makeQualified $1 }
| '(' OP_IDENT ')' { makeQualified $2 }
-- Types in Bang ------------------------------------------------------------
bang_type :: { Type }
: TYPE_IDENT { TVar (makeQualified $1) Star }
--
-- 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 }
{
lexer :: (Lexeme -> Parser a) -> Parser a
@@ -224,12 +350,6 @@ happyError = raiseP "Parse Error"
pappend :: ([a],[b]) -> ([a],[b]) -> ([a],[b])
pappend (a,b) (c,d) = (a++c,b++d)
unwindList :: [Expr ()] -> Expr ()
unwindList [] = Const () ConstEmpty
unwindList (a:rest) =
App () (App () (VarRef () (QualifiedName ["Data","List"] ":")) a)
(unwindList rest)
makeQualified :: String -> QualifiedName
makeQualified str = QualifiedName prefixes name
where