gdritter repos sml / master
Some basic stubbed-out stuff Getty Ritter 6 years ago
6 changed file(s) with 318 addition(s) and 0 deletion(s). Collapse all Expand all
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 module Main where
2
3 main :: IO ()
4 main = return ()
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 }
1 module SML
2 (
3 ) where