Some basic stubbed-out stuff
Getty Ritter
6 years ago
1 | dist | |
2 | dist-* | |
3 | *~ | |
4 | cabal-dev | |
5 | *.o | |
6 | *.hi | |
7 | *.chi | |
8 | *.chs.h | |
9 | *.dyn_o | |
10 | *.dyn_hi | |
11 | .hpc | |
12 | .hsenv | |
13 | .cabal-sandbox/ | |
14 | cabal.sandbox.config | |
15 | *.prof | |
16 | *.aux | |
17 | *.hp | |
18 | *.eventlog | |
19 | cabal.project.local | |
20 | .ghc.environment.* |
1 | name: sml | |
2 | version: 0.1.0.0 | |
3 | -- synopsis: | |
4 | -- description: | |
5 | license: BSD3 | |
6 | author: Getty Ritter <samothes@infinitenegativeutility.com> | |
7 | maintainer: Getty Ritter <samothes@infinitenegativeutility.com> | |
8 | copyright: @2018 Getty Ritter | |
9 | -- category: | |
10 | build-type: Simple | |
11 | cabal-version: >=1.14 | |
12 | ||
13 | library | |
14 | hs-source-dirs: src | |
15 | ghc-options: -Wall | |
16 | build-depends: base >=4.7 && <5 | |
17 | , text | |
18 | , alex-tools | |
19 | , array | |
20 | build-tools: happy | |
21 | , alex | |
22 | default-language: Haskell2010 | |
23 | default-extensions: ScopedTypeVariables | |
24 | exposed-modules: SML | |
25 | SML.AST | |
26 | SML.Lexer | |
27 | ||
28 | executable sml | |
29 | hs-source-dirs: sml | |
30 | main-is: Main.hs | |
31 | default-language: Haskell2010 | |
32 | default-extensions: ScopedTypeVariables | |
33 | ghc-options: -Wall | |
34 | build-depends: base >=4.7 && <5 |
1 | {-# LANGUAGE DataKinds #-} | |
2 | {-# LANGUAGE TypeFamilies #-} | |
3 | {-# LANGUAGE StandaloneDeriving #-} | |
4 | {-# LANGUAGE FlexibleContexts #-} | |
5 | {-# LANGUAGE UndecidableInstances #-} | |
6 | ||
7 | module SML.AST where | |
8 | ||
9 | type Ident = String | |
10 | type Label = String | |
11 | ||
12 | -- | |
13 | ||
14 | data Phase | |
15 | = Raw | |
16 | deriving (Eq, Show) | |
17 | ||
18 | type family TypeAnnot (p :: Phase) where | |
19 | TypeAnnot 'Raw = () | |
20 | ||
21 | -- | |
22 | ||
23 | data Exp (p :: Phase) | |
24 | = SconExp | |
25 | | LongviExp | |
26 | | RowExp (ExpRow p) | |
27 | | RecordSelExp Ident | |
28 | | UnitExp [Exp p] | |
29 | | ListExp [Exp p] | |
30 | | SequenceExp [Exp p] | |
31 | | LetExp (Dec p) [Exp p] | |
32 | | AppExp (Exp p) (Exp p) | |
33 | | InfExp (Exp p) Ident (Exp p) | |
34 | | TypExp (Exp p) (Ty p) | |
35 | | AndAlsoExp (Exp p) (Exp p) | |
36 | | OrElseExp (Exp p) (Exp p) | |
37 | | HandleExp (Exp p) (Match p) | |
38 | | RaiseExp (Exp p) | |
39 | | ITEExp (Exp p) (Exp p) (Exp p) | |
40 | | WhileExp (Exp p) (Exp p) | |
41 | | CaseExp (Exp p) (Exp p) | |
42 | | FnExp (Match p) | |
43 | ||
44 | deriving instance Show (TypeAnnot p) => Show (Exp p) | |
45 | ||
46 | -- | |
47 | ||
48 | data ExpRow (p :: Phase) | |
49 | = ExpRow [(Label, Exp p)] | |
50 | ||
51 | deriving instance Show (TypeAnnot p) => Show (ExpRow p) | |
52 | ||
53 | -- | |
54 | ||
55 | data Match (p :: Phase) | |
56 | = Match [(Pat p, Exp p)] | |
57 | deriving instance Show (TypeAnnot p) => Show (Match p) | |
58 | ||
59 | -- | |
60 | ||
61 | data Pat (p :: Phase) | |
62 | = WildPat | |
63 | | SconPat | |
64 | | ValuePat | |
65 | | RecordPat (PatRow p) | |
66 | | UnitPat | |
67 | | TuplePat [Pat p] | |
68 | | ListPat [Pat p] | |
69 | | ConstrPat Ident (Pat p) | |
70 | ||
71 | ||
72 | deriving instance Show (TypeAnnot p) => Show (Pat p) | |
73 | ||
74 | -- | |
75 | ||
76 | data PatRow (p :: Phase) | |
77 | = PatRow [(Label, Exp p)] | |
78 | ||
79 | deriving instance Show (TypeAnnot p) => Show (PatRow p) | |
80 | ||
81 | -- | |
82 | ||
83 | data Ty (p :: Phase) | |
84 | deriving instance Show (TypeAnnot p) => Show (Ty p) | |
85 | ||
86 | -- | |
87 | ||
88 | data Dec (p :: Phase) | |
89 | -- = ValDec (TyVarSeq p) (ValBind p) | |
90 | -- | FunDec (TyVarSeq p) (FunBind p) | |
91 | -- | TypeDec (TypBind p) | |
92 | ||
93 | deriving instance Show (TypeAnnot p) => Show (Dec p) | |
94 | ||
95 | data ValBind (p :: Phase) | |
96 | = ValbindEq (Pat p) (Exp p) (Maybe (ValBind p)) | |
97 | | Rec (ValBind p) | |
98 | ||
99 | deriving instance Show (TypeAnnot p) => Show (ValBind p) | |
100 | ||
101 | data FunBind (p :: Phase) | |
102 | deriving instance Show (TypeAnnot p) => Show (FunBind p) | |
103 | ||
104 | -- | |
105 | ||
106 | data Literal | |
107 | = IntLiteral Integer | |
108 | deriving (Eq, Show) |
1 | { | |
2 | {-# LANGUAGE RecordWildCards #-} | |
3 | ||
4 | module SML.Lexer where | |
5 | ||
6 | import AlexTools | |
7 | import qualified Data.Char as Char | |
8 | import qualified Data.Text as T | |
9 | } | |
10 | ||
11 | $digit = [0-9] | |
12 | ||
13 | :- | |
14 | ||
15 | <0> { | |
16 | $white+ ; | |
17 | ||
18 | "abstype" { keyword KAbstype} | |
19 | "and" { keyword KAnd } | |
20 | "andalso" { keyword KAndAlso } | |
21 | "as" { keyword KAs } | |
22 | "case" { keyword KCase } | |
23 | "datatype" { keyword KDatatype } | |
24 | "do" { keyword KDo } | |
25 | "else" { keyword KElse } | |
26 | "end" { keyword KEnd } | |
27 | "exception" { keyword KException } | |
28 | "fn" { keyword KFn } | |
29 | "fun" { keyword KFun } | |
30 | "handle" { keyword KHandle } | |
31 | "if" { keyword KIf } | |
32 | "in" { keyword KIn } | |
33 | "infix" { keyword KInfix } | |
34 | "infixr" { keyword KInfixr } | |
35 | "let" { keyword KLet } | |
36 | "local" { keyword KLocal } | |
37 | "nonfix" { keyword KNonfix } | |
38 | "of" { keyword KOf } | |
39 | "op" { keyword KOp } | |
40 | "open" { keyword KOpen } | |
41 | "orelse" { keyword KOrElse } | |
42 | "raise" { keyword KRaise } | |
43 | "rec" { keyword KRec } | |
44 | "then" { keyword KThen } | |
45 | "type" { keyword KType } | |
46 | "val" { keyword KVal } | |
47 | "with" { keyword KWith } | |
48 | "withType" { keyword KWithType } | |
49 | "while" { keyword KWhile } | |
50 | ||
51 | "[" { token TkLBrac } | |
52 | "]" { token TkRBrac } | |
53 | "(" { token TkLPar } | |
54 | ")" { token TkRPar } | |
55 | "{" { token TkLCurl } | |
56 | "}" { token TkRCurl } | |
57 | "," { token TkComma } | |
58 | ":" { token TkColon } | |
59 | ";" { token TkSemi } | |
60 | "..." { token TkEllipsis } | |
61 | "_" { token TkUnder } | |
62 | "|" { token TkBar } | |
63 | "=" { token TkEq } | |
64 | "=>" { token TkFatArrow } | |
65 | "->" { token TkArrow } | |
66 | "#" { token TkOcto } | |
67 | ||
68 | } | |
69 | ||
70 | { | |
71 | data Token | |
72 | = TkKeyword Keyword | |
73 | | TkLBrac | |
74 | | TkRBrac | |
75 | | TkLPar | |
76 | | TkRPar | |
77 | | TkLCurl | |
78 | | TkRCurl | |
79 | | TkComma | |
80 | | TkColon | |
81 | | TkSemi | |
82 | | TkEllipsis | |
83 | | TkUnder | |
84 | | TkBar | |
85 | | TkEq | |
86 | | TkFatArrow | |
87 | | TkArrow | |
88 | | TkOcto | |
89 | deriving (Eq, Show) | |
90 | ||
91 | data Keyword | |
92 | = KAbstype | |
93 | | KAnd | |
94 | | KAndAlso | |
95 | | KAs | |
96 | | KCase | |
97 | | KDatatype | |
98 | | KDo | |
99 | | KElse | |
100 | | KEnd | |
101 | | KException | |
102 | | KFn | |
103 | | KFun | |
104 | | KHandle | |
105 | | KIf | |
106 | | KIn | |
107 | | KInfix | |
108 | | KInfixr | |
109 | | KLet | |
110 | | KLocal | |
111 | | KNonfix | |
112 | | KOf | |
113 | | KOp | |
114 | | KOpen | |
115 | | KOrElse | |
116 | | KRaise | |
117 | | KRec | |
118 | | KThen | |
119 | | KType | |
120 | | KVal | |
121 | | KWith | |
122 | | KWithType | |
123 | | KWhile | |
124 | deriving (Eq, Show) | |
125 | ||
126 | data Mode | |
127 | = Normal | |
128 | deriving (Show) | |
129 | ||
130 | ||
131 | emits :: (T.Text -> Token) -> Action Mode [Lexeme Token] | |
132 | emits mkToken = | |
133 | do lexemeText <- matchText | |
134 | lexemeRange <- matchRange | |
135 | return [Lexeme { lexemeToken = mkToken lexemeText, .. }] | |
136 | ||
137 | token :: Token -> Action Mode [Lexeme Token] | |
138 | token tok = emits (const tok) | |
139 | ||
140 | keyword :: Keyword -> Action Mode [Lexeme Token] | |
141 | keyword k = token (TkKeyword k) | |
142 | ||
143 | alexGetByte :: AlexInput -> Maybe (Word8, AlexInput) | |
144 | alexGetByte = makeAlexGetByte $ \c -> | |
145 | if Char.isAscii c | |
146 | then toEnum (fromEnum c) | |
147 | else 0x1 | |
148 | ||
149 | } |