comp 150 vms module 3 lab

laws

sat :  'a producer * 'a producer -> 'a producer
(p1 <|> p2) ts == case p1 ts
                    of SOME x => SOME x
                     | NONE => p2 ts

sat : ('a -> bool) -> 'a producer -> 'a producer
sat predicate p ts = case p ts
                       of result as SOME (ERROR _, _) => result
                        | SOME x => if predicate x then SOME x else NONE
                        | NONE => NONE

many  p == (curry op:: <$> p <*> many p) <|> succeed []

many1 p == curry op:: <$> p <*> many p

optional p == (SOME <$> p) <|> succeed NONE

val count : int -> 'a producer -> 'a list producer (* exactly N *)
count 0     p == succeed []
count (n+1) p == curry op:: <$> p <*> count n p

val <~> : 'a producer * 'b producer -> 'a producer
p <~> q == (fn a => fn b => a) <$> p <*> q

val >>  : 'a producer * 'b producer -> 'b producer
p >>  q == (fn a => fn b => b) <$> p <*> q

simple-parser.hs

#!/usr/bin/env stack
-- stack script --package megaparsec --package text --resolver lts-16.15

{-# LANGUAGE OverloadedStrings #-}

import           Data.Char            (digitToInt)
import           Data.Maybe           (fromMaybe)
import           Data.Text            (Text)
import           Data.Void            (Void)
import           Text.Megaparsec      (Parsec, optional, parseTest, some, (<|>))
import           Text.Megaparsec.Char (digitChar, string)

type Parser = Parsec Void Text

input :: Text
input = "13.23"

main :: IO ()
main = parseTest parseNumber input

many1 :: Parser a -> Parser [a]
many1 = some

digit :: Parser Int
digit = digitToInt <$> digitChar 

parseNumber :: Parser Double
parseNumber = combine <$> sign <*> part1 <*> part2
    where
        sign :: Parser (Double -> Double)
        sign =
            (negate <$ string "-")
            <|>
            (id <$ string "+")
            <|>
            (pure id)
        part1 :: Parser Double
        part1 = foldr (\x acc -> acc * 10 + fromIntegral x) 0 <$> many1 digit
        part2 :: Parser (Maybe Double)
        part2 = optional (string "." >> foldr (\x acc -> acc / 10 + fromIntegral x / 10) 0 <$> many1 digit)
        combine f p1 p2 = f (p1 + fromMaybe 0 p2)

simple-parser.sml

type reg = int
val reg    : reg producer             (* parses a register number *)
val int    : int producer             (* parses an integer literal *)
val string : string producer          (* parses a string literal *)
val name   : string producer          (* parses a name *)
val the    : string -> unit producer  (* one token, like a comma or bracket *)

type opcode = string
type instr (* instruction *)
val eR0 : opcode -> instr
val eR1 : opcode -> reg -> instr
val eR2 : opcode -> reg -> reg -> instr
val eR3 : opcode -> reg -> reg -> reg -> instr

(* Numbers *)

val parse_number : real producer =
    let
        val sign : (real -> real) producer =
            (fn _ => Real.negate) <$> string "-"
            <|>
            (fn _ => fn x => x) <$> string "+"
            <|>
            succeed (fn x => x)
        val part1 : real producer = 
            foldr (fn (x, acc) => acc * 10 + Int.toReal x) 0 <$> many1 int
        val part2 : real option producer =
            optional (string "." >> foldr (fn (x, acc) => acc / 10 + Int.toReal x / 10) 0 <$> many1 int)
        fun combine f p1 p2 = f (p1 + Option.getOpt (p2, 0))
    in
        combine <$> sign <*> part1 <*> part2
    end