source: proto/pabloH/ParsePablo.hs @ 5596

Last change on this file since 5596 was 4863, checked in by cameron, 4 years ago

Pablo prototypes in Haskell

File size: 5.1 KB
Line 
1module ParsePablo(parsePablo, parseExpr, parseFactor, parseTerm, parseStmt, parseStmts, lexer, PabloE(..), PabloS(..), Token(..)) where
2
3import Data.Char
4
5data PabloE = All(Int) | Var(String) | And(PabloE, PabloE) | Or(PabloE, PabloE) | Xor(PabloE, PabloE)
6               | Not(PabloE) | Advance(PabloE, Int) | MatchStar(PabloE, PabloE)
7   deriving Show
8
9data PabloS = Assign(String, PabloE) |  If (PabloE, [PabloS], [PabloS])| While (PabloE, [PabloS])
10   deriving Show
11
12
13
14data Token = Equal | Colon | ParenLeft | ParenRight | Period |AndOp | OrOp | XorOp | NotOp 
15                                | IfKw | WhileKw | ElseKw | AdvanceKw | MatchstarKw | IntToken Int | VarToken [Char] 
16                                | AllZeroes | AllOnes | BadToken [Char]
17                                deriving Show
18
19lexer :: [Char] -> [Token]
20
21lexer [] = []
22lexer (':' : more) = Colon : (lexer more) 
23lexer ('=' : more) = Equal : (lexer more) 
24lexer ('(' : more) = ParenLeft : (lexer more) 
25lexer (')' : more) = ParenRight : (lexer more) 
26lexer ('.' : more) = Period : (lexer more) 
27lexer ('&' : more) = AndOp : (lexer more) 
28lexer ('|' : more) = OrOp : (lexer more) 
29lexer ('^' : more) = XorOp : (lexer more) 
30lexer ('~' : more) = NotOp : (lexer more) 
31lexer (' ' : more) = lexer more
32lexer ('\n' : more) = lexer more
33lexer ('0':'0':'0':'.':'.':'.':more) = AllZeroes: (lexer more)
34lexer ('1':'1':'1':'.':'.':'.':more) = AllOnes: (lexer more)
35lexer (ch1:more)
36   | isDigit ch1  = lexInt (more, ord(ch1) - 48)
37   | isLetter ch1 = lexVarOrKW (span (\ch-> isDigit(ch) || isLetter(ch) || ch == '_') (ch1:more))
38   | otherwise = (BadToken [ch1]) : (lexer more)
39
40lexVarOrKW("if", afterIf) = IfKw:(lexer afterIf)
41lexVarOrKW("else", ':':afterColon) = ElseKw:(lexer afterColon)
42lexVarOrKW("while", afterWhile) = WhileKw:(lexer afterWhile)
43lexVarOrKW("MatchStar", more) = MatchstarKw:(lexer more)
44lexVarOrKW("Advance", more) = AdvanceKw:(lexer more)
45lexVarOrKW(s, more) = VarToken s:(lexer more)
46
47lexInt :: ([Char], Int) -> [Token]
48lexInt([],numSoFar) = [IntToken numSoFar]
49lexInt(d:more,numSoFar) 
50  | isDigit(d)    = lexInt(more, numSoFar * 10 + (ord(d) - 48))
51  | otherwise     = (IntToken numSoFar) : (lexer (d:more))
52
53parseStmts :: [Token] -> ([PabloS], [Token])
54
55parseStmts [] = ([], [])
56parseStmts tokens =
57        case parseStmt(tokens) of
58                Nothing -> ([], tokens)
59                Just (t, tokens1) -> 
60                    let (stmts, tokens2) = parseStmts tokens1
61                    in (t:stmts, tokens2)
62
63parseStmt :: [Token] -> Maybe (PabloS, [Token])
64
65parseStmt [] = Nothing
66parseStmt (VarToken v:Equal:afterEq) =
67        case parseExpr(afterEq) of
68                Just (e, tokens) -> Just (Assign (v, e), tokens)
69                _ -> Nothing
70
71parseStmt (IfKw : afterIf) =
72        case parseExpr(afterIf) of 
73                Just (e, Colon:afterColon) ->
74                        case parseStmts(afterColon) of
75                                (thenStmts, ElseKw:afterElse) ->
76                                        case parseStmts(afterElse) of
77                                                (elseStmts, Period:afterPeriod) -> Just(If(e, thenStmts, elseStmts), afterPeriod)
78                                                _ -> Nothing
79                                (thenStmts, Period:afterPeriod) -> Just (If(e, thenStmts, []), afterPeriod)
80                                _ -> Nothing
81                _ -> Nothing
82
83parseStmt (WhileKw : afterWhile) =
84        case parseExpr(afterWhile) of 
85                Just (e, Colon:afterColon) ->
86                        case parseStmts(afterColon) of
87                                (repeatStmts, Period:afterPeriod) -> Just(While(e, repeatStmts), afterPeriod)
88                                _ -> Nothing
89                _ -> Nothing
90
91parseStmt _ = Nothing
92
93parseExpr :: [Token] -> Maybe (PabloE, [Token])
94
95parseExpr s =
96        case parseTerm(s) of
97                Just (term1, afterTerm) -> extendExpr(term1, afterTerm)
98                _ -> Nothing
99
100extendExpr(e1, []) = Just (e1, [])
101extendExpr(e1, (OrOp:afterOr)) =
102        case parseTerm(afterOr) of
103                Just (t2, afterTerm) -> extendExpr(Or(e1, t2), afterTerm)
104                _ -> Nothing
105extendExpr(e1, (XorOp:afterXor)) =
106        case parseTerm(afterXor) of
107                Just (t2, afterTerm) -> extendExpr(Xor(e1, t2), afterTerm)
108                _ -> Nothing
109extendExpr(e1, ts) = Just (e1, ts)
110
111parseTerm :: [Token] -> Maybe (PabloE, [Token])
112
113parseTerm s =
114        case parseFactor(s) of
115                Just (factor1, afterFactor) -> extendTerm(factor1, afterFactor)
116                _ -> Nothing
117
118extendTerm(e1, (AndOp:afterAnd)) =
119        case parseFactor(afterAnd) of
120                Just (f2, afterFactor) -> extendTerm(And(e1, f2), afterFactor)
121                _ -> Nothing
122extendTerm(e1, ts) = Just (e1, ts)
123
124
125
126parseFactor :: [Token] -> Maybe (PabloE, [Token])
127
128parseFactor (AllZeroes:more) = Just (All 0, more) 
129parseFactor (AllOnes:more) = Just (All 1, more)
130parseFactor (VarToken v:more) = Just (Var v, more)
131parseFactor (ParenLeft:afterParenL) =
132        case parseExpr(afterParenL) of 
133                 Just (e, ParenRight:afterParenR) -> Just (e, afterParenR)
134                 _ -> Nothing
135parseFactor (MatchstarKw:afterMatchstar) =
136        case parseExpr(afterMatchstar) of 
137                        Just (e, afterExpr) ->       
138                                case parseExpr(afterExpr) of 
139                                        Just (e2, afterExpr2) -> Just (MatchStar(e, e2), afterExpr2)
140                                        _ -> Nothing
141                        _ -> Nothing
142parseFactor (AdvanceKw:afterAdvance) =
143                case parseExpr(afterAdvance) of 
144                        Just (e, IntToken n:afterInt) -> Just (Advance(e, n), afterInt)
145                        _ -> Nothing
146parseFactor (NotOp:afterNot) = 
147                case parseExpr(afterNot) of 
148                        Just (e, afterExpr) -> Just (Not(e), afterExpr)
149                        _ -> Nothing
150parseFactor _ = Nothing       
151
152parsePablo :: [Char] -> Maybe [PabloS]
153parsePablo input = 
154        case parseStmts (lexer input) of 
155                 (stmts, []) -> Just stmts
156                 _ -> Nothing
157
Note: See TracBrowser for help on using the repository browser.