module Gibbon.L1.GenSML where

import Gibbon.L1.Syntax
import Gibbon.Common

import Text.PrettyPrint hiding ((<>))
import Data.Maybe
import Control.Monad
import Data.Map hiding (foldr, fold, null, empty)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Data.Foldable hiding ( toList )
import Data.Graph
import Data.Tree ( flatten )


ppExt :: E1Ext () Ty1 -> Doc
ppExt :: E1Ext () Ty1 -> Doc
ppExt E1Ext () Ty1
ext0 = case E1Ext () Ty1
ext0 of
  BenchE Var
_var [()]
_uts [PreExp E1Ext () Ty1]
_pes Bool
_b -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"BenchE"
  AddFixed Var
_var Int
_n -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"AddFixed"
  StartOfPkdCursor Var
_var -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"StartOfPkdCursor"

ppE :: Exp1 -> Doc
ppE :: PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
e0 = case PreExp E1Ext () Ty1
e0 of
  VarE Var
var -> Var -> Doc
ppVar Var
var
  LitE Int
n -> Int -> Doc
int Int
n
  CharE Char
c -> Char -> Doc
char Char
c
  FloatE Double
x -> Double -> Doc
double Double
x
  LitSymE Var
var -> Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar Var
var
  AppE Var
var [()]
_ [PreExp E1Ext () Ty1]
pes -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp (Var -> Doc
ppVar Var
var) [PreExp E1Ext () Ty1]
pes
  PrimAppE Prim Ty1
pr [PreExp E1Ext () Ty1]
pes -> Prim Ty1 -> [PreExp E1Ext () Ty1] -> Doc
ppPrim Prim Ty1
pr [PreExp E1Ext () Ty1]
pes
  LetE (Var
v, [()]
_, Ty1
_, PreExp E1Ext () Ty1
e) PreExp E1Ext () Ty1
pe' ->
    [Doc] -> Doc
hsep
      [ Doc
"\n  let val", Var -> Doc
ppVar Var
v, Doc
"="
      , PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
e, Doc
"in"
      , PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe', Doc
"end"
      ]
  IfE PreExp E1Ext () Ty1
pe' PreExp E1Ext () Ty1
pe2 PreExp E1Ext () Ty1
pe3 ->
    (Doc
"\n  " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ Doc
"if", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe'
      , Doc
"then", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe2
      , Doc
"\n   else", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe3
      ]
  MkProdE [PreExp E1Ext () Ty1]
pes -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes
  ProjE Int
0 PreExp E1Ext () Ty1
pe' -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
    [ Doc
"case", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe', Doc
"of"
    , Doc
"(t0, _) => t0"
    ]
  ProjE Int
1 PreExp E1Ext () Ty1
pe' -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
    [ Doc
"case", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe', Doc
"of"
    , Doc
"(_, t1) => t1"
    ]
  ProjE Int
n PreExp E1Ext () Ty1
pe' -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [[Doc] -> Doc
hcat [Doc
"#", Int -> Doc
int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
n], PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe']
  CaseE PreExp E1Ext () Ty1
pe' [([Char], [(Var, ())], PreExp E1Ext () Ty1)]
x0 ->
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ [Doc] -> Doc
hsep [Doc
"case", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe', Doc
"of"]
      , Doc -> [Doc] -> Doc
interleave Doc
"\n  |" ((\([Char]
dc, [(Var, ())]
vs, PreExp E1Ext () Ty1
e) -> [Doc] -> Doc
hsep
        [ [Char] -> Doc
text [Char]
dc
        , case [(Var, ())]
vs of
          [] -> Doc
forall a. Monoid a => a
mempty
          [(Var, ())]
_ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar (Var -> Doc) -> ((Var, ()) -> Var) -> (Var, ()) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, ()) -> Var
forall a b. (a, b) -> a
fst ((Var, ()) -> Doc) -> [(Var, ())] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, ())]
vs
        , Doc
"=>", PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
e
        ]) (([Char], [(Var, ())], PreExp E1Ext () Ty1) -> Doc)
-> [([Char], [(Var, ())], PreExp E1Ext () Ty1)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], [(Var, ())], PreExp E1Ext () Ty1)]
x0)
      ]
  DataConE ()
_ty0 [Char]
s [] -> [Char] -> Doc
text [Char]
s
  DataConE ()
_ty0 [Char]
s [PreExp E1Ext () Ty1]
pes ->
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ [Char] -> Doc
text [Char]
s
      , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes
      ]

  TimeIt PreExp E1Ext () Ty1
_pe' Ty1
_ty0 Bool
_b -> Doc
_
  WithArenaE Var
_var PreExp E1Ext () Ty1
_pe' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"WithArenaE"
  SpawnE Var
_var [()]
_ty0s [PreExp E1Ext () Ty1]
_pes -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SpawnE"
  PreExp E1Ext () Ty1
SyncE -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SyncE"
  MapE (Var, Ty1, PreExp E1Ext () Ty1)
_x0 PreExp E1Ext () Ty1
_pe' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"MapE"
  FoldE (Var, Ty1, PreExp E1Ext () Ty1)
_x0 (Var, Ty1, PreExp E1Ext () Ty1)
_x1 PreExp E1Ext () Ty1
_pe' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"FoldE"

  Ext E1Ext () Ty1
ee -> E1Ext () Ty1 -> Doc
ppExt E1Ext () Ty1
ee

ppCurried :: Doc -> [Exp1] -> Doc
ppCurried :: Doc -> [PreExp E1Ext () Ty1] -> Doc
ppCurried Doc
var [PreExp E1Ext () Ty1]
pes = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
var Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes)

ppAp :: Doc -> [Exp1] -> Doc
ppAp :: Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
var [PreExp E1Ext () Ty1]
pes =
  Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
var Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [PreExp E1Ext () Ty1]
pes of
    [] -> Doc
empty               -- don't confuse with application to unit (1 arg)
    [PreExp E1Ext () Ty1
x] -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
x
    [PreExp E1Ext () Ty1]
_ -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes

ppVar :: Var -> Doc
ppVar :: Var -> Doc
ppVar = [Char] -> Doc
text ([Char] -> Doc) -> (Var -> [Char]) -> Var -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> [Char]
getVar

getVar :: Var -> String
getVar :: Var -> [Char]
getVar (Var Symbol
s) = case Symbol -> [Char]
unintern Symbol
s of
  [Char]
"val" -> [Char]
"val_"
  [Char]
"as" -> [Char]
"as_"
  [Char]
"open" -> [Char]
"open_"
  [Char]
"rec" -> [Char]
"rec_"
  [Char]
"fun" -> [Char]
"fun_"
  [Char]
"end" -> [Char]
"end_"
  Char
'_' : [Char]
z -> [Char]
"internal_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
z
  [Char]
z -> [Char]
z

interleave :: Doc -> [Doc] -> Doc
interleave :: Doc -> [Doc] -> Doc
interleave Doc
sepr [Doc]
lst = case [Doc]
lst of
  [] -> Doc
