haskellf#fsharp-typeclasses

translate Haskell (monadic) to F#


Help me translate following block of the Haskell code. The run function produces text string that corresponding to a given regex that abstracted as Pattern. Declaration of the type Pattern you can see below in the block of F# code. You can test run function like

genex $ POr [PConcat [PEscape( DoPa 1) 'd'], PConcat [PEscape (DoPa 2) 'd']]

{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
import qualified Data.Text as T
import qualified Control.Monad.Stream as Stream
import Text.Regex.TDFA.Pattern
import Control.Monad.State
import Control.Applicative

genex = Stream.toList . run

maxRepeat :: Int
maxRepeat = 3

each = foldl1 (<|>) . map return

run :: Pattern -> Stream.Stream T.Text
run p = case p of
    PBound low high p -> do
        n <- each [low..maybe (low+maxRepeat) id high]
        fmap T.concat . sequence $ replicate n (run p) 
    PConcat ps -> fmap T.concat . Stream.suspended . sequence $ map run ps
    POr xs -> foldl1 mplus $ map run xs
    PEscape {..} -> case getPatternChar of
        'd' -> chars $ ['0'..'9']
        'w' -> chars $ ['0'..'9'] ++ '_' : ['a'..'z'] ++ ['A'..'Z']
        ch  -> isChar ch
    _      -> error $ show p
    where
    isChar = return . T.singleton
    chars = each . map T.singleton

Below I give my poor attempt. It works but incorrectly. The problem is in the following. Let assume parse produces Pattern like that

parse "\\d\\d";; val it : Pattern = POr [PConcat [PEscape (DoPa 1,'d'); PEscape (DoPa 2,'d')]]

and

parse "\\d{2}";; val it : Pattern = POr [PConcat [PBound (2,Some 2,PEscape (DoPa 1,'d'))]]

So feeding both patterns to run I expect to receive seq [['2'; '2']; ['2'; '3']; ['2'; '1']; ['2'; '4']; ...] that corresponding to seq ["22"; "23"; "21"; "24"; ...] (2 symbols per string)

This is valid in the first case,

POr [PConcat [PEscape (DoPa 1,'d'); PEscape (DoPa 2,'d')]] |> run;; val it : seq = seq [['2'; '2']; ['2'; '3']; ['2'; '1']; ['2'; '4']; ...]

seq ["22"; "23"; "21"; "24"; ...]

but not in the second

POr [PConcat [PBound (2,Some 2,PEscape (DoPa 1,'d'))]] |> run;; val it : seq = seq [['2']; ['2']; ['2']; ['3']; ...]

seq ["2"; "2", "2"; "3", "2"; "1", "2"; "4";...] (1 symbol per string)

I tested different variants with the following clauses:

| POr ps                -> Seq.concat (List.map run ps)
| PConcat ps            -> (sequence (List.map (run >> Seq.concat) ps))
| PBound (low,high,p)   -> 

but all in vain. I can't figure out the valid translation.

-Maybe I should use String or Array instead of char list.

-And I assume that Seq is quite good analogue to Control.Monad.Stream. Is it right?

Thanks in advance for help

open System

/// Used to track elements of the pattern that accept characters or are anchors
type DoPa = DoPa of int

/// Pattern is the type returned by the regular expression parser.
/// This is consumed by the CorePattern module and the tender leaves
/// are nibbled by the TNFA module.
type Pattern = PEmpty
             | POr     of Pattern list                  // flattened by starTrans
             | PConcat of Pattern list                  // flattened by starTrans
             | PBound  of int * (int option) * Pattern  // eliminated by starTrans
             | PEscape of DoPa * char                   // Backslashed Character

let maxRepeat = 3

let maybe deflt f opt = 
    match opt with
    | None -> deflt
    | Some v -> f v

/// Cartesian production
/// try in F# interactive: sequence [[1;2];[3;4]];;
let rec sequence = function 
  | []      -> Seq.singleton [] 
  | (l::ls) -> seq { for x in l do for xs in sequence ls do yield (x::xs) } 



let from'space'to'tilda     =  [' '..'~'] |> List.ofSeq
let numbers                 =  ['0'..'9'] |> List.ofSeq
let numbers'and'alphas      =  (['0'..'9'] @ '_' :: ['a'..'z'] @ ['A'..'Z']) |> List.ofSeq
let whites                  =  ['\009'; '\010'; '\012'; '\013'; '\032' ] |> List.ofSeq

let rec run (p:Pattern) : seq<char list> =
    let chars chs = seq { yield [for s in chs -> s] }
    match p with
    | POr ps                -> Seq.concat (List.map run ps)
    | PConcat ps            -> (sequence (List.map (run >> Seq.concat) ps))
    | PBound (low,high,p)   -> 
        let ns = seq {low .. maybe (low + maxRepeat) id high}
        Seq.concat (seq { for n in ns do yield  sequence (List.replicate n (((run >> Seq.concat)  p))) })
        // Seq.concat (seq { for n in ns do yield     ((List.replicate n (run p)) |> Seq.concat |> List.ofSeq |> sequence)})
        //((List.replicate low (run p)) |> Seq.concat |> List.ofSeq |> sequence)
        // PConcat [ for n in ns -> p] |> run
    | PEscape(_, ch)  -> 
        match ch with
        | 'd' -> chars numbers
        | 'w' -> chars numbers'and'alphas
        | ch  -> chars [ch]
    | _                     -> Seq.empty

Solution

  • I don't know why you didn't translate Data.Text from Haskell to string in F#, you just need to mimic two functions. Apart from that I did just a few changes to make it work, this way you can compare it easily with your original code, see replaced code between (* *)

    open System
    
    // Mimic Data.Text as T
    module T =
        let concat (x:seq<_>) = System.String.Concat x
        let singleton (x:char) = string x
    
    
    /// Used to track elements of the pattern that accept characters or are anchors
    type DoPa = DoPa of int
    
    /// Pattern is the type returned by the regular expression parser.
    /// This is consumed by the CorePattern module and the tender leaves
    /// are nibbled by the TNFA module.
    type Pattern = PEmpty
                 | POr     of Pattern list                  // flattened by starTrans
                 | PConcat of Pattern list                  // flattened by starTrans
                 | PBound  of int * (int option) * Pattern  // eliminated by starTrans
                 | PEscape of DoPa * char                   // Backslashed Character
    
    let maxRepeat = 3
    
    let maybe deflt f opt = 
        match opt with
        | None -> deflt
        | Some v -> f v
    
    /// Cartesian production
    /// try in F# interactive: sequence [[1;2];[3;4]];;
    let rec sequence = function 
      | []      -> Seq.singleton [] 
      | (l::ls) -> seq { for x in l do for xs in sequence ls do yield (x::xs) } 
    
    
    
    let from'space'to'tilda     =  [' '..'~'] |> List.ofSeq
    let numbers                 =  ['0'..'9'] |> List.ofSeq
    let numbers'and'alphas      =  (['0'..'9'] @ '_' :: ['a'..'z'] @ ['A'..'Z']) |> List.ofSeq
    let whites                  =  ['\009'; '\010'; '\012'; '\013'; '\032' ] |> List.ofSeq
    
    let rec run (p:Pattern) (*: seq<char list> *) =
        (* let chars chs = seq { yield [for s in chs -> s] } *)
        let chars (chs:seq<char>)  = Seq.map string chs
    
        match p with
        | POr ps                -> Seq.concat (List.map run ps)
        | PConcat ps            -> Seq.map T.concat << sequence <| List.map run ps (* (sequence (List.map (run >> Seq.concat) ps)) *) 
        | PBound (low,high,p)   -> 
            seq {
            for n in [low..maybe (low+maxRepeat) id high] do
                yield! (  (Seq.map T.concat << sequence) (List.replicate n (run p)) )}
            (*let ns = seq {low .. maybe (low + maxRepeat) id high}
            Seq.concat (seq { for n in ns do yield  sequence (List.replicate n (((run >> Seq.concat)  p)))  *)
    
            // Seq.concat (seq { for n in ns do yield     ((List.replicate n (run p)) |> Seq.concat |> List.ofSeq |> sequence)})
            //((List.replicate low (run p)) |> Seq.concat |> List.ofSeq |> sequence)
            // PConcat [ for n in ns -> p] |> run
        | PEscape(_, ch)  -> 
            match ch with
            | 'd' -> chars numbers
            | 'w' -> chars numbers'and'alphas
            | ch  -> chars [ch]
        | _                     -> Seq.empty  
    


    UPDATE

    If you are translating Haskell code to F# you may try using this code which mimics many Haskell functions, including those using Type Classes. I did a test translating as close as possible to your original Haskell code but using F# List (not lazy) and looks like this:

    #load "Prelude.fs"
    #load "Monad.fs"
    #load "Applicative.fs"
    #load "Monoid.fs"
    
    open Prelude
    open Control.Monad.Base
    open Control.Applicative
    
    module T =
        let concat (x:list<_>) = System.String.Concat x
        let singleton (x:char) = string x
    
    type DoPa = DoPa of int
    
    type Pattern = PEmpty
                 | POr     of Pattern list
                 | PConcat of Pattern list
                 | PBound  of int * (int option) * Pattern
                 | PEscape of DoPa * char
    
    let maxRepeat = 3
    
    let inline each   x = foldl1 (<|>) << map return'  <| x
    
    let rec run p:list<_> = 
        let inline isChar x = return' << T.singleton   <| x
        let inline chars  x = each << map T.singleton  <| x
        match p with
        | PBound (low,high,p) -> do' {
            let! n = each [low..maybe (low+maxRepeat) id high]
            return! (fmap T.concat << sequence <| replicate n (run p))}
        | PConcat ps -> fmap T.concat << sequence <| map run ps
        | POr xs -> foldl1 mplus <| map run xs
        | PEscape (_, ch) -> 
            match ch with
            | 'd' -> chars <| ['0'..'9']
            | 'w' -> chars <| ['0'..'9'] @ '_' :: ['a'..'z'] @ ['A'..'Z']
            | ch  -> isChar ch
        | _  -> failwith <| string p
    
    let genex = run