Some basic stubbed-out stuff
Getty Ritter
7 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 | } |