forall a. Monoid a => a
mempty
  Doc
d : [Doc]
ds -> (Doc
d Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc
sepr Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc]
ds

binary :: String -> [Exp1] -> Doc
binary :: [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
opSym [PreExp E1Ext () Ty1]
pes =
  Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [Doc
l, [Char] -> Doc
text [Char]
opSym, Doc
r]
  where
    (Doc
l, Doc
r) = [Char] -> [PreExp E1Ext () Ty1] -> (Doc, Doc)
extractBinary [Char]
opSym [PreExp E1Ext () Ty1]
pes

extractBinary :: String -> [Exp1] -> (Doc, Doc)
extractBinary :: [Char] -> [PreExp E1Ext () Ty1] -> (Doc, Doc)
extractBinary [Char]
opSym [PreExp E1Ext () Ty1]
pes = case PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes of
  [Doc
l, Doc
r] -> (Doc
l, Doc
r)
  [Doc]
es -> [Char] -> (Doc, Doc)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Doc, Doc)) -> [Char] -> (Doc, Doc)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ [Char]
"L0 error: (", [Char]
opSym, [Char]
") is provided "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Doc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
es, [Char]
" arguments"
    ]

extractUnary :: String -> [Exp1] -> Doc
extractUnary :: [Char] -> [PreExp E1Ext () Ty1] -> Doc
extractUnary [Char]
opSym [PreExp E1Ext () Ty1]
pes = case PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> [PreExp E1Ext () Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreExp E1Ext () Ty1]
pes of
  [Doc
x] -> Doc
x
  [Doc]
es -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ [Char]
"L0 error: (", [Char]
opSym, [Char]
") is provided "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Doc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
es, [Char]
" arguments"
    ]

ppFail :: String -> Doc
ppFail :: [Char] -> Doc
ppFail [Char]
s = [Doc] -> Doc
hsep
  [ Doc
"raise"
  , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [Doc
"Fail", Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
s]
  ]

ppPrim :: Prim Ty1 -> [Exp1] -> Doc
ppPrim :: Prim Ty1 -> [PreExp E1Ext () Ty1] -> Doc
ppPrim Prim Ty1
pr [PreExp E1Ext () Ty1]
pes = case Prim Ty1
pr of
  Prim Ty1
AddP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"+" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
SubP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"-" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
MulP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"*" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
DivP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"div" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
ModP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"mod" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
ExpP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"**" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
RandP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppCurried Doc
"MltonRandom.rand()" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
EqIntP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
LtP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"<" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
GtP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
">" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
LtEqP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"<=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
GtEqP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
">=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FAddP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"+" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FSubP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"-" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FMulP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"*" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FDivP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"/" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FExpP ->
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ Doc
"Math.pow"
      , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat [Doc
l, Doc
comma, Doc
r]
      ]
    where
      (Doc
l, Doc
r) = [Char] -> [PreExp E1Ext () Ty1] -> (Doc, Doc)
extractBinary [Char]
"pow" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FRandP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppCurried Doc
"Random.randFloat" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
EqFloatP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
EqCharP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FLtP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"<" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FGtP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
">" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FLtEqP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"<=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FGtEqP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
">=" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FSqrtP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"Math.sqrt" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
IntToFloatP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"Real.fromInt" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FloatToIntP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"Int.fromReal" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
FTanP -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"Math.tan" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
EqSymP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"=" [PreExp E1Ext () Ty1]
pes
  EqBenchProgP [Char]
_ -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"GenSML: EqBenchProgP"
  Prim Ty1
OrP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"orelse" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
AndP -> [Char] -> [PreExp E1Ext () Ty1] -> Doc
binary [Char]
"andalso" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
MkTrue -> Doc
"true"
  Prim Ty1
MkFalse -> Doc
"false"
  ErrorP [Char]
s Ty1
_ -> [Char] -> Doc
ppFail [Char]
s
  Prim Ty1
SizeParam -> Int -> Doc
int Int
1  -- ?
  Prim Ty1
IsBig -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"IsBig"
  Prim Ty1
GetNumProcessors -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"GetNumProcessors"
  Prim Ty1
PrintInt -> Doc -> Doc -> Doc
printer Doc
"Int" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ [PreExp E1Ext () Ty1] -> PreExp E1Ext () Ty1
forall a. HasCallStack => [a] -> a
head [PreExp E1Ext () Ty1]
pes
  Prim Ty1
PrintChar -> Doc -> Doc -> Doc
printer Doc
"Char" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ [PreExp E1Ext () Ty1] -> PreExp E1Ext () Ty1
forall a. HasCallStack => [a] -> a
head [PreExp E1Ext () Ty1]
pes
  Prim Ty1
PrintFloat -> Doc -> Doc -> Doc
printer Doc
"Float" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ [PreExp E1Ext () Ty1] -> PreExp E1Ext () Ty1
forall a. HasCallStack => [a] -> a
head [PreExp E1Ext () Ty1]
pes
  Prim Ty1
PrintBool -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"(fn true => \"True\" | false => \"False\")" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
PrintSym -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"print" [PreExp E1Ext () Ty1]
pes
  Prim Ty1
ReadInt -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"ReadInt"  -- Have every program read from stdin?
  DictInsertP Ty1
_ -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"DictInsertP"
  DictLookupP Ty1
_ -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"DictLookupP"
  DictEmptyP Ty1
_ -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"DictEmptyP"
  DictHasKeyP Ty1
_ -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"DictHasKeyP"
  Prim Ty1
SymSetEmpty -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymSetEmpty"
  Prim Ty1
SymSetInsert -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymSetInsert"
  Prim Ty1
SymSetContains -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymSetContains"
  Prim Ty1
SymHashEmpty -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymHashEmpty"
  Prim Ty1
SymHashInsert -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymHashInsert"
  Prim Ty1
SymHashLookup -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymHashLookup"
  Prim Ty1
SymHashContains -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"SymHashContains"
  Prim Ty1
IntHashEmpty -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"IntHashEmpty"
  Prim Ty1
IntHashInsert -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"IntHashInsert"
  Prim Ty1
IntHashLookup -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"IntHashLookup"
  PDictAllocP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictAllocP"
  PDictInsertP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictInsertP"
  PDictLookupP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictLookupP"
  PDictHasKeyP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictHasKeyP"
  PDictForkP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictForkP"
  PDictJoinP Ty1
_ty0 Ty1
_ty0' -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"PDictJoinP"
  LLAllocP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLAllocP"
  LLIsEmptyP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLIsEmptyP"  -- Implement these? 
  LLConsP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLConsP"
  LLHeadP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLHeadP"
  LLTailP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLTailP"
  LLFreeP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLFreeP"
  LLFree2P Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLFree2P"
  LLCopyP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"LLCopyP"
  VAllocP Ty1
_ty0 ->
    Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"(fn internal__ => ArraySlice.full(Array.array(internal__, 0)))" [PreExp E1Ext () Ty1]
pes
  VFreeP Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"VFreeP"
  VFree2P Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"VFree2P"
  VLengthP Ty1
