git @ Cat's Eye Technologies Parc / master ParcSt2StDemo.hs
master

Tree @master (Download .tar.gz)

ParcSt2StDemo.hs @masterraw · history · blame

-- Copyright (c) 2022-2023 Chris Pressey, Cat's Eye Technologies
-- This work is distributed under an MIT license.  See LICENSES directory:
-- SPDX-License-Identifier: LicenseRef-MIT-X-Parc

module ParcSt2StDemo where
import Prelude hiding (pred, seq, any)

import ParcSt2St

-- Helpers

char x = pred (\c v -> if x == c then Just v else Nothing)
try c = alt c ok
fol f [] = ok
fol f (c:cs) = seq (f c) (fol f cs)
seqn = fol (id)
str = fol (char)

-- Grammar

whitespace = char ' '
zero = (seq (char '0') (update $ \v -> v * 2))
one = (seq (char '1') (update $ \v -> v * 2 + 1))
bit = alt zero one
bits = seq bit (many bit)
bitstring = seq bits (try (char 'B'))
docco = many (seq (many whitespace) bitstring)
keyword s st = seqn [many whitespace, str s, update $ \v -> (s:v)] st
proggo = seqn $ map (keyword) ["while", "do", "that"]

-- Demo

test1 = docco $ Parsing "1110B   100B" 0
test2 = docco $ Parsing "1110G   100B" 0
test3 = proggo $ Parsing "while do that" []