_ty0 -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"ArraySlice.length" [PreExp E1Ext () Ty1]
pes
  VNthP Ty1
_ty0 -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"ArraySlice.sub" [PreExp E1Ext () Ty1]
pes
  VSliceP Ty1
_ty0 -> case [PreExp E1Ext () Ty1]
pes of
    [PreExp E1Ext () Ty1
pe1, PreExp E1Ext () Ty1
pe2, PreExp E1Ext () Ty1
pe3] -> [Doc] -> Doc
hcat
      [ Doc
"ArraySlice.subslice"
      , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma
        [ PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe3
        , PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe1
        , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"SOME" Doc -> Doc -> Doc
<+> PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
pe2
        ]
      ]
    [PreExp E1Ext () Ty1]
_ -> Doc
_
  InplaceVUpdateP Ty1
_ty0 -> [Doc] -> Doc
hsep
      [ Doc
"let val _ ="
      , Doc -> [PreExp E1Ext () Ty1] -> Doc
ppAp Doc
"ArraySlice.update" [PreExp E1Ext () Ty1]
pes
      , Doc
"in", PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ [PreExp E1Ext () Ty1] -> PreExp E1Ext () Ty1
forall a. HasCallStack => [a] -> a
head [PreExp E1Ext () Ty1]
pes
      , Doc
"end"
      ]
  VConcatP Ty1
_ty0 -> [Char] -> Doc
ppFail [Char]
"VConcatP"
  VSortP Ty1
_ty0 -> [Char] -> Doc
ppFail [Char]
"VSortP"
  InplaceVSortP Ty1
_ty0 -> Doc -> [PreExp E1Ext () Ty1] -> Doc
ppCurried Doc
qsort [PreExp E1Ext () Ty1]
pes
  VMergeP Ty1
_ty0 -> [Char] -> Doc
ppFail [Char]
"VMergeP"
  Write3dPpmFile [Char]
_s -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Write3dPpmFile"
  ReadPackedFile Maybe [Char]
_m_s [Char]
_s Maybe Var
_m_var Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"ReadPackedFile"
  WritePackedFile [Char]
_s Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"WritePackedFile"
  ReadArrayFile Maybe ([Char], Int)
_ma Ty1
_ty0 -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"ReadArrayFile"
  Prim Ty1
RequestEndOf -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"RequestEndOf"
  Prim Ty1
RequestSizeOf -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"RequestSizeOf"
  Prim Ty1
Gensym -> [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Gensym"

ppProgram :: Prog1 -> Doc
ppProgram :: Prog1 -> Doc
ppProgram Prog1
prog = [Doc] -> Doc
hcat
  [ DDefs1 -> Doc
ppDDefs (DDefs1 -> Doc) -> DDefs1 -> Doc
forall a b. (a -> b) -> a -> b
$ Prog1 -> DDefs (TyOf (PreExp E1Ext () Ty1))
forall ex. Prog ex -> DDefs (TyOf ex)
ddefs Prog1
prog
  , Map Var (FunDef (PreExp E1Ext () Ty1)) -> Doc
ppFunDefs (Map Var (FunDef (PreExp E1Ext () Ty1)) -> Doc)
-> Map Var (FunDef (PreExp E1Ext () Ty1)) -> Doc
forall a b. (a -> b) -> a -> b
$ Prog1 -> Map Var (FunDef (PreExp E1Ext () Ty1))
forall ex. Prog ex -> FunDefs ex
fundefs Prog1
prog
  , Maybe (PreExp E1Ext () Ty1, Ty1) -> Doc
ppMainExpr (Maybe (PreExp E1Ext () Ty1, Ty1) -> Doc)
-> Maybe (PreExp E1Ext () Ty1, Ty1) -> Doc
forall a b. (a -> b) -> a -> b
$ Prog1 -> Maybe (PreExp E1Ext () Ty1, TyOf (PreExp E1Ext () Ty1))
forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp Prog1
prog
  , Doc
"\n"
  ]

ppFunDefs :: Map Var (FunDef Exp1) -> Doc
ppFunDefs :: Map Var (FunDef (PreExp E1Ext () Ty1)) -> Doc
ppFunDefs Map Var (FunDef (PreExp E1Ext () Ty1))
funDefs =
  (Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
 -> Doc)
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
-> Doc
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either
  (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> Doc
ppBlock [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
organize
  where
    ppBlock :: Either
  (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> Doc
ppBlock = (FunDef (PreExp E1Ext () Ty1) -> Doc)
-> ([FunDef (PreExp E1Ext () Ty1)] -> Doc)
-> Either
     (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FunDef (PreExp E1Ext () Ty1) -> Doc
ppValDef [FunDef (PreExp E1Ext () Ty1)] -> Doc
ppFunRec
    organize :: [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
organize = [FunDef (PreExp E1Ext () Ty1)] -> [[FunDef (PreExp E1Ext () Ty1)]]
sortDefs (Map Var (FunDef (PreExp E1Ext () Ty1))
-> [FunDef (PreExp E1Ext () Ty1)]
forall k a. Map k a -> [a]
elems Map Var (FunDef (PreExp E1Ext () Ty1))
funDefs) [[FunDef (PreExp E1Ext () Ty1)]]
-> ([FunDef (PreExp E1Ext () Ty1)]
    -> [Either
          (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]])
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
separateDefs

separateDefs :: [FunDef Exp1] -> [Either (FunDef Exp1) [FunDef Exp1]]
separateDefs :: [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
separateDefs [FunDef (PreExp E1Ext () Ty1)]
funDefs = case [FunDef (PreExp E1Ext () Ty1)]
funDefs of
  [] -> []
  FunDef (PreExp E1Ext () Ty1)
fd : [FunDef (PreExp E1Ext () Ty1)]
fds -> case FunDef (PreExp E1Ext () Ty1) -> [Var]
forall ex. FunDef ex -> [Var]
funArgs FunDef (PreExp E1Ext () Ty1)
fd of
    [] -> FunDef (PreExp E1Ext () Ty1)
-> Either
     (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
forall a b. a -> Either a b
Left FunDef (PreExp E1Ext () Ty1)
fd Either
  (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
forall a. a -> [a] -> [a]
: [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
separateDefs [FunDef (PreExp E1Ext () Ty1)]
fds
    [Var]
_ -> case [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
separateDefs [FunDef (PreExp E1Ext () Ty1)]
fds of
      [] -> [[FunDef (PreExp E1Ext () Ty1)]
-> Either
     (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
forall a b. b -> Either a b
Right [FunDef (PreExp E1Ext () Ty1)
fd]]
      fds' :: [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
fds'@(Left FunDef (PreExp E1Ext () Ty1)
_ : [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
_) -> [FunDef (PreExp E1Ext () Ty1)]
-> Either
     (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
forall a b. b -> Either a b
Right [FunDef (PreExp E1Ext () Ty1)
fd] Either
  (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
forall a. a -> [a] -> [a]
: [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
fds'
      Right [FunDef (PreExp E1Ext () Ty1)]
fds' : [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
fds'' ->  [FunDef (PreExp E1Ext () Ty1)]
-> Either
     (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
forall a b. b -> Either a b
Right (FunDef (PreExp E1Ext () Ty1)
fd FunDef (PreExp E1Ext () Ty1)
-> [FunDef (PreExp E1Ext () Ty1)] -> [FunDef (PreExp E1Ext () Ty1)]
forall a. a -> [a] -> [a]
: [FunDef (PreExp E1Ext () Ty1)]
fds') Either
  (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
-> [Either
      (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
forall a. a -> [a] -> [a]
: [Either
   (FunDef (PreExp E1Ext () Ty1)) [FunDef (PreExp E1Ext () Ty1)]]
fds''

ppValDef :: FunDef Exp1 -> Doc
ppValDef :: FunDef (PreExp E1Ext () Ty1) -> Doc
ppValDef FunDef (PreExp E1Ext () Ty1)
funDef =
  [Doc] -> Doc
hsep
    [ Doc
"val"
    , Var -> Doc
ppVar (Var -> Doc) -> Var -> Doc
forall a b. (a -> b) -> a -> b
$ FunDef (PreExp E1Ext () Ty1) -> Var
forall ex. FunDef ex -> Var
funName FunDef (PreExp E1Ext () Ty1)
funDef
    , Doc
"="
    , PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ FunDef (PreExp E1Ext () Ty1) -> PreExp E1Ext () Ty1
forall ex. FunDef ex -> ex
funBody FunDef (PreExp E1Ext () Ty1)
funDef
    ] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

ppFunRec :: [FunDef Exp1] -> Doc
ppFunRec :: [FunDef (PreExp E1Ext () Ty1)] -> Doc
ppFunRec [FunDef (PreExp E1Ext () Ty1)]
fdefs =
  Doc -> FunDef (PreExp E1Ext () Ty1) -> Doc -> Doc
reduceFunDefs Doc
"fun" ([FunDef (PreExp E1Ext () Ty1)] -> FunDef (PreExp E1Ext () Ty1)
forall a. HasCallStack => [a] -> a
head [FunDef (PreExp E1Ext () Ty1)]
fdefs) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    (FunDef (PreExp E1Ext () Ty1) -> Doc -> Doc)
-> Doc -> [FunDef (PreExp E1Ext () Ty1)] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> FunDef (PreExp E1Ext () Ty1) -> Doc -> Doc
reduceFunDefs Doc
"and") Doc
";\n" ([FunDef (PreExp E1Ext () Ty1)] -> [FunDef (PreExp E1Ext () Ty1)]
forall a. HasCallStack => [a] -> [a]
tail [FunDef (PreExp E1Ext () Ty1)]
fdefs)

reduceFunDefs :: Doc -> FunDef Exp1 -> Doc -> Doc
reduceFunDefs :: Doc -> FunDef (PreExp E1Ext () Ty1) -> Doc -> Doc
reduceFunDefs Doc
keyword FunDef (PreExp E1Ext () Ty1)
funDef Doc
doc =
  Doc
"\n" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case FunDef (PreExp E1Ext () Ty1) -> [Var]
forall ex. FunDef ex -> [Var]
funArgs FunDef (PreExp E1Ext () Ty1)
funDef of
    [] -> [Doc] -> Doc
hsep
      [ Doc
keyword
      , Var -> Doc
ppVar (Var -> Doc) -> Var -> Doc
forall a b. (a -> b) -> a -> b
$ FunDef (PreExp E1Ext () Ty1) -> Var
forall ex. FunDef ex -> Var
funName FunDef (PreExp E1Ext () Ty1)
funDef
      , Doc
"="
      , PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ FunDef (PreExp E1Ext () Ty1) -> PreExp E1Ext () Ty1
forall ex. FunDef ex -> ex
funBody FunDef (PreExp E1Ext () Ty1)
funDef
      ] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc
    [Var]
fargs -> [Doc] -> Doc
hsep
      [ Doc
keyword
      , Var -> Doc
ppVar Var
name
      , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar (Var -> Doc) -> [Var] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
fargs
      , Doc
"="
      , case Var
name of
        Var
"print_check" -> Doc -> Doc
parens Doc
forall a. Monoid a => a
mempty
        Var
"print_space" -> Doc
"print \" \""
        Var
"print_newline" -> Doc
"print \"\\n\""
        Var
_ -> PreExp E1Ext () Ty1 -> Doc
ppE (PreExp E1Ext () Ty1 -> Doc) -> PreExp E1Ext () Ty1 -> Doc
forall a b. (a -> b) -> a -> b
$ FunDef (PreExp E1Ext () Ty1) -> PreExp E1Ext () Ty1
forall ex. FunDef ex -> ex
funBody FunDef (PreExp E1Ext () Ty1)
funDef
      ] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc
      where name :: Var
name = FunDef (PreExp E1Ext () Ty1) -> Var
forall ex. FunDef ex -> Var
funName FunDef (PreExp E1Ext () Ty1)
funDef

ppMainExpr :: Maybe (Exp1, Ty1) -> Doc
ppMainExpr :: Maybe (PreExp E1Ext () Ty1, Ty1) -> Doc
ppMainExpr Maybe (PreExp E1Ext () Ty1, Ty1)
opt = case Maybe (PreExp E1Ext () Ty1, Ty1)
opt of
  Maybe (PreExp E1Ext () Ty1, Ty1)
Nothing -> Doc
forall a. Monoid a => a
mempty
  Just (PreExp E1Ext () Ty1
exp1, Ty1
ty1) -> 
    Doc
"val _ = " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Ty1 -> Doc -> Doc
printerTy1 Ty1
ty1 (PreExp E1Ext () Ty1 -> Doc
ppE PreExp E1Ext () Ty1
exp1) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\nval _ = print \"\\n\""

ppDDefs :: DDefs1 -> Doc
ppDDefs :: DDefs1 -> Doc
ppDDefs DDefs1
ddefs = case DDefs1 -> [DDef Ty1]
forall k a. Map k a -> [a]
elems DDefs1
ddefs of
  [] -> Doc
forall a. Monoid a => a
mempty
  DDef Ty1
h : [DDef Ty1]
t -> [Doc] -> Doc
hsep
    [ Doc
"datatype"
    , DDef Ty1 -> Doc
ppDDef DDef Ty1
h
    , [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc
"\nand" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (DDef Ty1 -> Doc) -> DDef Ty1 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DDef Ty1 -> Doc
ppDDef (DDef Ty1 -> Doc) -> [DDef Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DDef Ty1]
t
    , Doc
";\n"
    ]

ppDDef :: DDef1 -> Doc
ppDDef :: DDef Ty1 -> Doc
ppDDef DDef Ty1
ddef = [Doc] -> Doc
hsep
  [ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ TyVar -> Doc
ppTyVar (TyVar -> Doc) -> [TyVar] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDef Ty1 -> [TyVar]
forall a. DDef a -> [TyVar]
tyArgs DDef Ty1
ddef
  , (Doc
"dat_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar (Var -> Doc) -> Var -> Doc
forall a b. (a -> b) -> a -> b
$ DDef Ty1 -> Var
forall a. DDef a -> Var
tyName DDef Ty1
ddef
  , Doc
"="
  , Doc -> [Doc] -> Doc
interleave
      Doc
"|"
      (([Char], [(Bool, Ty1)]) -> Doc
forall {a}. ([Char], [(a, Ty1)]) -> Doc
ppBody (([Char], [(Bool, Ty1)]) -> Doc)
-> [([Char], [(Bool, Ty1)])] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDef Ty1 -> [([Char], [(Bool, Ty1)])]
forall a. DDef a -> [([Char], [(Bool, a)])]
dataCons DDef Ty1
ddef)
  ]
  where
    ppBody :: ([Char], [(a, Ty1)]) -> Doc
ppBody ([Char]
s, [(a, Ty1)]
lst) = [Char] -> Doc
text [Char]
s Doc -> Doc -> Doc
<+> case [(a, Ty1)]
lst of
      [] -> Doc
forall a. Monoid a => a
mempty
      [(a, Ty1)]
_ -> Doc
"of" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Doc -> [Doc] -> Doc
interleave Doc
" *" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Ty1 -> Doc
ppTy1 (Ty1 -> Doc) -> ((a, Ty1) -> Ty1) -> (a, Ty1) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Ty1) -> Ty1
forall a b. (a, b) -> b
snd ((a, Ty1) -> Doc) -> [(a, Ty1)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Ty1)]
lst)

ppTyVar :: TyVar -> Doc
ppTyVar :: TyVar -> Doc
ppTyVar TyVar
tyVar = case TyVar
tyVar of
  BoundTv Var
var -> Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Var -> Doc
ppVar Var
var
  SkolemTv [Char]
_s Int
_n -> Doc
_
  UserTv Var
var -> Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Var -> Doc
ppVar Var
var

ppTy1 :: Ty1 -> Doc
ppTy1 :: Ty1 -> Doc
ppTy1 Ty1
ty1 = case Ty1
ty1 of
  Ty1
IntTy -> Doc
"int"
  Ty1
CharTy -> Doc
"char"
  Ty1
FloatTy -> Doc
"real"
  Ty1
BoolTy -> Doc
"bool"
  ProdTy [Ty1]
ty1s -> Doc -> [Doc] -> Doc
interleave Doc
" * " ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Ty1 -> Doc
ppTy1 (Ty1 -> Doc) -> [Ty1] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty1]
ty1s
  SymDictTy Maybe Var
_m_var Ty1
_ty1' -> Doc
_
  PDictTy Ty1
_ty1' Ty1
_ty12 -> Doc
_
  Ty1
SymSetTy -> Doc
_
  Ty1
SymHashTy -> Doc
_
  Ty1
IntHashTy -> Doc
_
  PackedTy [Char]
s () -> Doc
" dat_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
s
  VectorTy Ty1
ty1' -> Ty1 -> Doc
ppTy1 Ty1
ty1' Doc -> Doc -> Doc
<+> Doc
"ArraySlice.slice"
  ListTy Ty1
ty1' -> Ty1 -> Doc
ppTy1 Ty1
ty1' Doc -> Doc -> Doc
<+> Doc
"list"
  Ty1
ArenaTy -> Doc
_

  Ty1
SymTy -> Doc
_
  Ty1
PtrTy -> Doc
_
  Ty1
CursorTy -> Doc
_

printerTy1 :: Ty1 -> Doc -> Doc
printerTy1 :: Ty1 -> Doc -> Doc
printerTy1 Ty1
ty1 Doc
d = case Ty1
ty1 of
  Ty1
IntTy -> Doc -> Doc -> Doc
printer Doc
"Int" Doc
d
  Ty1
CharTy -> Doc -> Doc -> Doc
printer Doc
"Char" Doc
d
  Ty1
FloatTy -> Doc -> Doc -> Doc
printer Doc
"Float" Doc
d
  Ty1
SymTy -> Doc
_
  Ty1
BoolTy -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"(fn true => print \"True\" | false => print \"False\") " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d
  ProdTy [] -> Doc
"let val () = " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" in (print \"#()\") end"
  ProdTy [Ty1]
uts -> 
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ Doc
"case", Doc
d, Doc
"of"
      , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> Doc
interleave Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc
"x__" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> ((Int, Ty1) -> Doc) -> (Int, Ty1) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
int (Int -> Doc) -> ((Int, Ty1) -> Int) -> (Int, Ty1) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Ty1) -> Int
forall a b. (a, b) -> a
fst ((Int, Ty1) -> Doc) -> [(Int, Ty1)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Ty1] -> [(Int, Ty1)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Ty1]
uts
      , Doc
"-> let"
      , Doc
"val _ = print \"#(\""
      , ((Int, Ty1) -> Doc) -> [(Int, Ty1)] -> Doc
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Ty1) -> Doc
ppSub ([(Int, Ty1)] -> Doc) -> [(Int, Ty1)] -> Doc
forall a b. (a -> b) -> a -> b
$ [Int] -> [Ty1] -> [(Int, Ty1)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Ty1]
uts
      , Doc
"val _ = print \")\""
      , Doc
"in ()"
      ]
    where
      ppSub :: (Int, Ty1) -> Doc
ppSub (Int
i, Ty1
x) = [Doc] -> Doc
hsep
        [ Doc
"val _ ="
        , Ty1 -> Doc -> Doc
printerTy1 Ty1
x (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"x__" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
int Int
i
        , Doc
"val _ = print \" \""
        ]
  SymDictTy Maybe Var
_m_var Ty1
_ut -> Doc
_
  PackedTy [Char]
s () -> Doc
"internal_print_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
d
  VectorTy Ty1
ut -> 
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ Doc -> Doc
quotePrint Doc
"#["
      , Doc -> Doc
toss (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep 
        [ Doc
"case length", Doc
d, Doc
"of"
        , Doc
"0 -> ()"
        , Doc
"1 ->", Ty1 -> Doc -> Doc
printerTy1 Ty1
ut (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"ArraySlice.sub" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
", 0")
        , Doc
"_ ->"
        , Doc -> Doc
toss (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Ty1 -> Doc -> Doc
printerTy1 Ty1
ut (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"ArraySlice.sub" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
", 0")
        , Doc
"ArraySlice.app", Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 
          Doc
"fn y__ => " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Ty1 -> Doc -> Doc
printerTy1 Ty1
ut Doc
"y__"
        , Doc
"xs__"
        ]
      , Doc
"print \"]\""
      ]
  PDictTy Ty1
_ut Ty1
_ut' -> Doc
_
  ListTy Ty1
ut -> 
    Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep
      [ Doc -> Doc
quotePrint Doc
"["
      , Doc -> Doc
toss (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ Doc
"case", Doc
d, Doc
"of"
        , Doc
"[] -> ()"
        , Doc
"| [x__] ->", Ty1 -> Doc -> Doc
printerTy1 Ty1
ut Doc
"x__"
        , Doc
"| [x__ :: xs__] ->"
        , Doc -> Doc
toss (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Ty1 -> Doc -> Doc
printerTy1 Ty1
ut Doc
"x__"
        , Doc
"list.app", Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 
          Doc
"fn y__ => " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
quotePrint Doc
", " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Ty1 -> Doc -> Doc
printerTy1 Ty1
ut Doc
"y__"
        , Doc
"xs__"
        ]
      , Doc
"print \"]\""
      ]
  Ty1
ArenaTy -> Doc
_
  Ty1
SymSetTy -> Doc
_
  Ty1
SymHashTy -> Doc
_
  Ty1
IntHashTy -> Doc
_
  Ty1
PtrTy -> Doc
_
  Ty1
CursorTy -> Doc
_

printer :: Doc -> Doc -> Doc
printer :: Doc -> Doc -> Doc
printer Doc
p Doc
d = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"print" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".toString" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
d)

toss :: Doc -> Doc
toss :: Doc -> Doc
toss Doc
s = Doc
"let val _ = " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" in "
justPrint :: Doc -> Doc
justPrint :: Doc -> Doc
justPrint Doc
s = Doc -> Doc
toss (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"print " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
s
quotePrint :: Doc -> Doc
quotePrint :: Doc -> Doc
quotePrint = Doc -> Doc
justPrint (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
quotes

qsort :: Doc
qsort :: Doc
qsort = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text
  [Char]
"fn arr => fn cmp => \n\
  \  let\n\
  \    fun qsort(arr, lo, hi) = \n\
  \      if cmp lo hi < 0 then\n\
  \        let\n\
  \          val pivot = ArraySlice.sub(arr, hi)\n\
  \          val i = ref (lo - 1)\n\
  \          val j = ref lo\n\
  \          val _ = \n\
  \            while cmp (!j) (hi - 1) < 1 do\n\
  \              let\n\
  \                val _ = \n\
  \                  if cmp (ArraySlice.sub(arr, !j)) pivot < 0 then\n\
  \                    let\n\
  \                      val _ = i := !i + 1\n\
  \                      val tmp = ArraySlice.sub(arr, !i)\n\
  \                      val _ = ArraySlice.update(arr, !i, ArraySlice.sub(arr, !j))\n\
  \                      val _ = ArraySlice.update(arr, !j, tmp)\n\
  \                    in\n\
  \                      ()\n\
  \                    end\n\
  \                  else ()\n\
  \              in\n\
  \                j := !j + 1\n\
  \              end\n\
  \          val tmp = ArraySlice.sub(arr, !i + 1)\n\
  \          val _ = ArraySlice.update(arr, !i + 1, ArraySlice.sub(arr, hi))\n\
  \          val _ = ArraySlice.update(arr, hi, tmp)\n\
  \          val p = !i + 1\n\
  \          val _ = qsort(arr, lo, p - 1)\n\
  \          val _ = qsort(arr, p + 1, hi)\n\
  \        in\n\
  \          ()\n\
  \        end\n\
  \    else ()\n\
  \    val _ = qsort(arr, 0, ArraySlice.length arr - 1)\n\
  \  in\n\
  \    arr\
  \  end\n"

varsEs :: Set.Set String -> [Exp1] -> Set.Set String
varsEs :: Set [Char] -> [PreExp E1Ext () Ty1] -> Set [Char]
varsEs = (PreExp E1Ext () Ty1 -> Set [Char])
-> [PreExp E1Ext () Ty1] -> Set [Char]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((PreExp E1Ext () Ty1 -> Set [Char])
 -> [PreExp E1Ext () Ty1] -> Set [Char])
-> (Set [Char] -> PreExp E1Ext () Ty1 -> Set [Char])
-> Set [Char]
-> [PreExp E1Ext () Ty1]
-> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set [Char] -> PreExp E1Ext () Ty1 -> Set [Char]
varsE

varsE :: Set.Set String -> Exp1 -> Set.Set String
varsE :: Set [Char] -> PreExp E1Ext () Ty1 -> Set [Char]
varsE Set [Char]
vs PreExp E1Ext () Ty1
pe0 = case PreExp E1Ext () Ty1
pe0 of
  -- VarE var -> collect var
  VarE Var
_ -> Set [Char]
forall a. Monoid a => a
mempty
  AppE Var
var [()]
_ [PreExp E1Ext () Ty1]
pes -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1]
pes Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> Var -> Set [Char]
collect Var
var
  PrimAppE Prim Ty1
_ [PreExp E1Ext () Ty1]
pes -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1]
pes
  LetE (Var
_, [()]
_, Ty1
_, PreExp E1Ext () Ty1
pe') PreExp E1Ext () Ty1
pe -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe'
  IfE PreExp E1Ext () Ty1
pe PreExp E1Ext () Ty1
pe' PreExp E1Ext () Ty1
pe3 -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1
pe, PreExp E1Ext () Ty1
pe', PreExp E1Ext () Ty1
pe3]
  MkProdE [PreExp E1Ext () Ty1]
pes -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1]
pes
  ProjE Int
_ PreExp E1Ext () Ty1
pe -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe
  CaseE PreExp E1Ext () Ty1
pe [([Char], [(Var, ())], PreExp E1Ext () Ty1)]
x0 -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> (([Char], [(Var, ())], PreExp E1Ext () Ty1) -> Set [Char])
-> [([Char], [(Var, ())], PreExp E1Ext () Ty1)] -> Set [Char]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\([Char]
_, [(Var, ())]
_, PreExp E1Ext () Ty1
pe') -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe') [([Char], [(Var, ())], PreExp E1Ext () Ty1)]
x0
  DataConE ()
_ [Char]
_ [PreExp E1Ext () Ty1]
pes -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1]
pes
  TimeIt PreExp E1Ext () Ty1
pe Ty1
_ Bool
_ -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe
  WithArenaE Var
_ PreExp E1Ext () Ty1
pe -> PreExp E1Ext () Ty1 -> Set [Char]
vpe PreExp E1Ext () Ty1
pe
  SpawnE Var
_ [()]
_ [PreExp E1Ext () Ty1]
pes -> [PreExp E1Ext () Ty1] -> Set [Char]
vpes [PreExp E1Ext () Ty1]
pes
  PreExp E1Ext () Ty1
SyncE -> Set [Char]
_
  MapE (Var, Ty1, PreExp E1Ext () Ty1)
_ PreExp E1Ext () Ty1
_ -> Set [Char]
_
  FoldE {} -> Set [Char]
_
  PreExp E1Ext () Ty1
_ -> Set [Char]
forall a. Monoid a => a
mempty
  where
    vpe :: PreExp E1Ext () Ty1 -> Set [Char]
vpe = Set [Char] -> PreExp E1Ext () Ty1 -> Set [Char]
varsE Set [Char]
vs
    vpes :: [PreExp E1Ext () Ty1] -> Set [Char]
vpes = Set [Char] -> [PreExp E1Ext () Ty1] -> Set [Char]
varsEs Set [Char]
vs
    collect :: Var -> Set [Char]
collect Var
var
      | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member [Char]
s Set [Char]
vs = [Char] -> Set [Char]
forall a. a -> Set a
Set.singleton [Char]
s
      | Bool
otherwise = Set [Char]
forall a. Monoid a => a
mempty
      where s :: [Char]
s = Var -> [Char]
getVar Var
var

addFunBinding :: FunDef ex -> Map String (FunDef ex) -> Map String (FunDef ex)
addFunBinding :: forall ex.
FunDef ex -> Map [Char] (FunDef ex) -> Map [Char] (FunDef ex)
addFunBinding FunDef ex
funDef = [Char]
-> FunDef ex -> Map [Char] (FunDef ex) -> Map [Char] (FunDef ex)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Var -> [Char]
getVar (Var -> [Char]) -> Var -> [Char]
forall a b. (a -> b) -> a -> b
$ FunDef ex -> Var
forall ex. FunDef ex -> Var
funName FunDef ex
funDef) FunDef ex
funDef

allFunEntries :: [FunDef ex] -> Map String (FunDef ex)
allFunEntries :: forall ex. [FunDef ex] -> Map [Char] (FunDef ex)
allFunEntries = (FunDef ex -> Map [Char] (FunDef ex) -> Map [Char] (FunDef ex))
-> Map [Char] (FunDef ex) -> [FunDef ex] -> Map [Char] (FunDef ex)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FunDef ex -> Map [Char] (FunDef ex) -> Map [Char] (FunDef ex)
forall ex.
FunDef ex -> Map [Char] (FunDef ex) -> Map [Char] (FunDef ex)
addFunBinding Map [Char] (FunDef ex)
forall k a. Map k a
Map.empty

allFunNames :: [FunDef ex] -> Set.Set String
allFunNames :: forall ex. [FunDef ex] -> Set [Char]
allFunNames = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char])
-> ([FunDef ex] -> [[Char]]) -> [FunDef ex] -> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunDef ex -> [Char]) -> [FunDef ex] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var -> [Char]
getVar (Var -> [Char]) -> (FunDef ex -> Var) -> FunDef ex -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef ex -> Var
forall ex. FunDef ex -> Var
funName)

getDependencies :: [FunDef Exp1] -> Map String [FunDef Exp1]
getDependencies :: [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
getDependencies [FunDef (PreExp E1Ext () Ty1)]
funDefs =
  (FunDef (PreExp E1Ext () Ty1)
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)])
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FunDef (PreExp E1Ext () Ty1)
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
reduceDeps Map [Char] [FunDef (PreExp E1Ext () Ty1)]
forall k a. Map k a
Map.empty [FunDef (PreExp E1Ext () Ty1)]
funDefs
  where
    funMap :: Map [Char] (FunDef (PreExp E1Ext () Ty1))
funMap = [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
forall ex. [FunDef ex] -> Map [Char] (FunDef ex)
allFunEntries [FunDef (PreExp E1Ext () Ty1)]
funDefs
    funSet :: Set [Char]
funSet = [FunDef (PreExp E1Ext () Ty1)] -> Set [Char]
forall ex. [FunDef ex] -> Set [Char]
allFunNames [FunDef (PreExp E1Ext () Ty1)]
funDefs
    toNode :: [Char] -> FunDef (PreExp E1Ext () Ty1)
toNode = FunDef (PreExp E1Ext () Ty1)
-> Maybe (FunDef (PreExp E1Ext () Ty1))
-> FunDef (PreExp E1Ext () Ty1)
forall a. a -> Maybe a -> a
fromMaybe FunDef (PreExp E1Ext () Ty1)
_ (Maybe (FunDef (PreExp E1Ext () Ty1))
 -> FunDef (PreExp E1Ext () Ty1))
-> ([Char] -> Maybe (FunDef (PreExp E1Ext () Ty1)))
-> [Char]
-> FunDef (PreExp E1Ext () Ty1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
 -> Map [Char] (FunDef (PreExp E1Ext () Ty1))
 -> Maybe (FunDef (PreExp E1Ext () Ty1)))
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
-> [Char]
-> Maybe (FunDef (PreExp E1Ext () Ty1))
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char]
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
-> Maybe (FunDef (PreExp E1Ext () Ty1))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map [Char] (FunDef (PreExp E1Ext () Ty1))
funMap
    toDep :: FunDef (PreExp E1Ext () Ty1) -> [FunDef (PreExp E1Ext () Ty1)]
toDep = ([Char] -> FunDef (PreExp E1Ext () Ty1))
-> [[Char]] -> [FunDef (PreExp E1Ext () Ty1)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> FunDef (PreExp E1Ext () Ty1)
toNode ([[Char]] -> [FunDef (PreExp E1Ext () Ty1)])
-> (FunDef (PreExp E1Ext () Ty1) -> [[Char]])
-> FunDef (PreExp E1Ext () Ty1)
-> [FunDef (PreExp E1Ext () Ty1)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.toList (Set [Char] -> [[Char]])
-> (FunDef (PreExp E1Ext () Ty1) -> Set [Char])
-> FunDef (PreExp E1Ext () Ty1)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set [Char] -> PreExp E1Ext () Ty1 -> Set [Char]
varsE Set [Char]
funSet (PreExp E1Ext () Ty1 -> Set [Char])
-> (FunDef (PreExp E1Ext () Ty1) -> PreExp E1Ext () Ty1)
-> FunDef (PreExp E1Ext () Ty1)
-> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef (PreExp E1Ext () Ty1) -> PreExp E1Ext () Ty1
forall ex. FunDef ex -> ex
funBody
    reduceDeps :: FunDef (PreExp E1Ext () Ty1)
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
reduceDeps = [Char]
-> [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert ([Char]
 -> [FunDef (PreExp E1Ext () Ty1)]
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)])
-> (FunDef (PreExp E1Ext () Ty1) -> [Char])
-> FunDef (PreExp E1Ext () Ty1)
-> [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> [Char]
getVar (Var -> [Char])
-> (FunDef (PreExp E1Ext () Ty1) -> Var)
-> FunDef (PreExp E1Ext () Ty1)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef (PreExp E1Ext () Ty1) -> Var
forall ex. FunDef ex -> Var
funName (FunDef (PreExp E1Ext () Ty1)
 -> [FunDef (PreExp E1Ext () Ty1)]
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
 -> Map [Char] [FunDef (PreExp E1Ext () Ty1)])
-> (FunDef (PreExp E1Ext () Ty1) -> [FunDef (PreExp E1Ext () Ty1)])
-> FunDef (PreExp E1Ext () Ty1)
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
forall a b.
(FunDef (PreExp E1Ext () Ty1) -> a -> b)
-> (FunDef (PreExp E1Ext () Ty1) -> a)
-> FunDef (PreExp E1Ext () Ty1)
-> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FunDef (PreExp E1Ext () Ty1) -> [FunDef (PreExp E1Ext () Ty1)]
toDep

sortDefs :: [FunDef Exp1] -> [[FunDef Exp1]]
sortDefs :: [FunDef (PreExp E1Ext () Ty1)] -> [[FunDef (PreExp E1Ext () Ty1)]]
sortDefs [FunDef (PreExp E1Ext () Ty1)]
defs =
  (Int -> FunDef (PreExp E1Ext () Ty1))
-> [Int] -> [FunDef (PreExp E1Ext () Ty1)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\([Char]
_, FunDef (PreExp E1Ext () Ty1)
n, [FunDef (PreExp E1Ext () Ty1)]
_) -> FunDef (PreExp E1Ext () Ty1)
n) (([Char], FunDef (PreExp E1Ext () Ty1),
  [FunDef (PreExp E1Ext () Ty1)])
 -> FunDef (PreExp E1Ext () Ty1))
-> (Int
    -> ([Char], FunDef (PreExp E1Ext () Ty1),
        [FunDef (PreExp E1Ext () Ty1)]))
-> Int
-> FunDef (PreExp E1Ext () Ty1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> ([Char], FunDef (PreExp E1Ext () Ty1),
    [FunDef (PreExp E1Ext () Ty1)])
back) ([Int] -> [FunDef (PreExp E1Ext () Ty1)])
-> (Tree Int -> [Int])
-> Tree Int
-> [FunDef (PreExp E1Ext () Ty1)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Int -> [Int]
forall a. Tree a -> [a]
flatten (Tree Int -> [FunDef (PreExp E1Ext () Ty1)])
-> [Tree Int] -> [[FunDef (PreExp E1Ext () Ty1)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Graph -> [Tree Int]
scc Graph
gr
  where
    (Graph
gr, Int
-> ([Char], FunDef (PreExp E1Ext () Ty1),
    [FunDef (PreExp E1Ext () Ty1)])
back, FunDef (PreExp E1Ext () Ty1) -> Maybe Int
_) = [([Char], FunDef (PreExp E1Ext () Ty1),
  [FunDef (PreExp E1Ext () Ty1)])]
-> (Graph,
    Int
    -> ([Char], FunDef (PreExp E1Ext () Ty1),
        [FunDef (PreExp E1Ext () Ty1)]),
    FunDef (PreExp E1Ext () Ty1) -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges ([([Char], FunDef (PreExp E1Ext () Ty1),
   [FunDef (PreExp E1Ext () Ty1)])]
 -> (Graph,
     Int
     -> ([Char], FunDef (PreExp E1Ext () Ty1),
         [FunDef (PreExp E1Ext () Ty1)]),
     FunDef (PreExp E1Ext () Ty1) -> Maybe Int))
-> [([Char], FunDef (PreExp E1Ext () Ty1),
     [FunDef (PreExp E1Ext () Ty1)])]
-> (Graph,
    Int
    -> ([Char], FunDef (PreExp E1Ext () Ty1),
        [FunDef (PreExp E1Ext () Ty1)]),
    FunDef (PreExp E1Ext () Ty1) -> Maybe Int)
forall a b. (a -> b) -> a -> b
$ ([Char], [FunDef (PreExp E1Ext () Ty1)])
-> ([Char], FunDef (PreExp E1Ext () Ty1),
    [FunDef (PreExp E1Ext () Ty1)])
mkNode (([Char], [FunDef (PreExp E1Ext () Ty1)])
 -> ([Char], FunDef (PreExp E1Ext () Ty1),
     [FunDef (PreExp E1Ext () Ty1)]))
-> [([Char], [FunDef (PreExp E1Ext () Ty1)])]
-> [([Char], FunDef (PreExp E1Ext () Ty1),
     [FunDef (PreExp E1Ext () Ty1)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
-> [([Char], [FunDef (PreExp E1Ext () Ty1)])]
forall k a. Map k a -> [(k, a)]
toList Map [Char] [FunDef (PreExp E1Ext () Ty1)]
depMap
    mkNode :: ([Char], [FunDef (PreExp E1Ext () Ty1)])
-> ([Char], FunDef (PreExp E1Ext () Ty1),
    [FunDef (PreExp E1Ext () Ty1)])
mkNode ([Char]
s, [FunDef (PreExp E1Ext () Ty1)]
lst) = ([Char]
s, FunDef (PreExp E1Ext () Ty1)
-> Maybe (FunDef (PreExp E1Ext () Ty1))
-> FunDef (PreExp E1Ext () Ty1)
forall a. a -> Maybe a -> a
fromMaybe FunDef (PreExp E1Ext () Ty1)
_ ([Char]
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
-> Maybe (FunDef (PreExp E1Ext () Ty1))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
s Map [Char] (FunDef (PreExp E1Ext () Ty1))
nameMap), [FunDef (PreExp E1Ext () Ty1)]
lst)
    depMap :: Map [Char] [FunDef (PreExp E1Ext () Ty1)]
depMap = [FunDef (PreExp E1Ext () Ty1)]
-> Map [Char] [FunDef (PreExp E1Ext () Ty1)]
getDependencies [FunDef (PreExp E1Ext () Ty1)]
defs
    nameMap :: Map [Char] (FunDef (PreExp E1Ext () Ty1))
nameMap = [([Char], FunDef (PreExp E1Ext () Ty1))]
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([([Char], FunDef (PreExp E1Ext () Ty1))]
 -> Map [Char] (FunDef (PreExp E1Ext () Ty1)))
-> [([Char], FunDef (PreExp E1Ext () Ty1))]
-> Map [Char] (FunDef (PreExp E1Ext () Ty1))
forall a b. (a -> b) -> a -> b
$ (FunDef (PreExp E1Ext () Ty1)
 -> FunDef (PreExp E1Ext () Ty1)
 -> ([Char], FunDef (PreExp E1Ext () Ty1)))
-> FunDef (PreExp E1Ext () Ty1)
-> ([Char], FunDef (PreExp E1Ext () Ty1))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((,) ([Char]
 -> FunDef (PreExp E1Ext () Ty1)
 -> ([Char], FunDef (PreExp E1Ext () Ty1)))
-> (FunDef (PreExp E1Ext () Ty1) -> [Char])
-> FunDef (PreExp E1Ext () Ty1)
-> FunDef (PreExp E1Ext () Ty1)
-> ([Char], FunDef (PreExp E1Ext () Ty1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> [Char]
getVar (Var -> [Char])
-> (FunDef (PreExp E1Ext () Ty1) -> Var)
-> FunDef (PreExp E1Ext () Ty1)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef (PreExp E1Ext () Ty1) -> Var
forall ex. FunDef ex -> Var
funName) (FunDef (PreExp E1Ext () Ty1)
 -> ([Char], FunDef (PreExp E1Ext () Ty1)))
-> [FunDef (PreExp E1Ext () Ty1)]
-> [([Char], FunDef (PreExp E1Ext () Ty1))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FunDef (PreExp E1Ext () Ty1)]
defs