packages feed

fregel (empty) → 1.2.0

raw patch · 47 files changed

+27447/−0 lines, 47 filesdep +arraydep +basedep +groom

Dependencies added: array, base, groom, mtl, process

Files

+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog for fregel+## Unreleased changes++## [1.2.0] - 2023-07-20+### Added+- fregel.cabal to be published on Hackage
+ Installing_Hadoop_and_Giraph view
@@ -0,0 +1,138 @@+==============================+A way to install Giraph/Hadoop+===============================++Prepare a (virtual) machine with Ubuntu 16.04.2 LTS installed.++Then, follow the instructions below (type or copy&paste the commands in bash).++* Installing OpenSSH server+sudo apt-get install openssh-server++* Installing public keys for SSH+ssh-keygen+# repeat hitting the Enter key++cat ~/.ssh/id_ras.pub > ~/.ssh/authorized_keys++* Installing Java 8 (Oracle)+sudo add-apt-repository ppa:webupd8team/java+sudo apt-get update+sudo apt-get install oracle-java8-installer++* Installing Hadoop 1.2.1 (pseudo distributed env. with localhost only)+cd+wget http://ftp.riken.jp/net/apache/hadoop/common/hadoop-1.2.1/hadoop-1.2.1.tar.gz+tar xvzf hadoop-1.2.1.tar.gz +cd hadoop-1.2.1++cat << EOF > conf/core-site.xml+<?xml version="1.0"?>+<?xml-stylesheet type="text/xsl" href="configuration.xsl"?>+<configuration>+<property>+<name>hadoop.tmp.dir</name>+<value>$HOME/hdfs16/</value>+</property>+<property>+<name>fs.default.name</name>+<value>hdfs://localhost:54310</value>+</property>+</configuration>+EOF++cat << EOF > conf/hdfs-site.xml+<?xml version="1.0"?>+<?xml-stylesheet type="text/xsl" href="configuration.xsl"?>+<configuration>+<property>+<name>dfs.replication</name> +<value>1</value> +</property>+</configuration>+EOF++cat << EOF > conf/mapred-site.xml+<?xml version="1.0"?>+<?xml-stylesheet type="text/xsl" href="configuration.xsl"?>+<configuration>+<property>+<name>mapred.child.java.opts</name> +<value>-Xmx8000m</value>+</property>+<property>+<name>mapred.job.tracker</name> +<value>localhost:54311</value>+</property>+<property>+<name>mapred.tasktracker.map.tasks.maximum</name>+<value>4</value>+</property>+<property>+<name>mapred.map.tasks</name>+<value>4</value>+</property>+<property>+<name>mapreduce.job.counters.limit</name>+<value>5000000</value>+</property>+</configuration>+EOF++sed -i -e 's|.*JAVA_HOME=.*|export JAVA_HOME=/usr/lib/jvm/java-8-oracle/|' conf/hadoop-env.sh++bin/hadoop namenode -format++wget http://www.gutenberg.org/cache/epub/132/pg132.txt++bin/start-all.sh+bin/hadoop dfs -copyFromLocal pg132.txt /user/hduser/input/pg132.txt+bin/hadoop dfs -ls /user/hduser/input+bin/hadoop dfs -cat /user/hduser/input/pg132.txt++bin/hadoop jar hadoop-examples-1.2.1.jar wordcount /user/hduser/input/pg132.txt /user/hduser/output/wordcount++bin/hadoop dfs -cat /user/hduser/output/wordcount/p* | less++# If you can see a table of counts of words, it works well. ++* Instaling Giraph 1.2.0++sudo apt-get install git+sudo apt-get install maven++echo "export JAVA_HOME=/usr/lib/jvm/java-8-oracle/" >> ~/.bashrc+echo "export GIRAPH_HOME=~/giraph-1.2.0/" >> ~/.bashrc+exit++# open a new terminal, and continue++cd+wget http://ftp.jaist.ac.jp/pub/apache/giraph/giraph-1.2.0/giraph-dist-1.2.0-src.tar.bz2+tar xfvj giraph-dist-1.2.0-src.tar.bz2 +cd giraph-1.2.0+mvn package -DskipTests++cat << EOF > tiny_graph.txt+[0,0,[[1,1],[3,3]]]+[1,0,[[0,1],[2,2],[3,1]]]+[2,0,[[1,2],[4,4]]]+[3,0,[[0,3],[1,1],[4,4]]]+[4,0,[[3,4],[2,4]]]+EOF++~/hadoop-1.2.1/bin/hadoop dfs -copyFromLocal tiny_graph.txt /user/hduser/input/tiny_graph.txt+~/hadoop-1.2.1/bin/hadoop dfs -ls /user/hduser/input++~/hadoop-1.2.1/bin/hadoop jar $GIRAPH_HOME/giraph-examples/target/giraph-examples-1.2.0-for-hadoop-1.2.1-jar-with-dependencies.jar org.apache.giraph.GiraphRunner org.apache.giraph.examples.SimpleShortestPathsComputation -vif org.apache.giraph.io.formats.JsonLongDoubleFloatDoubleVertexInputFormat -vip /user/hduser/input/tiny_graph.txt -vof org.apache.giraph.io.formats.IdWithValueTextOutputFormat -op /user/hduser/output/shortestpaths -w 1+++~/hadoop-1.2.1/bin/hadoop dfs -cat /user/hduser/output/shortestpaths/*++# If you can see the output like below (the shortest length for every vertex), it works well. +#+# 0       1.0+# 1       0.0+# 2       2.0+# 3       1.0+# 4       5.0
+ LICENSE view
@@ -0,0 +1,8 @@+Copyright 2017-2018 Fregel Project
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+ README_on_samples view
@@ -0,0 +1,34 @@+To build Fregel compiler, read compiler/README.++Some sample Fregel programs are found in sample-programs directory:++  ds.fgl     ... Densest subgraph computation.+  gmaxv.fgl  ... Every vertex finds the maximum among all vertices.+  maxv.fgl   ... Every vertex finds the maximum among its reachable vertices.+  re.fgl     ... Reachability computation.+  sssp.fgl   ... Single source shortest path (from vertex 1)+  sssp2.fgl  ... Single source shortest path (from vertex 1) (another version)++  graph4.txt ... A small graph for Giraph (graph4 in Graphs.hs)+++Haskell implementation of Fregel for debugging is found in haskell directory:++  Fregel.hs  ... Haskell implementation of Fregel (for debugging)+  Graphs.hs  ... Sample graphs and utilities+  +  ds.hs      ... For running ds.fgl on Haskell+  maxv.hs    ... For running maxv.fgl on Haskell+  re.hs      ... For running re.fgl on Haskell+  sssp.hs    ... For running sssp.fgl on Haskell+  sssp2.hs   ... For running sssp2.fgl on Haskell+++Current limitation:++  Haskell's off-side rule is not implemented yet. You need to separate+  bindings in a let-expression by semicolon. A new parser is now being+  implemented.++  The type of vertex values in the input graph is assumed to be Integer. +
+ compiler/ASTData.hs view
@@ -0,0 +1,169 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}
+
+{-
+
+Defining
+  
+  - data structure of aux. data on ASTs
+  - initial environment
+
+-}
+
+module ASTData where
+
+import Numeric (showHex)
+import Spec (DAdditionalData, getData, setData, DRecordSpec (DRecordSpec), DConstructor(DConstructor), PrettyShow (prettyShow), ppList)
+
+-- compilation targets
+data TargetSystem = Giraph | PregelPlus | IROnly | NASTOnly | ASTOnly | NoSystem
+                    deriving (Eq, Show)
+
+-- compilation option
+data Option =
+  Option { normLevel :: Int           -- normalization level (1--10)
+         , zipOpt :: Bool             -- -oz:  zip-elimination
+         , pcFusionOpt :: Bool        -- -opc: prev-curr fusion
+         , mzFusionOpt :: Bool        -- -omz: map*zip* fusion
+         , elimCommOpt :: Bool        -- -oec: eliminate communications
+         , elimIdOpt :: Bool          -- -oei: elmiminate sending id values
+         , useV2HOpt :: Bool          -- -ovh: use voteToHalt
+         , useMsgCombOpt :: Bool      -- -omc: use message combiner
+         , useSmt :: Bool             -- -smt: use SMT solver
+         , smtPath :: String          -- -smtpath path: specify path of z3
+         , smtOption :: String        -- -smtoption option: option of z3
+         , smtTimeout:: Int           -- -smttimeout time: specify timeout
+         , printSmt :: Bool
+         , genMode :: TargetSystem
+         , outputFile :: Maybe String
+         }
+-- defaultOpt = Option 100 False False False Giraph Nothing
+defaultOpt = Option { normLevel = 100
+                    , zipOpt = False
+                    , pcFusionOpt = False
+                    , mzFusionOpt = False
+                    , elimCommOpt = False
+                    , elimIdOpt = False
+                    , useV2HOpt = False
+                    , useMsgCombOpt = False
+                    , useSmt = False
+                    , smtPath = "/usr/local/bin/z3"
+                    , smtOption = "-smt2 -in"
+                    , smtTimeout = 5 * 10 ^ 6
+                    , printSmt = False
+                    , genMode = Giraph
+                    , outputFile = Nothing
+                    }
+
+-- optimization information
+type CanElimComm = Bool
+type CanVoteToHalt = Bool
+type CombineMessages = Bool
+
+type OptimizeInfo = (CanElimComm, CanVoteToHalt, CombineMessages)
+
+-- dependency info.
+type DVarName = String
+
+-- type info.
+type Id = String
+data DTypeTerm = DTypeVar Id
+               | DTypeTerm Id [DTypeTerm]
+               deriving (Eq, Show)
+
+type DTypeInfo = DTypeTerm
+type VarTypeBind = (DVarName, DTypeInfo)
+
+type DUnique = Int
+
+-- the AST data (type info. and dependency info.)
+data DASTData = DASTData { typeOf :: DTypeTerm, depOf :: [DVarName] }
+              deriving (Eq, Show)
+
+-- type builders
+typeVar a = DTypeVar a
+typeDTInt = DTypeTerm "Int" []
+typeDTBool = DTypeTerm "Bool" []
+typeDTString = DTypeTerm "String" []
+typeDTDouble = DTypeTerm "Double" []
+typeTuple ts = DTypeTerm "(,)" ts
+typeRecord c ts = DTypeTerm c ts
+getTupleTypes (DTypeTerm "(,)" ts) = ts
+typeSolid name = DTypeTerm name []
+typeVertex (ts@[tv, te]) = DTypeTerm "Vertex" ts
+typeGraph (ts@[tv, te]) = DTypeTerm "Graph" ts
+typePair (ts@[tv, te]) = DTypeTerm "Pair" ts
+resultTypeVarName = "@@ResultingType@@"
+typeNull = DTypeTerm "Null" []
+getTypeName (DTypeTerm n _) = n
+typeParams (DTypeTerm _ ps) = ps
+
+nullRecordSpec = DRecordSpec (DConstructor "Null" (DASTData typeNull [])) [] (DASTData typeNull [])
+
+getType :: forall (t :: * -> *). 
+            (DAdditionalData (t DASTData) DASTData) 
+            => t DASTData -> DTypeInfo
+getType = typeOf . getData
+
+setType :: forall (t :: * -> *). 
+            (DAdditionalData (t DASTData) DASTData) 
+            => DTypeInfo -> t DASTData -> t DASTData
+setType t x = setData ((getData x) { typeOf = t }) x
+
+
+isTupleType "(,)" = True
+isPrimitive t = t == "Int" || t == "Bool" || t == "String"  || t == "Double" 
+
+typeFunction ts =  foldr1 (\t ft -> DTypeTerm "->" [t, ft]) ts
+getInputType (DTypeTerm "->" (x:_)) = x
+getVertexType (DTypeTerm "Graph" [tv, te]) = tv
+getEdgeType (DTypeTerm "Graph" [tv, te]) = te
+
+-- initial environment: 
+initEnv :: [VarTypeBind]
+initEnv =
+   [("fst", typeFunction [typeTuple [typeVar "a", typeVar "b"], typeVar "a"]),
+    ("snd", typeFunction [typeTuple [typeVar "a", typeVar "b"], typeVar "b"]),
+    ("Pair", typeFunction [typeVar "a", typeVar "b", typePair [typeVar "a", typeVar "b"]]),
+    ("_fst", typeFunction [typePair [typeVar "a", typeVar "b"], typeVar "a"]),
+    ("_snd", typeFunction [typePair [typeVar "a", typeVar "b"], typeVar "b"]),
+    ("+", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("/", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("*", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("-", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("neg", typeFunction [typeVar "a", typeVar "a"]),
+    ("!=", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    ("==", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    (">=", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    ("<=", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    ("<", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    (">", typeFunction [typeVar "a", typeVar "a", typeDTBool]),
+    ("||", typeFunction [typeDTBool, typeDTBool, typeDTBool]),
+    ("&&", typeFunction [typeDTBool, typeDTBool, typeDTBool]),
+    ("not", typeFunction [typeDTBool, typeDTBool]),
+    ("min", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("max", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("mod", typeFunction [typeVar "a", typeVar "a", typeVar "a"]),
+    ("val", typeFunction [typeVertex [typeVar "a", typeVar "b"], typeVar "a"]),
+    ("vid", typeFunction [typeVertex [typeVar "a", typeVar "b"], typeDTInt]),
+    -- dummy
+    ("bot", typeVar "a")]
+
+
+genNewName i s = (s ++ "_X"++((showHex i "")), i+1) 
+getBaseName s = s --if isPrefixOf "_X" s then else s
+
+-- util
+lookupBy :: Eq b => (a -> b) -> b -> [a] -> Maybe a
+lookupBy _ _ [] = Nothing
+lookupBy f key (x:xs) = if f x == key then Just x else lookupBy f key xs
+
+instance PrettyShow [(String, DTypeInfo)] where
+  prettyShow env = unlines $ map (\(v, t) -> v ++ "::" ++ prettyShow t) env
+                   
+instance PrettyShow DTypeInfo where
+  prettyShow (DTypeVar a) = a
+  prettyShow (DTypeTerm "(,)" ts) = "(" ++ ppList ", " (map prettyShow ts) ++ ")"
+  prettyShow (DTypeTerm "->" [h,t]) = "(" ++ prettyShow h ++ " -> " ++ prettyShow t ++ ")"
+  prettyShow (DTypeTerm s []) = s
+  prettyShow (DTypeTerm s ts) = "(" ++ s ++ " " ++ ppList " " (map prettyShow ts) ++ ")"
+
+ compiler/ASTTrans.hs view
@@ -0,0 +1,209 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables,DeriveGeneric,OverloadedStrings #-}++module ASTTrans+  (transIdElim, transCommElim, transInactivate, collectDPregel,+   dPregelStepArg, isDPregelFixStepArg, collectDConstr, DPregelStepArg,+   collectDependDSmplDef) where++import Spec+import ASTData++import Data.Maybe+import Data.List+import Numeric (showHex)++-- import GenSMT as GS+import Debug.Trace as DT++class ASTTrans a where+  elimId :: a -> a++instance ASTTrans (DProgramSpec a) where+  elimId (DProgramSpec rs p a) = DProgramSpec rs (elimId p) a++instance ASTTrans (DProg a) where+  elimId (DProg f defs e a) = DProg f (map elimId defs) e a++instance ASTTrans (DGroundDef a) where+  elimId (DGDefVC d a) = DGDefVC (elimId d) a+  elimId x = x++instance ASTTrans (DDefVertComp a) where+  elimId (DDefVertComp f ds e a) = DDefVertComp f (map elimId ds) e a++instance ASTTrans (DSmplDef a) where+  elimId (DDefVar f ds e a) = DDefVar f (map elimId ds) (elimId e) a+  elimId (DDefFun f vs ds e a) = DDefFun f vs (map elimId ds) (elimId e) a+  elimId x = x+  -- elimId (DDefTuple vs ds e a) = undefined++instance ASTTrans (DExpr a) where+  elimId (DFunAp f es a) = DFunAp f (map elimId es) a+  elimId (DAggr agg e g es a) = DAggr agg e g (idCheck e agg ++ es) a+  elimId x = x++idCheck :: DExpr a -> DAgg a -> [DExpr a]+idCheck e (DAggMin a) = [DFunAp (DBinOp "<" a) [e, DCExp (DCInt maxint a) a] a]+                        where maxint = 99999999+idCheck e (DAggMax a) =+  [DFunAp (DBinOp ">" a)+          [e, DFunAp (DFun "neg" a) [DCExp (DCInt maxint a) a] a] a]+  where maxint = 99999999+idCheck e (DAggSum a) = [DFunAp (DBinOp "!=" a) [e, DCExp (DCInt 0 a) a] a]+idCheck e (DAggProd a) = [DFunAp (DBinOp "!=" a) [e, DCExp (DCInt 1 a) a] a]+idCheck e (DAggAnd a) = [DFunAp (DBinOp "!=" a) [e, DCExp (DCBool True a) a] a]+idCheck e (DAggOr a) = [DFunAp (DBinOp "!=" a) [e, DCExp (DCBool False a) a] a]+idCheck e _ = []++transIdElim :: (Show a) => DProgramSpec a -> DProgramSpec a+transIdElim = elimId++class ASTTraverse a b | a -> b where+  collectDPregel :: a -> [b]+  collectDPregel _ = []++type DPregelStepArg a = (DFun a, DTermination a)++instance ASTTraverse (DProgramSpec a) (DPregelStepArg a) where+  collectDPregel (DProgramSpec _ prog _) = collectDPregel prog++instance ASTTraverse (DProg a) (DPregelStepArg a) where+  collectDPregel (DProg f gdefs gexpr _) =+    concatMap collectDPregel gdefs ++ collectDPregel gexpr++instance ASTTraverse (DGroundDef a) (DPregelStepArg a) where+  collectDPregel (DGDefGV gv _) = collectDPregel gv+  collectDPregel (DGDefGF gf _) = collectDPregel gf+  collectDPregel _ = []++instance ASTTraverse (DDefGraphVar a) (DPregelStepArg a) where+  collectDPregel (DDefGraphVar _ gexpr _) = collectDPregel gexpr++instance ASTTraverse (DDefGraphFun a) (DPregelStepArg a) where+  collectDPregel (DDefGraphFun _ _ gvs gexpr _) =+    concatMap collectDPregel gvs ++ collectDPregel gexpr++instance ASTTraverse (DGraphExpr a) (DPregelStepArg a) where+  collectDPregel (DPregel initfn stepfn term gexpr _) =+    (stepfn, term) : collectDPregel gexpr+  collectDPregel (DGMap _ gexpr _) = collectDPregel gexpr+  collectDPregel (DGZip gexpr1 gexpr2 _) =+    collectDPregel gexpr1 ++ collectDPregel gexpr2+  collectDPregel (DGIter _ _ _ gexpr _) = collectDPregel gexpr+  collectDPregel _ = []++dPregelStepArg :: String -> [DPregelStepArg a] -> Maybe (DTermination a)+dPregelStepArg name [] = Nothing+dPregelStepArg name ((DFun step _, term) : ds) =+  if name == step then Just term else dPregelStepArg name ds+dPregelStepArg name (_:ds) = dPregelStepArg name ds++isDPregelFixStepArg :: String -> [DPregelStepArg a] -> Bool+isDPregelFixStepArg name [] = False+isDPregelFixStepArg name ((DFun step _, DTermF _) : ds) =+  if name == step then True else isDPregelFixStepArg name ds+isDPregelFixStepArg name ((DFun step _, _) : ds) =+  if name == step then False else isDPregelFixStepArg name ds+isDPregelFixStepArg name (_:ds) = isDPregelFixStepArg name ds++collectDConstr :: DExpr a -> [DConstructor a]+collectDConstr (DIf e1 e2 e3 _) = collectDConstr e2 ++ collectDConstr e3+collectDConstr (DConsAp con es _) = [con]+collectDConstr _ = []++collectDependDSmplDef :: DSmplDef a -> [String]+collectDependDSmplDef (DDefFun f vars locals exp _) =+  collectDependLE (getNames f) vars locals exp++collectDependDSmplDef (DDefVar v locals exp _) =+  collectDependLE [] [v] locals exp++collectDependDSmplDef (DDefTuple vars locals exp _) =+  collectDependLE [] vars locals exp++collectDependLE :: [String] -> [DVar a] -> [DSmplDef a] -> DExpr a -> [String]+collectDependLE names vars locals exp =+  removeDup (freevs0 ++ freevs1)+  where boundvs = names ++ concatMap getNames vars ++ concatMap getNames locals+        freevs0 = removeDep boundvs (concatMap collectDependDSmplDef locals)+        freevs1 = removeDep boundvs (collectDependDExpr exp)++collectDependDExpr :: DExpr a -> [String]+collectDependDExpr (DIf e1 e2 e3 _) = concatMap collectDependDExpr [e1,e2,e3]+collectDependDExpr (DTuple es _) = concatMap collectDependDExpr es+collectDependDExpr (DFunAp fn es _) = concatMap collectDependDExpr es+collectDependDExpr (DConsAp con es _) = concatMap collectDependDExpr es+collectDependDExpr (DAggr ag e gen es _) = concatMap collectDependDExpr (e:es)+collectDependDExpr (DCheckTerm e _) = collectDependDExpr e+collectDependDExpr (DVExp v a) = getNames v+collectDependDExpr _ = []++removeDep :: (Eq a) => [a] -> [a] -> [a]+removeDep names deps = foldr delete deps names++removeDup :: (Eq a) => [a] -> [a]+removeDup [] = []+removeDup (x:xs) = x : delete x (removeDup xs)++transCommElim :: DGroundDef a -> DGroundDef a+transCommElim x = x++transInactivate :: DGroundDef a -> DGroundDef a+transInactivate = id++-- The following code is developed by Morihata++{-+transCommElim :: DProgramSpec a -> DProgramSpec a+transCommElim (DProgramSpec (r:rs) p a) = +    let (con, flds, r') = transDataDecl r +    in DProgramSpec (r' : rs) (transProg (con,flds) p) a++transDataDecl (DRecordSpec con flds a) = +    let DField _ a' = fst (head flds)+    in (con, flds, +        DRecordSpec con ((DField "__changed" a', DTBool a') : flds) a)++transProg con (DProg a defs b c) = DProg a (map (transDef con) defs) b c++transDef con (DGDefVI (DDefVertInit f defs  expr b) c) +    = (DGDefVI (DDefVertInit f (map (transLet con False) defs) +                                 (transExpr con False expr) b) c) +transDef con (DGDefSmpl sd a) = DGDefSmpl (transLet con False sd) a+transDef con (DGDefVC (DDefVertComp f ldefs expr a) b) +    = (DGDefVC (DDefVertComp f (map (transLet con True) ldefs) +                                 (transExpr con True expr) a) b) +transDef c a = a++transLet c flg (DDefFun f vars defs expr a) = +    DDefFun f vars (map (transLet c flg) defs) (transExpr c flg expr) a+transLet c flg (DDefVar v defs expr a) = +    DDefVar v (map (transLet c flg) defs) (transExpr c flg expr) a++transExpr c flg (DIf e1 e2 e3 a) = +    DIf (transExpr c flg e1) (transExpr c flg e2) (transExpr c flg e3) a+transExpr c flg (DFunAp f exprs a) = +    DFunAp f (map (transExpr c flg) exprs) a+transExpr c@(con,flds) flg (DConsAp con' exprs a) = +    let exprs' = map (transExpr c flg) exprs+        equiv (DConstructor a _) (DConstructor b _) = a == b+    in if equiv con' con +       then if flg +            then let anyOf = foldr1 (\p r-> DFunAp (DBinOp "||" a) [p,r] a) +                     preds = zipWith chkEq exprs' flds +                     chkEq e (f,t) = DFunAp (DBinOp "==" a) +                                     [e, DFieldAcc (DPrev (DVar "v" a) a) [f] a] a+                 in DConsAp con (anyOf preds : exprs') a+            else DConsAp con (DCExp (DCBool True a) a : exprs') a +       else DConsAp con exprs' a+transExpr c flg  (DAggr agop e1 ge e2 a) = +    let comChk = DFieldAcc (DPrev (DVar "u" a) a) [DField "__changed" a] a+    in DAggr agop e1 ge (comChk : e2) a+transExpr c flg a = a++transInactivate (DProgramSpec rs (DProg a defs expr c) d) = +   (DProgramSpec rs (DProg a defs (transFregel expr) c) d)++transFregel (DPregel init step (DTermF a) expr b)  = +    DPregel init step (DTermV2H a) expr b+-}
+ compiler/AggregatorExtraction.hs view
@@ -0,0 +1,350 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++Transformation to extract aggregations from complex expressions (and recollect dependency info.?) (5th step).++Assumption:+ - no function definition (other than vertex-computation and vertex-initialization)+ - unique names+ - let-bindings in the order consistent with their dependency+ - no nested aggregation++-}++module AggregatorExtraction where++import Spec+import ASTData++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++-- uniq id, aggregations, in-aggr?, move aggregator flags+type DEnvAE = (DUnique, [DSmplDef DASTData], Bool, [Bool])++class AggExtractable a  where+    aggExtract :: a -> State DEnvAE a  -- returns a transformed expression+    aggExtract x = return x            -- default++getNewName :: String -> State (DEnvAE) DVarName+getNewName s = +    do (i, as, af, mfs) <- get +       let (n, i') = genNewName i s+       put (i', as, af, mfs)+       return n++-- entry point+aggExtraction :: forall (t :: * -> *) a . AggExtractable (t DASTData) => (t DASTData) -> DUnique -> (t DASTData, DUnique)+aggExtraction p uid = let (p', (uid', _, _, _)) = runState (aggExtract p) (uid, [], False, [True])+                      in (p', uid')++aggExtractionE :: (DExpr DASTData) -> DUnique -> (DExpr DASTData, [DSmplDef DASTData], DUnique)+aggExtractionE e uid = let (e', (uid', defs, _, _)) = runState (aggExtract e) (uid, [], False, [True])+                      in (e', defs, uid')+++-- stores the given definition of a varible binding an aggregation to the env.+addAggDef :: DSmplDef DASTData -> State (DEnvAE) ()+addAggDef agg = +    do (d, aggs, b, m) <- get+       put (d, agg:aggs, b, m)++popAggDefs :: State DEnvAE ([DSmplDef DASTData])+popAggDefs =+    do (d, aggs, f, m) <- get+       put (d, [], f, m)+       return aggs++unsetInAgg :: State DEnvAE ()+unsetInAgg =+    do (d, aggs, _, m) <- get+       put (d, aggs, False, m)++setInAgg :: State DEnvAE ()+setInAgg = +    do (d, aggs, f, m) <- get+       if f then error "nested aggregation is not allowed." else put (d, aggs, True, m)++needsAggMove :: State DEnvAE Bool+needsAggMove =+    do x <- get+       let (d, aggs, f, m:ms) = x+       return m++setNeedsAggMove :: State DEnvAE ()+setNeedsAggMove =+    do (d, aggs, f, ms)<- get+       put(d, aggs, f, True:ms)++unsetNeedsAggMove :: State DEnvAE ()+unsetNeedsAggMove =+    do (d, aggs, f, ms) <- get+       put (d, aggs, f, False:ms)++restoreNeedsAggMove :: State DEnvAE ()+restoreNeedsAggMove =+    do x <- get+       let (d, aggs, f, _:ms) = x+       put(d, aggs, f, ms)++instance AggExtractable (DProgramSpec DASTData) where+    aggExtract (DProgramSpec rs p a) = +        do p' <- aggExtract p+           return (DProgramSpec rs p' a)++instance AggExtractable (DConst DASTData) ++liftToGD def = DGDefSmpl def (getData def)++getDep :: forall (t :: * -> *) . (DAdditionalData (t DASTData) DASTData) => (t DASTData) -> [String]+getDep = (depOf . getData)+++setDep :: forall (t :: * -> *) . (DAdditionalData (t DASTData) DASTData) => [String] -> (t DASTData) -> (t DASTData)+setDep deps x = setData ((getData x) { depOf = deps}) x++removeDep names deps = foldr delete deps names++instance AggExtractable (DProg DASTData) where+    aggExtract (DProg f defs e a) = +        do defaggs' <- mapM (\def -> do def' <- aggExtract def; aggs <- popAggDefs; return (def', map liftToGD aggs)) defs+           let defs' = concatMap (\(def', aggs) -> aggs++[def']) defaggs'+           e' <- aggExtract e+           aggs <- popAggDefs+           let defs'' = (defs' ++ map liftToGD aggs) +               deps = removeDep (concatMap getNames defs''++["g"]) $ normalizeDepsX $ map getDep defs'' ++ [depOf (getData e')]+               f' = setDep deps f+               a' = a { depOf = deps}+           return (DProg f' defs'' e' a')++instance AggExtractable (DGroundDef DASTData) where+    aggExtract (DGDefVI d a) = do d' <- aggExtract d+                                  return (DGDefVI d' (a {depOf = getDep d'}) )+    aggExtract (DGDefVC d a) = do d' <- aggExtract d+                                  return (DGDefVC d' (a {depOf = getDep d'}))+    aggExtract (DGDefGV d a) = do d' <- aggExtract d+                                  return (DGDefGV d' (a {depOf = getDep d'}))+    aggExtract (DGDefGF d a) = do d' <- aggExtract d+                                  return (DGDefGF d' (a {depOf = getDep d'}))+    aggExtract (DGDefSmpl d a) = do d' <- aggExtract d+                                    return (DGDefSmpl d' (a {depOf = getDep d'}))++aggExtractLet+    :: forall (t :: * -> *) (v :: * -> *). +       (DAdditionalData (v DASTData) DASTData,+        DAdditionalData (t DASTData) DASTData,+        AggExtractable (v DASTData)+       ) +       => [(t DASTData)] -> [(DSmplDef DASTData)] -> (v DASTData) -> DASTData -> [String] -> Bool -> State DEnvAE ([(t DASTData)], [(DSmplDef DASTData)], (v DASTData), DASTData)+aggExtractLet vs defs e a names extract = +        do defaggs' <- mapM (\def -> do def' <- aggExtract def; aggs <- if extract then popAggDefs else return []; return (def', aggs)) defs+           let defs' = concatMap (\(def', aggs) -> aggs++[def']) defaggs'+           e' <- aggExtract e+           aggs <- if extract then popAggDefs else return []+           let defs'' = (defs' ++ aggs) +               deps = removeDep (concatMap getNames defs''++names) $ normalizeDepsX $ map getDep defs'' ++ [depOf (getData e')]+               vs' = map (setDep deps) vs+               a' = a { depOf = deps}+           return (vs', defs'', e', a')++instance AggExtractable (DDefVertComp DASTData) where+    aggExtract (DDefVertComp f defs e a) = +        do x <- aggExtractLet [f] defs e a ["v", "prev", "curr"] True+           let ([f'], defs', e', a') = x+           return (DDefVertComp f' defs' e' a')++instance AggExtractable (DDefVertInit DASTData) where+    aggExtract (DDefVertInit f defs e a) = +        do x <- aggExtractLet [f] defs e a ["v"] True+           let ([f'], defs', e', a') = x+           return (DDefVertInit f' defs' e' a')++instance AggExtractable (DDefGraphVar DASTData) where+    aggExtract (DDefGraphVar v e a) = +        do e' <- aggExtract e+           let v' = setDep (getDep e') v+           return (DDefGraphVar v' e' (a {depOf = getDep v'}))++instance AggExtractable (DDefGraphFun DASTData) where+    aggExtract (DDefGraphFun f v defs e a) = +        do defs' <- mapM aggExtract defs+           e' <- aggExtract e+           let f' = setDep (getDep e') f+           return (DDefGraphFun f' v defs' e' (a {depOf = getDep f'}))++instance AggExtractable (DSmplDef DASTData) where+    aggExtract (DDefFun f vs [] e a) = +        do x <- aggExtractLet [f] [] e a (concatMap getNames vs) False+           let ([f'], _, e', a') = x+           return (DDefFun f' vs [] e' a')+    aggExtract (DDefVar v [] e a) = +        do x <- aggExtractLet [v] [] e a [] False+           let ([v'], _, e', a') = x+           return (DDefVar v' [] e' a')+    aggExtract (DDefTuple vs [] e a) = +        do x <- aggExtractLet vs [] e a (concatMap getNames vs) False+           let (vs', _, e', a') = x+           return (DDefTuple vs' [] e' a')++instance AggExtractable (DTermination DASTData) where+    aggExtract (DTermF a) = return (DTermF a)+    aggExtract (DTermI e a) = +        do unsetNeedsAggMove+           e' <- aggExtract e+           restoreNeedsAggMove+           return (DTermI e' (a { depOf = getDep e'}))+    aggExtract (DTermU e a) = +        do unsetNeedsAggMove+           e' <- aggExtract e+           restoreNeedsAggMove+           return (DTermU e' (a { depOf = removeDep ["g"] (getDep e')}))++getDeps4 t1 t2 t3 t4 = normalizeDepsX $ [getDep t1, getDep t2, getDep t3, getDep t4]+getDeps3 t1 t2 t3 = normalizeDepsX $ [getDep t1, getDep t2, getDep t3]+getDeps t1 t2 = normalizeDepsX $ [getDep t1, getDep t2]+getDepsX ts = normalizeDepsX $ map getDep ts++normalizeDeps = nub  -- remove duplicated dependency entries+normalizeDepsX = foldr (\a r -> normalizeDeps (a++r)) []++instance AggExtractable (DGraphExpr DASTData) where+    aggExtract (DPregel f0 ft x g a) = +        do f0' <- aggExtract f0+           ft' <- aggExtract ft+           x' <- aggExtract x+           g' <- aggExtract g+           let ds = getDeps4 f0' ft' x' g'+           return (DPregel f0' ft' x' g' (a {depOf = ds}))+    aggExtract (DGMap f g a) = +        do f' <- aggExtract f+           g' <- aggExtract g+           let ds = getDeps f' g'+           return (DGMap f' g' (a {depOf = ds}))+    aggExtract (DGZip g1 g2 a) = +        do g1' <- aggExtract g1+           g2' <- aggExtract g2+           let ds = getDeps g1' g2'+           return (DGZip g1' g2' (a {depOf = ds}))+    aggExtract (DGIter f0 ft x g a) = +        do f0' <- aggExtract f0+           ft' <- aggExtract ft+           x' <- aggExtract x+           g' <- aggExtract g+           let ds = getDeps4 f0' ft' x' g'+           return (DGIter f0' ft' x' g' (a {depOf = ds}))+    aggExtract (DGVar v a) = +        do v' <- aggExtract v +           return (DGVar v' (a {depOf = getDep v'}))++instance AggExtractable (DExpr DASTData) where+    aggExtract (DIf p t e a) = +        do p' <- aggExtract p+           t' <- aggExtract t+           e' <- aggExtract e+           let ds = getDeps3 p' t' e'+           return (DIf p' t' e' (a {depOf = ds}))+    aggExtract (DTuple es a) =+        do es' <- mapM aggExtract es +           let ds = getDepsX es'+           return (DTuple es' (a {depOf = ds}))+    aggExtract (DFunAp f es a) =+        do f' <- aggExtract f+           es' <- mapM aggExtract es+           let ds = normalizeDepsX (getDep f' : map getDep es')+           return (DFunAp f' es' (a {depOf = ds}))+    aggExtract (DConsAp c es a) =+        do c' <- aggExtract c+           es' <- mapM aggExtract es+           let ds = normalizeDepsX (getDep c' : map getDep es')+           return (DConsAp c' es' (a {depOf = ds}))+    aggExtract (DFieldAcc t fs a) =+        do t' <- aggExtract t+           fs' <- mapM aggExtract fs+           let ds = normalizeDepsX (getDep t' : map getDep fs')+           return (DFieldAcc t' fs' (a {depOf = ds}))+    aggExtract (DFieldAccE e fs a) =+        do e' <- aggExtract e+           fs' <- mapM aggExtract fs+           let ds = normalizeDepsX (getDep e' : map getDep fs')+           return (DFieldAccE e' fs' (a {depOf = ds}))+    aggExtract (DAggr a' e g es a) =+        do setInAgg+           a'' <- aggExtract a'+           g' <- aggExtract g+           e' <- aggExtract e+           es' <- mapM aggExtract es+           let ds = removeDep (case g of (DGenG _) -> ["u"]; (DGenTermG _) -> ["u"]; _ -> ["u","e"]) $ normalizeDepsX (getDep g' : getDep a'' : map (getDep) (e':es'))+           moveflag <- needsAggMove+           if moveflag then(do -- assigning a new name to this aggregation expression+                             newName <- getNewName "agg"+                             let d = [newName]+                                 v = DVar newName (a {depOf = d})  -- new variable biding the aggregation+                                 def = DDefVar v [] (DAggr a'' e' g' es' (a {depOf = ds})) (a {depOf = ds})+                             -- store the definition in the env+                             addAggDef def+                             unsetInAgg+                             return (DVExp v (a {depOf = d})))  -- returns the varible as the expression+           else do unsetInAgg+                   return (DAggr a'' e' g' es' (a {depOf = ds}))+    aggExtract (DVExp v a) =+        do v' <- aggExtract v+           return (DVExp v' (a {depOf = getDep v'}))+    aggExtract (DCExp c a) = +        do c' <- aggExtract c +           return (DCExp c' (a {depOf = getDep c'}))++instance AggExtractable (DAgg DASTData) where+    aggExtract (DAggMin a) = +        do return (DAggMin (a { depOf = ["minimum"] }))+    aggExtract (DAggMax a) = +        do return (DAggMax (a { depOf = ["maximum"] }))+    aggExtract (DAggSum a) = +        do return (DAggSum (a { depOf = ["sum"] }))+    aggExtract (DAggProd a) = +        do return (DAggProd (a { depOf = ["prod"] }))+    aggExtract (DAggAnd a) = +        do return (DAggAnd (a { depOf = ["and"] }))+    aggExtract (DAggOr a) = +        do return (DAggOr (a { depOf = ["or"] }))+    aggExtract (DAggChoice x a) =+        do x' <- aggExtract x+           let ds = getDep x'+           return (DAggChoice x' (a { depOf = "random":ds }))+    aggExtract (DTupledAgg as a) = +        do as' <- mapM aggExtract as+           let ds = getDepsX as'+           return (DTupledAgg as' (a { depOf = ds }))++instance AggExtractable (DGen DASTData) where+    aggExtract (DGenI a) = return (DGenI (a {depOf = ["v"]}))+    aggExtract (DGenO a) = return (DGenO (a {depOf = ["v"]}))+    aggExtract (DGenG a) = return (DGenG (a {depOf = ["g"]}))+    aggExtract (DGenTermG a) = return (DGenTermG (a {depOf = ["g"]}))++instance AggExtractable (DEdge DASTData) where+    aggExtract (DEdge a) = return (DEdge (a {depOf = ["e"]}))++instance AggExtractable (DTableExpr DASTData) where+    aggExtract (DPrev v a) = return (DPrev v (a {depOf = [getName v, "prev"]}))+    aggExtract (DCurr v a) = return (DCurr v (a {depOf = [getName v, "curr"]}))+    aggExtract (DVal v a) = return (DVal v (a {depOf = [getName v, "val"]}))++instance AggExtractable (DField DASTData) where+--    aggExtract (DFfst a) = return (DFfst (a {depOf = ["_fst"]}))+--    aggExtract (DFsnd a) = return (DFsnd (a {depOf = ["_snd"]}))+    aggExtract (DField f a) = return (DField f (a {depOf = [f]}))++instance AggExtractable (DFun DASTData) where+    aggExtract (DBinOp f a) = return (DBinOp f (a {depOf = [f]}))+    aggExtract (DFun f a) = return (DFun f (a {depOf = [f]}))++instance AggExtractable (DVar DASTData) where+    aggExtract (DVar v a) = return (DVar v (a {depOf = [v]}))++instance AggExtractable (DConstructor DASTData) where+    aggExtract (DConstructor c a) = return (DConstructor c (a {depOf = [c]}))+
+ compiler/Analysis.hs view
@@ -0,0 +1,523 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}+++{-++Depencency check, reordering of let-bindings, and alpha renaming with unique names. (1st step)++-}++module Analysis where++import Spec++import Debug.Trace++import Control.Monad.State+import Data.Maybe+import Data.List+import ASTData++type DNewName = DVarName+type DDepth = Int+type DDepVar = (DVarName, (DDepth, DNewName))+type DDeps = [DDepVar]+type DEnvDC a = ([(DDeps, DDepth)], DUnique, a, Bool)++-- extracted aggregations, in-aggregator flag, +type NormalizeData1 a = ([DSmplDef (DDeps, a)], Bool, [Bool])+class DepCheckable a b c | a -> b c where+    depCheck :: a -> State (DEnvDC c) b  -- assigns [(name to which the given term depends, depth)] to the given term+++-- to flattern definitions (within a vertex-compute/vertex-init function)+collectDef :: DSmplDef a -> [DSmplDef a]+collectDef (DDefFun f vs defs e a) = concatMap collectDef defs++[(DDefFun f vs [] e a)]+collectDef (DDefVar v defs e a) = concatMap collectDef defs++[(DDefVar v [] e a)]+collectDef (DDefTuple vs defs e a) = concatMap collectDef defs++[(DDefTuple vs [] e a)]++-- getter/setter on the environment++getEnvDepth' :: DEnvDC a -> DDepth+getEnvDepth' (bds, _, _, _) = snd (head bds)++getEnvDepth :: State (DEnvDC a) DDepth+getEnvDepth = +    do env <- get +       return (getEnvDepth' env)++getEnvBinds' :: DEnvDC a -> DDeps+getEnvBinds' (bds, _, _, _) = fst (head bds)++getEnvBinds :: State (DEnvDC a) DDeps+getEnvBinds = +    do env <- get +       return (getEnvBinds' env)++setEnvBindsDepth :: (DDeps, DDepth) -> State (DEnvDC a) ()+setEnvBindsDepth bd =+    do (bds, i, a, b) <- get+       put (bd:bds, i, a, b)++popBindsDepth :: State (DEnvDC a) ()+popBindsDepth =+    do (bds, i, a, b) <- get+       put (tail bds, i, a, b)++getNewName :: String -> State (DEnvDC a) DNewName+getNewName n = +    do (bds, i, a, b) <- get +       let (nn, i') = genNewName i n+       put (bds, i', a, b)+       return nn++doingAlpha :: State (DEnvDC a) Bool+doingAlpha =+    do (bds, i, a, b) <- get+       return b++replaceApostrophe n = map (\c -> if c == '\'' then 'X' else c) n+              +-- orgName = true => new name = original name  (for predefined identifiers)+getNewName' :: Bool -> (DVarName, DDepth) -> State (DEnvDC a) DDepVar+getNewName' orgName (n, d) = +    do b <- doingAlpha+       if b then do let n' = replaceApostrophe n+                    nn <- getNewName n'+                    return (n, (d, if orgName then n else nn))+            else return (n, (d, n))++getDVDepth :: DDepVar -> DDepth+getDVDepth (_, (d, _)) = d++getDVVar :: DDepVar -> DVarName+getDVVar (v, (_, _)) = v++getDVNewName :: DDepVar -> DNewName+getDVNewName (_, (_, n)) = n++-- entry point for analysis chain (accepts the uniq ID)+dependencyC :: forall (t :: * -> *) a . +               (DepCheckable (t a) (t (DDeps, a)) (NormalizeData1 a),+                DAdditionalData2 (t (DDeps, a)) (DDeps, a) ([String], a) (t ([String], a))) +               => DUnique -> t a -> (t ([DVarName], a), DUnique)+dependencyC uid p = +    let (ast, uid') = dependencyC' uid p+    in (mapData (\(ds::DDeps, a::a) -> (map (snd.snd) ds, a)) ast, uid')++dependencyC' :: forall (t :: * -> *) a . +               (DepCheckable (t a) (t (DDeps, a)) (NormalizeData1 a),+                DAdditionalData2 (t (DDeps, a)) (DDeps, a) ([String], a) (t ([String], a))) +               => DUnique -> t a -> (t (DDeps, a), DUnique)+dependencyC' uid p = +    let (ast, (_,uid',_,_)) = runState (depCheck0 p) ([([], -2)], uid, ([], False, [True]), True)+    in (ast, uid')++-- no alpha-renaming+topoSortOnly :: forall (t :: * -> *) a . +               (DepCheckable (t a) (t (DDeps, a)) (NormalizeData1 a),+                DAdditionalData2 (t (DDeps, a)) (DDeps, a) a (t a)) +               => t a -> t a+topoSortOnly p = +  let (ast, _) = runState (depCheck0 p) ([([], -2)], -100, ([], False, [True]), False)+  in mapData (snd::(DDeps,a)->a) ast++-- entry point for single use+dependency :: forall (t :: * -> *) a . +               (DepCheckable (t a) (t (DDeps, a)) (NormalizeData1 a),+                DAdditionalData2 (t (DDeps, a)) (DDeps, a) ([String], a) (t ([String], a))+               ) => t a -> t (DDeps, a)+dependency p = fst $ dependencyC' 0 p++-- cleaned version+dependency' :: forall (t :: * -> *) a . +               (DepCheckable (t a) (t (DDeps, a)) (NormalizeData1 a),+                DAdditionalData2 (t (DDeps, a)) (DDeps, a) ([String], a) (t ([String], a))+               ) => t a -> t ([String], a)+dependency' p = fst $ dependencyC 0 p+++-- cleaned data++depCheck0 p = +    do addNames' True initDCnames  -- names at level -1+       depCheck p+  +initDCnames = map fst initEnv++-- misc functions for dependencies+getDep :: forall (t :: * -> *) b . (DAdditionalData (t (DDeps, b)) (DDeps, b)) => (t (DDeps, b)) -> DDeps+getDep = fst . getData++getDepL :: forall (t :: * -> *) b . (DAdditionalData (t (DDeps, b)) (DDeps, b)) => Int -> (t (DDeps, b)) -> DDeps+getDepL depth = filter ((< depth) . getDVDepth ) . getDep    -- names in lower (outer) depth levels+getDepE depth = filter ((== depth) . getDVDepth ) . getDep   -- names at the depth level++getDeps a b = normalizeDepsX [getDep a, getDep b]+getDeps3 a b c = normalizeDepsX [getDep a, getDep b, getDep c]+getDeps4 a b c d = normalizeDepsX [getDep a, getDep b, getDep c, getDep d]+getDepsX es = normalizeDepsX $ map getDep es++normalizeDeps :: DDeps -> DDeps+normalizeDeps = nub  -- remove duplicated dependency entries++normalizeDepsX ::[DDeps] -> DDeps+normalizeDepsX = foldr (\a r -> normalizeDeps (a++r)) []++-- reordering the let bindings (or any named things) according to their dependencies among them+-- NOTE: run after the alpha-conversion+depTopoSort ::  forall (t :: * -> *) b . (DNamed (t (DDeps, b)), DAdditionalData (t (DDeps, b)) (DDeps, b)) =>+     DDepth -> [(t (DDeps, b)) ] -> [(t (DDeps, b)) ]+depTopoSort depth ts = depTopoSort' True depth ts++-- withNew == True => using new alpha-converted names +depTopoSort' ::  forall (t :: * -> *) b . (DNamed (t (DDeps, b)), DAdditionalData (t (DDeps, b)) (DDeps, b)) =>+     Bool -> DDepth -> [(t (DDeps, b)) ] -> [(t (DDeps, b)) ]+depTopoSort' withNew depth ts = ds'+ where+  ts' = zip [0..] ts+  vs = map findDepIds ts'+  findDepIds (i, t) = (i, map findId $ getDepE depth t, t)+  findId :: DDepVar -> Int  -- this dv is defined in the returned position+  findId dv = let tt = findIndices (elem (if withNew then getDVNewName dv else getDVVar dv) . getNames) ts in if tt == [] then error ("Something wrong: " ++ show (map getNames ts) ++ " -- " ++ (show dv)) else head tt+  (ds, ok) = topologicalSort vs +  ds' = if ok then map snd ds else error ("circular dependency among " ++ show (map getNames ts))++-- topological sort algorithm: https://ja.wikipedia.org/wiki/%E3%83%88%E3%83%9D%E3%83%AD%E3%82%B8%E3%82%AB%E3%83%AB%E3%82%BD%E3%83%BC%E3%83%88+-- (id, outNeighbors, data)+-- id starts from 0, contiguous =>  assumption: vs!!i = (i, _, _)+topologicalSort :: [(Int, [Int], a)] -> ([(Int, a)], Bool)+topologicalSort vs =+  let vs' = map (findIncoming vs) vs+      findIncoming us (v,ns,d) = (v, ns, d, length $ filter (\(_, os, _) -> elem v os) us)+      ins (_,_,_,i) = i+      decIns (x,ns,d,i) = (x, ns, d, i-1)+      noIncomings = filter ((==0) . ins)+      s = noIncomings vs'+      (l, g) = rec s [] vs'+      ok = all ((==0). ins)g+      rec [] l g = (l, g)+      rec (((x, ns, d, _)):s) l g +          = let l' = (x, d):l+                (g', s') = foldr step (g, s) ns+                step j (g, s) = let (g1, y:g2) = splitAt j g+                                    g' = g1++((decIns y):g2)+                                in (g', if ins y == 1 then y:s else s)+            in rec s' l' g'+  in (l, ok)+++-- adds names to the envitonment, returns the old env with the current depth+addNames :: [String] -> State (DEnvDC a) (Int, [DNewName])+addNames ns = addNames' False ns++addNames' :: Bool -> [String] -> State (DEnvDC a) (Int, [DNewName])+addNames' orgName ns = +    do depth <- getEnvDepth+       binds <- getEnvBinds+       let ns' = if ns == nub ns then ns else error ("multiple definitions in " ++ show ns)+           depth' = depth + 1+           nds = zip ns' (repeat depth')+       binds' <- mapM (getNewName' orgName) nds+       setEnvBindsDepth (binds'++ binds, depth')+       return (depth', map getDVNewName binds')++-- removed added names by addNames+popNames :: State (DEnvDC a) ()+popNames = popBindsDepth++{- dependency check of expression e with simple-let-bindings defs -}+depCheckLet+    :: forall (u :: * -> *) b a . +       (DepCheckable (u b) (u (DDeps, b)) (NormalizeData1 b),+        DAdditionalData (u (DDeps, b)) (DDeps, b)) +       => [(DSmplDef b)] -> (u b) -> [DVarName] -> State (DEnvDC (NormalizeData1 b)) ([(DSmplDef (DDeps, b))], (u (DDeps, b)), DDeps, [DNewName])+depCheckLet defs e vs = depCheckLetG' False defs e vs++-- general version +depCheckLetG' +    :: forall (t :: * -> *) (u :: * -> *) b . +       (DNamed (t b), +        DNamed (t (DDeps, b)), +        DepCheckable (t b) (t (DDeps, b)) (NormalizeData1 b),+        DepCheckable (u b) (u (DDeps, b)) (NormalizeData1 b),+        DAdditionalData (t (DDeps, b)) (DDeps, b),+        DAdditionalData (u (DDeps, b)) (DDeps, b)) +       => Bool -> [(t b)] -> (u b) -> [DVarName] -> State (DEnvDC (NormalizeData1 b)) ([(t (DDeps, b))], (u (DDeps, b)), DDeps, [DNewName])+depCheckLetG' orgName defs e vs =+    do (_, nvs) <- addNames' orgName vs  -- add the argument variables first,+       let ons = concatMap getNames defs+       (depth, nns) <- addNames ons -- then add the let-bindings+       defs' <- mapM depCheck defs+       e' <- depCheck e+       let defs'' = replaceNames nns defs'  +           dss = map (getDepL depth) defs'' ++ [getDepL depth e'] +           ds = normalizeDepsX dss+           defs''' = depTopoSort depth $ defs''  -- sort the bindings according to their dependency+       popNames+       popNames+       return (defs''', e', ds, nvs)++{- replaces old names with newnames at the depth -}+replaceNames nns dfs = dfs'+  where dfs' = evalState (mapM setNames dfs) nns++instance (Show a) => DepCheckable (DProgramSpec a) (DProgramSpec (DDeps, a)) (NormalizeData1 a) where+    depCheck (DProgramSpec rs p a) = +        do (rs', p', ds, _) <- depCheckLetG' False rs p []+           return (DProgramSpec rs' p' (ds, a))++{- newly introduced names have no dependency -}+nullDep :: forall (k :: * -> *) a.+                 DAdditionalData2 (k a) a (DDeps, a) (k (DDeps, a)) =>+                 (k a) -> (k (DDeps, a))+nullDep f = mapData null f+  where null :: a -> (DDeps, a)+        null a = ([], a)++instance Show a => DepCheckable (DRecordSpec a) (DRecordSpec (DDeps, a)) (NormalizeData1 a) where+    depCheck (DRecordSpec c fts a) =+        do dst <- mapM depCheck (map snd fts)+           let dsf = map nullDep (map fst fts)+               c' = nullDep c+               fts' = zip dsf dst+               ds = normalizeDeps $ concatMap getDep dst+               ret = (DRecordSpec c' fts' (ds, a))+           return ret++instance DepCheckable (DType a) (DType (DDeps, a)) (NormalizeData1 a) where+    depCheck (DTInt a) = return (DTInt ([],a))+    depCheck (DTBool a) = return (DTBool ([],a))+    depCheck (DTString a) = return (DTString ([],a))+    depCheck (DTDouble a) = return (DTDouble ([],a))+    depCheck (DTTuple ts a) = +        do ts' <- mapM depCheck ts+           let ds = normalizeDeps $ concatMap getDep ts'+           return (DTTuple ts' (ds, a))+    depCheck (DTRecord c ts a) = +        do c' <- depCheck c+           ts' <- mapM depCheck ts+           let ds = normalizeDeps $ concatMap getDep ts' ++ getDep c'+           return (DTRecord c' ts' (ds,a))++instance DepCheckable (DConst a) (DConst (DDeps, a)) (NormalizeData1 a) where+    depCheck (DCInt c a) = return (DCInt c ([], a))+    depCheck (DCBool c a) = return (DCBool c ([], a))+    depCheck (DCString c a) = return (DCString c ([], a))+    depCheck (DCDouble c a) = return (DCDouble c ([], a))++instance DepCheckable (DProg a) (DProg (DDeps, a)) (NormalizeData1 a) where+    depCheck (DProg f defs e a) = +        do (defs', e', ds, _) <- depCheckLetG' True defs e ["g"]+           let f' = nullDep f+           return (DProg f' defs' e' (ds, a))++instance DepCheckable (DGroundDef a) (DGroundDef (DDeps, a)) (NormalizeData1 a) where+    depCheck (DGDefVI d a) = do d' <- depCheck d+                                return (DGDefVI d' (getDep d', a))+    depCheck (DGDefVC d a) = do d' <- depCheck d+                                return (DGDefVC d' (getDep d', a))+    depCheck (DGDefGV d a) = do d' <- depCheck d+                                return (DGDefGV d' (getDep d', a))+    depCheck (DGDefGF d a) = do d' <- depCheck d+                                return (DGDefGF d' (getDep d', a))+    depCheck (DGDefSmpl d a) = do d' <- depCheck d+                                  return (DGDefSmpl d' (getDep d', a))++instance DepCheckable (DDefVertComp a) (DDefVertComp (DDeps, a)) (NormalizeData1 a) where+    depCheck (DDefVertComp f defs e a) = +        do (defs', e', ds, _) <- depCheckLetG' True defs e ["v", "prev", "curr"]+           let f' = nullDep f+               defs'' = concatMap collectDef defs'+           return (DDefVertComp f' defs'' e' (ds, a))++instance DepCheckable (DDefVertInit a) (DDefVertInit (DDeps, a)) (NormalizeData1 a) where+    depCheck (DDefVertInit f defs e a) = +        do (defs', e', ds, _) <- depCheckLetG' True defs e ["v"]+           let f' = nullDep f+               defs'' = concatMap collectDef defs'+           return (DDefVertInit f' defs'' e' (ds, a))++instance DepCheckable (DDefGraphVar a) (DDefGraphVar (DDeps, a)) (NormalizeData1 a) where+    depCheck (DDefGraphVar v e a) = +        do e' <- depCheck e+           let v' = nullDep v+           return (DDefGraphVar v' e' (getDep e', a))++instance DepCheckable (DDefGraphFun a) (DDefGraphFun (DDeps, a)) (NormalizeData1 a) where+    depCheck (DDefGraphFun f v defs e a) = +        do (defs', e', ds, vns) <- depCheckLetG' True defs e (getNames v)+           let f' = nullDep f+               [v'] = replaceNames vns [nullDep v]+           return (DDefGraphFun f' v' defs' e' (ds, a))++instance DepCheckable (DSmplDef a) (DSmplDef (DDeps, a)) (NormalizeData1 a) where+    depCheck (DDefFun f vs defs e a) = +        do let vns = concatMap getNames vs+               f' = nullDep f+               vs' = map nullDep vs+           (defs', e', ds, vns') <- depCheckLet defs e vns+           let vs'' = replaceNames vns' vs'+           return (DDefFun f' vs'' defs' e' (ds, a))+    depCheck (DDefVar v defs e a) = +        do (defs', e', ds, _) <- depCheckLet defs e []+           let v' = nullDep v+           return (DDefVar v' defs' e' (ds, a))+    depCheck (DDefTuple vs defs e a) = +        do (defs', e', ds, _) <- depCheckLet defs e []+           let vs' = map nullDep vs+           return (DDefTuple vs' defs' e' (ds, a))++instance DepCheckable (DTermination a) (DTermination (DDeps, a)) (NormalizeData1 a) where+    depCheck (DTermF a) = return (DTermF ([], a)) +    depCheck (DTermI e a) = +        do e' <- depCheck e+           return (DTermI e' (getDep e', a))+    depCheck (DTermU e a) = +        do addNames' True ["g"]+           e' <- depCheck e+           popNames+           return (DTermU e' (getDep e', a))++instance DepCheckable (DGraphExpr a) (DGraphExpr (DDeps, a)) (NormalizeData1 a) where+    depCheck (DPregel f0 ft x g a) = +        do f0' <- depCheck f0+           ft' <- depCheck ft+           x' <- depCheck x+           g' <- depCheck g+           let ds = getDeps4 f0' ft' x' g'+           return (DPregel f0' ft' x' g' (ds, a))+    depCheck (DGMap f g a) = +        do f' <- depCheck f+           g' <- depCheck g+           let ds = getDeps f' g'+           return (DGMap f' g' (ds, a))+    depCheck (DGZip g1 g2 a) = +        do g1' <- depCheck g1+           g2' <- depCheck g2+           let ds = getDeps g1' g2'+           return (DGZip g1' g2' (ds, a))+    depCheck (DGIter f0 ft x g a) = +        do f0' <- depCheck f0+           ft' <- depCheck ft+           x' <- depCheck x+           g' <- depCheck g+           let ds = getDeps4 f0' ft' x' g'+           return (DGIter f0' ft' x' g' (ds, a))+    depCheck (DGVar v a) = +        do v' <- depCheck v +           return (DGVar v' (getDep v', a))+++instance DepCheckable (DExpr a) (DExpr (DDeps, a)) (NormalizeData1 a) where+    depCheck (DIf p t e a) = +        do p' <- depCheck p+           t' <- depCheck t+           e' <- depCheck e+           let ds = getDeps3 p' t' e'+           return (DIf p' t' e' (ds, a))+    depCheck (DTuple es a) =+        do es' <- mapM depCheck es +           let ds = getDepsX es'+           return (DTuple es' (ds, a))+    depCheck (DFunAp f es a) =+        do f' <- depCheck f+           es' <- mapM depCheck es+           let ds = normalizeDepsX (getDep f' : map getDep es')+           return (DFunAp f' es' (ds, a))+    depCheck (DConsAp c es a) =+        do c' <- depCheck c+           es' <- mapM depCheck es+           let ds = normalizeDepsX (getDep c' : map getDep es')+           return (DConsAp c' es' (ds, a))+    depCheck (DFieldAcc t fs a) =+        do t' <- depCheck t+           fs' <- mapM depCheck fs+           let ds = normalizeDepsX (getDep t' : map getDep fs')+           return (DFieldAcc t' fs' (ds, a))+    depCheck (DFieldAccE e fs a) =+        do e' <- depCheck e+           fs' <- mapM depCheck fs+           let ds = normalizeDepsX (getDep e' : map getDep fs')+           return (DFieldAccE e' fs' (ds, a))+    depCheck (DAggr a' e g es a) =+        do let a'' = nullDep a'+           g' <- depCheck g+           (depth, _) <- addNames' True (getNames g)+           e' <- depCheck e+           es' <- mapM depCheck es+           popNames+           let ds = normalizeDepsX (getDep g' : map (getDepL depth) (e':es'))+           return (DAggr a'' e' g' es' (ds, a))+    depCheck (DVExp v a) =+        do v' <- depCheck v+           return (DVExp v' (getDep v', a))+    depCheck (DCExp c a) = +        do c' <- depCheck c +           return (DCExp c' (getDep c', a))++instance DepCheckable (DGen a) (DGen (DDeps, a)) (NormalizeData1 a) where+    depCheck (DGenI a) = +        do d <- checkDefined "v"           -- hard-coded...+           return (DGenI ([d], a))+    depCheck (DGenO a) = +        do d <- checkDefined "v"+           return (DGenO ([d], a))+    depCheck (DGenG a) = +        do return (DGenG ([], a))+    depCheck (DGenTermG a) = +        do return (DGenTermG ([], a))++instance DepCheckable (DEdge a) (DEdge (DDeps, a)) (NormalizeData1 a) where+    depCheck (DEdge a) = +        do d <- checkDefined "e"+           return (DEdge ([d], a))++instance DepCheckable (DTableExpr a) (DTableExpr (DDeps, a)) (NormalizeData1 a) where+    depCheck (DPrev v a) = +        do v' <- depCheck v +           d <- checkDefined "prev"+           return (DPrev v' (d:getDep v', a))+    depCheck (DCurr v a) = +        do v' <- depCheck v +           d <- checkDefined "curr"+           return (DCurr v' (d:getDep v', a))+    depCheck (DVal v a) = +        do v' <- depCheck v +           return (DVal v' (getDep v', a))++checkDefined n = +  do binds <- getEnvBinds+     case (lookup n binds) of+       Just d -> return (n, d)+       Nothing -> error ("\nUndefined in dependency check " ++ n ++ " in " ++ show binds)++-- do not use these depChecks in field/fun/var/constructor definitions+instance DepCheckable (DField a) (DField (DDeps, a)) (NormalizeData1 a) where+    depCheck (DField f a) = +        do d <- checkDefined f+           return (DField (getDVNewName d) ([d], a))+--    depCheck (DFfst a) = +--        do return (DFfst ([], a))+--    depCheck (DFsnd a) = +--        do return (DFsnd ([], a))++instance DepCheckable (DFun a) (DFun (DDeps, a)) (NormalizeData1 a) where+    depCheck (DFun f a) = +        do d <- checkDefined f+           return (DFun (getDVNewName d) ([d], a))+    depCheck (DBinOp f a) = +        do d <- checkDefined f+           return (DBinOp (getDVNewName d) ([d], a))++instance DepCheckable (DVar a) (DVar (DDeps, a)) (NormalizeData1 a) where+    depCheck (DVar v a) = +        do d <- checkDefined v+           return (DVar (getDVNewName d) ([d], a))++instance DepCheckable (DConstructor a) (DConstructor (DDeps, a)) (NormalizeData1 a) where+    depCheck (DConstructor c a) = +        do d <- checkDefined c+           return (DConstructor (getDVNewName d) ([d], a))++
+ compiler/Convert0.hs view
@@ -0,0 +1,117 @@+module Convert0 where+import Lexer hiding (main)+import Spec+import Spec0+import Control.Monad.State++type Pos = AlexPosn++v2f (DVar n a) = DFun n a+                                     +convert0 :: DProgramSpec0 Pos -> DProgramSpec Pos+convert0 (DProgramSpec0 rs p a) = DProgramSpec rs (toProg p) a++toProg :: DSmplDef0 Pos -> DProg Pos+toProg (DDefFun0 f [DVar "g" _] ds e a) = DProg (v2f f) (toGroundDefs ds) (toGraphExpr e) a+toProg x = error $ "top-level definition must be a function of the form 'prog g = ...' (at" ++ showPosn (getData x) ++ ")"++-- converting some of functions/variables to graph-level's++toGroundDefs :: [DSmplDef0 Pos] -> [DGroundDef Pos]+toGroundDefs = map toGroundDef++toGroundDef :: DSmplDef0 Pos -> DGroundDef Pos+toGroundDef (DDefFun0 f [DVar "v" _] ds e a)   --- 'f v = ...' is regarded as an initialization func.+  = DGDefVI (DDefVertInit (v2f f) (toSmplDefs ds) (toExpr e) a) a+toGroundDef (DDefVertComp0 f ds e a)           --- f v prev curr is a vertex-compute func.+  = DGDefVC (DDefVertComp (v2f f) (toSmplDefs ds) (toExpr e) a) a+toGroundDef (DDefFun0 f [v] ds e a)            --- if the body consists of graph exprs => regerded as a graph func.+  | isGraphExpr e || isGraphVarDefs ds+  = DGDefGF (DDefGraphFun (v2f f) v (toGraphVarDefs ds) (toGraphExpr e) a) a+toGroundDef (DDefVar0 v [] e a)                --- if the body is a graph expr => regarded as a graph var.+  | isGraphExpr e+  = DGDefGV (DDefGraphVar v (toGraphExpr e) a) a+toGroundDef x = DGDefSmpl (toSmplDef x) (getData x)  -- default++isGraphVarDefs :: [DSmplDef0 Pos] -> Bool+isGraphVarDefs = all isGraphVarDef++isGraphVarDef :: DSmplDef0 Pos -> Bool+isGraphVarDef (DDefVar0 v [] e a)+  | isGraphExpr e+  = True+isGraphVarDef _ = False++toGraphVarDefs :: [DSmplDef0 Pos] -> [DDefGraphVar Pos]+toGraphVarDefs = map toGraphVarDef++toGraphVarDef :: DSmplDef0 Pos -> DDefGraphVar Pos+toGraphVarDef (DDefVar0 v [] e a)+  | isGraphExpr e  -- double-check+  = DDefGraphVar v (toGraphExpr e) a++isGraphExpr :: DExpr0 Pos -> Bool+isGraphExpr (DPregel0 _ _ _ _ _) = True+isGraphExpr (DGMap0 _ _ _) = True+isGraphExpr (DGZip0 _ _ _) = True+isGraphExpr (DGIter0 _ _ _ _ _) = True+isGraphExpr (DVExp0 _ _) = True+isGraphExpr _ = False++toGraphExpr :: DExpr0 Pos -> DGraphExpr Pos+toGraphExpr (DPregel0 i s t g a) = DPregel (v2f i) (v2f s) (toTermination t) (toGVar g) a+toGraphExpr (DGMap0 f g a) = DGMap (v2f f) (toGVar g) a+toGraphExpr (DGZip0 g1 g2 a) = DGZip (toGVar g1) (toGVar g2) a+toGraphExpr (DGIter0 i s t g a) = DGIter (v2f i) (v2f s) (toTermination t) (toGVar g) a+toGraphExpr (DVExp0 v a) = DGVar v a++toGVar :: DVar Pos -> DGraphExpr Pos+toGVar v = DGVar v (getData v)++toTermination :: DTermination0 Pos -> DTermination Pos+toTermination (DTermF0 a) = DTermF a+toTermination (DTermI0 e a) = DTermI (toExpr e) a+toTermination (DTermU0 e a) = DTermU (toExpr e) a+toTermination (DTermV2H0 a) = DTermV2H a++---- the rest is not in the graph-level++toSmplDefs :: [DSmplDef0 Pos] -> [DSmplDef Pos]+toSmplDefs = map toSmplDef++toSmplDef :: DSmplDef0 Pos -> DSmplDef Pos+toSmplDef (DDefFun0 f vs ds e a) = DDefFun (v2f f) vs (toSmplDefs ds) (toExpr e) a+toSmplDef (DDefVar0 v ds e a) = DDefVar v (toSmplDefs ds) (toExpr e) a+toSmplDef (DDefTuple0 vs ds e a) = DDefTuple vs (toSmplDefs ds) (toExpr e) a+toSmplDef (DDefVertComp0 _ _ _ a) = error $ "definition of a vertex-func. is not allowed here (at "++ showPosn a ++")"++toExprs :: [DExpr0 Pos] -> [DExpr Pos]+toExprs = map toExpr++toExpr :: DExpr0 Pos -> DExpr Pos+toExpr (DIf0 e1 e2 e3 a) = DIf (toExpr e1) (toExpr e2) (toExpr e3) a+toExpr (DTuple0 es a) = DTuple (toExprs es) a+toExpr (DFunAp0 f es a) = DFunAp f (toExprs es) a+toExpr (DConsAp0 c es a) = DConsAp c (toExprs es) a+toExpr (DFieldAcc0 t fs a) = DFieldAcc t fs a+toExpr (DFieldAccE0 e fs a) = DFieldAccE e fs a+toExpr (DAggr0 ag e g es a) = DAggr (toAgg ag) (toExpr e) g (toExprs es) a+toExpr (DCheckTerm0 e a) = DCheckTerm (toExpr e) a+toExpr (DVExp0 (DVar "e" b) a) = DFieldAccE (DEdge b) [] a   -- "e" is a special variable to access an edge +toExpr (DVExp0 v a) = DVExp v a+toExpr (DCExp0 c a) = DCExp c a+toExpr (DPregel0 _ _ _ _ a) = error $ "graph expression is not allowed here (at "++ showPosn a ++")"+toExpr (DGMap0 _ _ a)       = error $ "graph expression is not allowed here (at "++ showPosn a ++")"+toExpr (DGZip0 _ _ a)       = error $ "graph expression is not allowed here (at "++ showPosn a ++")"+toExpr (DGIter0 _ _ _ _ a)  = error $ "graph expression is not allowed here (at "++ showPosn a ++")"++toAgg :: DAgg0 Pos -> DAgg Pos+toAgg (DAggMin0 a) = DAggMin a +toAgg (DAggMax0 a) = DAggMax a+toAgg (DAggSum0 a) = DAggSum a+toAgg (DAggProd0 a) = DAggProd a+toAgg (DAggAnd0 a) = DAggAnd a+toAgg (DAggOr0 a) = DAggOr a+toAgg (DAggChoice0 e a) = DAggChoice (toExpr e) a+toAgg (DTupledAgg0 ags a) = DTupledAgg (map toAgg ags) a   +
+ compiler/DependencySimple.hs view
@@ -0,0 +1,265 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++Collecting dependency info. as the last phase of transformation on ASTs. (10th step)++-}++module DependencySimple where++import Spec+import ASTData++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace+++-- entry point++computeDependency p = let (p', _) = runState (depAnnotate p) ()+                      in p'++class DependencyAnnotatable a  where+    depAnnotate :: a -> State () a     -- reannotate [name to which the given term depends]+    depAnnotate x = return x           -- default+++instance DependencyAnnotatable (DProgramSpec DASTData) where+    depAnnotate (DProgramSpec rs p a) = +        do p' <- depAnnotate p+           return (DProgramSpec rs p' a)++instance DependencyAnnotatable (DConst DASTData) ++liftToGD def = DGDefSmpl def (getData def)++getDep :: forall (t :: * -> *) . (DAdditionalData (t DASTData) DASTData) => (t DASTData) -> [String]+getDep = (depOf . getData)++setDep :: forall (t :: * -> *) . (DAdditionalData (t DASTData) DASTData) => [String] -> (t DASTData) -> (t DASTData)+setDep deps x = setData ((getData x) { depOf = deps}) x++removeDep names deps = foldr delete deps names++instance DependencyAnnotatable (DProg DASTData) where+    depAnnotate (DProg f defs e a) = +        do defs' <- mapM depAnnotate defs+           e' <- depAnnotate e+           let deps = removeDep (concatMap getNames defs'++["g"]) $ normalizeDepsX $ map getDep defs' ++ [depOf (getData e')]+               f' = setDep deps f+               a' = a { depOf = deps}+           return (DProg f' defs' e' a')++instance DependencyAnnotatable (DGroundDef DASTData) where+    depAnnotate (DGDefVI d a) = do d' <- depAnnotate d+                                   return (DGDefVI d' (a {depOf = getDep d'}) )+    depAnnotate (DGDefVC d a) = do d' <- depAnnotate d+                                   return (DGDefVC d' (a {depOf = getDep d'}))+    depAnnotate (DGDefGV d a) = do d' <- depAnnotate d+                                   return (DGDefGV d' (a {depOf = getDep d'}))+    depAnnotate (DGDefGF d a) = do d' <- depAnnotate d+                                   return (DGDefGF d' (a {depOf = getDep d'}))+    depAnnotate (DGDefSmpl d a) = do d' <- depAnnotate d+                                     return (DGDefSmpl d' (a {depOf = getDep d'}))++depAnnotateLet+    :: forall (t :: * -> *) (v :: * -> *). +       (DAdditionalData (v DASTData) DASTData,+        DAdditionalData (t DASTData) DASTData,+        DependencyAnnotatable (v DASTData)+       ) +       => [(t DASTData)] -> [(DSmplDef DASTData)] -> (v DASTData) -> DASTData -> [String] -> State () ([(t DASTData)], [(DSmplDef DASTData)], (v DASTData), DASTData)+depAnnotateLet vs defs e a names = +        do defs' <- mapM depAnnotate defs+           e' <- depAnnotate e+           let deps = removeDep (concatMap getNames defs'++names) $ normalizeDepsX $ map getDep defs' ++ [depOf (getData e')]+               vs' = map (setDep deps) vs+               a' = a { depOf = deps}+           return (vs', defs', e', a')++instance DependencyAnnotatable (DDefVertComp DASTData) where+    depAnnotate (DDefVertComp f defs e a) = +        do x <- depAnnotateLet [f] defs e a ["v", "prev", "curr"]+           let ([f'], defs', e', a') = x+           return (DDefVertComp f' defs' e' a')++instance DependencyAnnotatable (DDefVertInit DASTData) where+    depAnnotate (DDefVertInit f defs e a) = +        do x <- depAnnotateLet [f] defs e a ["v"]+           let ([f'], defs', e', a') = x+           return (DDefVertInit f' defs' e' a')++instance DependencyAnnotatable (DDefGraphVar DASTData) where+    depAnnotate (DDefGraphVar v e a) = +        do e' <- depAnnotate e+           let v' = setDep (getDep e') v+           return (DDefGraphVar v' e' (a {depOf = getDep v'}))++instance DependencyAnnotatable (DDefGraphFun DASTData) where+    depAnnotate (DDefGraphFun f v defs e a) = +        do defs' <- mapM depAnnotate defs+           e' <- depAnnotate e+           let ds = removeDep (getNames v ++ concatMap getNames defs)$ normalizeDepsX $ [getDep e'] ++ map getDep defs'+               f' = setDep ds f+           return (DDefGraphFun f' v defs' e' (a {depOf = getDep f'}))++instance DependencyAnnotatable (DSmplDef DASTData) where+    depAnnotate (DDefFun f vs [] e a) = +        do x <- depAnnotateLet [f] [] e a (concatMap getNames vs)+           let ([f'], _, e', a') = x+           return (DDefFun f' vs [] e' a')+    depAnnotate (DDefVar v [] e a) = +        do x <- depAnnotateLet [v] [] e a []+           let ([v'], _, e', a') = x+           return (DDefVar v' [] e' a')+    depAnnotate (DDefTuple vs [] e a) = +        do x <- depAnnotateLet vs [] e a (concatMap getNames vs)+           let (vs', _, e', a') = x+           return (DDefTuple vs' [] e' a')++instance DependencyAnnotatable (DTermination DASTData) where+    depAnnotate (DTermF a) = return (DTermF a)+    depAnnotate (DTermI e a) = +        do e' <- depAnnotate e+           return (DTermI e' (a { depOf = getDep e'}))+    depAnnotate (DTermU e a) = +        do e' <- depAnnotate e+           return (DTermU e' (a { depOf = removeDep ["g"] (getDep e')}))++getDeps4 t1 t2 t3 t4 = normalizeDepsX $ [getDep t1, getDep t2, getDep t3, getDep t4]+getDeps3 t1 t2 t3 = normalizeDepsX $ [getDep t1, getDep t2, getDep t3]+getDeps t1 t2 = normalizeDepsX $ [getDep t1, getDep t2]+getDepsX ts = normalizeDepsX $ map getDep ts++normalizeDeps = nub  -- remove duplicated dependency entries+normalizeDepsX = foldr (\a r -> normalizeDeps (a++r)) []++instance DependencyAnnotatable (DGraphExpr DASTData) where+    depAnnotate (DPregel f0 ft x g a) = +        do f0' <- depAnnotate f0+           ft' <- depAnnotate ft+           x' <- depAnnotate x+           g' <- depAnnotate g+           let ds = normalizeDepsX $ [getDeps4 f0' ft' x' g'] ++ [getNames f0', getNames ft'] --, getNames g' ]+           return (DPregel f0' ft' x' g' (a {depOf = ds}))+    depAnnotate (DGMap f g a) = +        do f' <- depAnnotate f+           g' <- depAnnotate g+           let ds = normalizeDepsX $ [getDeps f' g'] -- ++ [getNames f', getNames g' ]+           return (DGMap f' g' (a {depOf = ds}))+    depAnnotate (DGZip g1 g2 a) = +        do g1' <- depAnnotate g1+           g2' <- depAnnotate g2+           let ds = normalizeDepsX $ [getDeps g1' g2'] -- ++ [getNames g1', getNames g2' ]+           return (DGZip g1' g2' (a {depOf = ds}))+    depAnnotate (DGIter f0 ft x g a) = +        do f0' <- depAnnotate f0+           ft' <- depAnnotate ft+           x' <- depAnnotate x+           g' <- depAnnotate g+           let ds = normalizeDepsX $ [getDeps4 f0' ft' x' g']++ [getNames f0', getNames ft'] -- , getNames g' ]+           return (DGIter f0' ft' x' g' (a {depOf = ds}))+    depAnnotate (DGVar v a) = +        do v' <- depAnnotate v +           return (DGVar v' (a {depOf = getDep v'}))++instance DependencyAnnotatable (DExpr DASTData) where+    depAnnotate (DIf p t e a) = +        do p' <- depAnnotate p+           t' <- depAnnotate t+           e' <- depAnnotate e+           let ds = getDeps3 p' t' e'+           return (DIf p' t' e' (a {depOf = ds}))+    depAnnotate (DTuple es a) =+        do es' <- mapM depAnnotate es +           let ds = getDepsX es'+           return (DTuple es' (a {depOf = ds}))+    depAnnotate (DFunAp f es a) =+        do f' <- depAnnotate f+           es' <- mapM depAnnotate es+           let ds = normalizeDepsX (getDep f' : map getDep es')+           return (DFunAp f' es' (a {depOf = ds}))+    depAnnotate (DConsAp c es a) =+        do c' <- depAnnotate c+           es' <- mapM depAnnotate es+           let ds = normalizeDepsX (getDep c' : map getDep es')+           return (DConsAp c' es' (a {depOf = ds}))+    depAnnotate (DFieldAcc t fs a) =+        do t' <- depAnnotate t+           fs' <- mapM depAnnotate fs+           let ds = normalizeDepsX (getDep t' : map getDep fs')+           return (DFieldAcc t' fs' (a {depOf = ds}))+    depAnnotate (DFieldAccE e fs a) =+        do e' <- depAnnotate e+           fs' <- mapM depAnnotate fs+           let ds = normalizeDepsX (getDep e' : map getDep fs')+           return (DFieldAccE e' fs' (a {depOf = ds}))+    depAnnotate (DAggr a' e g es a) =+        do a'' <- depAnnotate a'+           g' <- depAnnotate g+           e' <- depAnnotate e+           es' <- mapM depAnnotate es+           let ds = removeDep (case g of (DGenG _) -> ["u"]; (DGenTermG _) -> ["u"]; _ -> ["u","e"]) $ normalizeDepsX (getDep g' : getDep a'' : map (getDep) (e':es'))+           return (DAggr a'' e' g' es' (a {depOf = ds}))+    depAnnotate (DVExp v a) =+        do v' <- depAnnotate v+           return (DVExp v' (a {depOf = getDep v'}))+    depAnnotate (DCExp c a) = +        do c' <- depAnnotate c +           return (DCExp c' (a {depOf = getDep c'}))++instance DependencyAnnotatable (DAgg DASTData) where+    depAnnotate (DAggMin a) = +        do return (DAggMin (a { depOf = ["minimum"] }))+    depAnnotate (DAggMax a) = +        do return (DAggMax (a { depOf = ["maximum"] }))+    depAnnotate (DAggSum a) = +        do return (DAggSum (a { depOf = ["sum"] }))+    depAnnotate (DAggProd a) = +        do return (DAggProd (a { depOf = ["prod"] }))+    depAnnotate (DAggAnd a) = +        do return (DAggAnd (a { depOf = ["and"] }))+    depAnnotate (DAggOr a) = +        do return (DAggOr (a { depOf = ["or"] }))+    depAnnotate (DAggChoice x a) =+        do x' <- depAnnotate x+           let ds = getDep x'+           return (DAggChoice x' (a { depOf = "random":ds }))+    depAnnotate (DTupledAgg as a) = +        do as' <- mapM depAnnotate as+           let ds = getDepsX as'+           return (DTupledAgg as' (a { depOf = ds }))++instance DependencyAnnotatable (DGen DASTData) where+    depAnnotate (DGenI a) = return (DGenI (a {depOf = ["v"]}))+    depAnnotate (DGenO a) = return (DGenO (a {depOf = ["v"]}))+    depAnnotate (DGenG a) = return (DGenG (a {depOf = ["g"]}))+    depAnnotate (DGenTermG a) = return (DGenTermG (a {depOf = ["g"]}))++instance DependencyAnnotatable (DEdge DASTData) where+    depAnnotate (DEdge a) = return (DEdge (a {depOf = ["e"]}))++instance DependencyAnnotatable (DTableExpr DASTData) where+    depAnnotate (DPrev v a) = return (DPrev v (a {depOf = [getName v, "prev"]}))+    depAnnotate (DCurr v a) = return (DCurr v (a {depOf = [getName v, "curr"]}))+    depAnnotate (DVal v a) = return (DVal v (a {depOf = [getName v, "val"]}))++instance DependencyAnnotatable (DField DASTData) where+--    depAnnotate (DFfst a) = return (DFfst (a {depOf = ["_fst"]}))+--    depAnnotate (DFsnd a) = return (DFsnd (a {depOf = ["_snd"]}))+    depAnnotate (DField f a) = return (DField f (a {depOf = [f]}))++instance DependencyAnnotatable (DFun DASTData) where+    depAnnotate (DBinOp f a) = return (DBinOp f (a {depOf = [f]}))+    depAnnotate (DFun f a) = return (DFun f (a {depOf = [f]}))++instance DependencyAnnotatable (DVar DASTData) where+    depAnnotate (DVar v a) = return (DVar v (a {depOf = [v]}))++instance DependencyAnnotatable (DConstructor DASTData) where+    depAnnotate (DConstructor c a) = return (DConstructor c (a {depOf = [c]}))+
+ compiler/GenSMT.hs view
@@ -0,0 +1,496 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}+{-# OPTIONS_GHC -i.. #-}++-- module GenSMT (genCommElimSpec, genInactivateSpec, PregelStepfn) where+module GenSMT+  (genCommElimSpec, genInactivateSpec, collectVCStepfns, collectVCFixStepfns,+   PregelStepfn, SMTOptimizable, stepfnName, applicableElimComm, applicableV2H)+where++import Spec+import ASTTrans+import ASTData+import TypeChecker+import Data.Char+import Data.List+import Debug.Trace+import System.IO.Unsafe++import DependencySimple (computeDependency, depAnnotate)++type Ty a = (DTypeTerm, a)++ppp v = unsafePerformIO $ do { putStrLn (show v); return v;}++sameConstructor :: DConstructor (Ty a) -> DConstructor (Ty b) -> Bool+sameConstructor (DConstructor con1 _) (DConstructor con2 _) = con1 == con2++vE, tRP, tBool :: String+vE = "|e|"    -- name of edge+tRP = "_RP"+tBool = "Bool"++prelude :: String+prelude = unlines $ +  ["(declare-datatypes () ((_RP _pinf _ninf _nan (_rv (_val Real)))))",+   "(define-fun _isReal ((x _RP)) Bool",+   "  (not (or (= x _pinf) (or (= x _ninf) (= x _nan)))))",+   "(define-fun _eq ((x _RP) (y _RP)) Bool",+   "  (and (_isReal x) (and (_isReal y) (= (_val x) (_val y)))))",+   "(define-fun _neq ((x _RP) (y _RP)) Bool",+   "  (not (_eq x y)))",+   "(define-fun _gt ((x _RP) (y _RP)) Bool",+   "  (or (= x _pinf) (or (= _ninf y)",+   "  (and (_isReal x) (and (_isReal y) (> (_val x) (_val y)))))))",+   "(define-fun _lt ((x _RP) (y _RP)) Bool",+   "  (or (= x _ninf) (or (= y _pinf)",+   "  (and (_isReal x) (and (_isReal y) (< (_val x) (_val y)))))))",+   "(define-fun _add ((x _RP) (y _RP)) _RP",+   "  (ite (and (_isReal x) (_isReal y)) (_rv (+ (_val x) (_val y))) _nan))",+   "(define-fun _mult ((x _RP) (y _RP)) _RP",+   "  (ite (and (_isReal x) (_isReal y)) (_rv (* (_val x) (_val y))) _nan))",+   "(define-fun _div ((x _RP) (y _RP)) _RP",+   "  (ite (and (_isReal x) (_isReal y)) (_rv (/ (_val x) (_val y))) _nan))",+   "(define-fun _neg ((x _RP)) _RP",+   "  (ite (= x _pinf) _ninf (ite (= x _ninf) _pinf",+   "  (ite (= x _nan) _nan (_rv (- (_val x)))))))",+   "(define-fun _min ((x _RP) (y _RP)) _RP (ite (_lt x y) x y))",+   "(define-fun _max ((x _RP) (y _RP)) _RP (ite (_gt x y) x y))\n"]++genAuxDecls :: (Show a) =>+  DRecordSpec (Ty a) -> [DGroundDef (Ty a)] -> [String]+genAuxDecls rs gdefs = [genDataDecls rs] ++ concatMap genAuxFunc gdefs++genDataDecls :: DRecordSpec (Ty a) -> String+genDataDecls (DRecordSpec (DConstructor dname _) fields _) =+  genZ3DeclareDatatypes+    ("((" ++ dname ++ " (" ++ toHL dname ++ " " +++     unwords (map genF fields) ++ ")))")+    True+  where genF (DField fname _, ty) = "(" ++ fname ++ " " ++ genTy ty ++ ")"++toHL :: String -> String+toHL (c:s) = toLower c : s++genTy :: DType a -> String+genTy (DTInt _ ) = tRP+genTy (DTBool _ ) = tBool+genTy (DTDouble _ ) = tRP+genTy _  = undefined -- others may not be supported.++genAuxFunc :: (Show a) => DGroundDef (Ty a) -> [String]+genAuxFunc (DGDefVI (DDefVertInit (DFun fn _) _ expr _) _) =  [] +genAuxFunc (DGDefSmpl sd _) = [genSmplDef [] sd]+genAuxFunc (DGDefVC (DDefVertComp (DFun fn _) ldefs expr _) _) = []+genAuxFunc _ = []++getVC :: DProgramSpec (Ty a) -> [(String, [DSmplDef (Ty a)], DExpr (Ty a))]+getVC pr@(DProgramSpec rs (DProg _ defs _ _) _) = rs+  where genVCdefs :: DGroundDef a -> [(String, [DSmplDef a], DExpr a)]+        genVCdefs (DGDefVC (DDefVertComp (DFun fn _) ldefs expr _) _) =+          if isDPregelFixStepArg fn dps then [(fn, ldefs, expr)] else []+        genVCdefs _ = []+        dps = collectDPregel pr+        rs = concatMap genVCdefs defs++type PregelStepfn a =+  (String, [DSmplDef a], DExpr a, DTermination a, DRecordSpec a)++type SMTOptimizable = (String, Bool, Bool)+-- (name of a step function,+--  applicable eliminate-commucation optimzation,+--  applicable vote-to-halt optimzation)++stepfnName :: SMTOptimizable -> String+stepfnName (name, _, _) = name++applicableElimComm :: SMTOptimizable -> Bool+applicableElimComm (_, b, _) = b++applicableV2H :: SMTOptimizable -> Bool+applicableV2H (_, _, b) = b++-- If pr is a DProgramSpec after typechecking, a is (ASTData.DTypeInfo, a').+-- collectVCStepfns :: (Show a) => DProgramSpec a -> [PregelStepfn a]+collectVCStepfns :: (Show a) => DProgramSpec (Ty a) -> [PregelStepfn (Ty a)]+collectVCStepfns pr@(DProgramSpec rs (DProg _ defs _ _) _) =+  -- ppp "collectDPregel = " `seq` ppp dps `seq`+  concatMap genVCStep defs+  where dps = collectDPregel pr+        -- genVCStep :: DGroundDef a -> [PregelStepfn a]+        genVCStep (DGDefVC (DDefVertComp (DFun fn _) ldefs expr _) _) =+          case dPregelStepArg fn dps of+            Just term -> [(fn, ldefs, expr, term, getRecSpec rs ldefs expr)]+            Nothing   -> []+        genVCStep _ = []+        -- getRecSpec :: [DRecordSpec t] -> [DSmplDef t] -> DExpr t -> DRecordSpec t+        getRecSpec rs ldefs expr =+          if null cs then undefined+          else if null (tail cs) then findRS (head cs) rs+          else ppp "DConstructor is not uniq" `seq` findRS (head cs) rs+          where cs = uniqList (getDConstrs ldefs expr)+                -- uniqList :: Eq t => [t] -> [t]+                uniqList [] = []+                uniqList (x:xs) =+                  (if or (map (sameConstructor x) xs) then [] else [x])+                  ++ uniqList xs+                -- findRS :: DConstructor a -> [DRecordSpec a] -> DRecordSpec a+                findRS con [] = undefined+                findRS con (r@(DRecordSpec c mems _):rs)+                  | sameConstructor con c = r+                  | otherwise             = findRS con rs+        -- getDConstrs :: [DSmplDef t] -> DExpr t -> [DConstructor t]+        getDConstrs ldefs expr = cs+          where cs = concatMap col ldefs ++ collectDConstr expr+                col (DDefVar _ _ e _) = collectDConstr e+                col _ = []++collectVCFixStepfns :: (Show a) => DProgramSpec (Ty a) -> [PregelStepfn (Ty a)]+collectVCFixStepfns pr = filter isTermFix (collectVCStepfns pr)+  where isTermFix (_, _, _, DTermF _, _) = True+        isTermFix _ = False++genVC :: (Show a) =>+  String -> (String, [DSmplDef (Ty a)], DExpr (Ty a)) ->+  (String, [(DAgg (Ty a), DExpr (Ty a), DGen (Ty a), [DExpr (Ty a)])],+   [String], String, [String])+genVC dn (fn, ldefs, expr) = +    let mds = messageAggrs dn ldefs expr+        mdts = map getType mds+        vars = map (\n -> genZ3var ("m" ++ show n)) [1 .. length mds]+        vc = genZ3DefineFun+               fn+               (genParenedStr+                 (genZ3VarTy vx dn : zipWith genZ3VarTy vars mdts))+               dn+               (snd (genLetsExpr vars ldefs expr))+               True+        vx = genZ3var "vx"+        getType (DAggMin _, _, _, _) = tRP+        getType (DAggMax _, _, _, _) = tRP+        getType (DAggSum _, _, _, _) = tRP+        getType (DAggProd _, _, _, _) = tRP+        getType (DAggAnd _, _, _, _) = tBool+        getType (DAggOr _, _, _, _) = tBool+        getType (_, _, _, _) = "None"+        {-+        vars = map (\n -> "|m" ++ show n ++"|") [1 .. length mds]+        vc = "(define-fun |" ++ fn ++ "| ((|vx| " ++ dn ++ ") " +++             (unwords $ map (\vn -> "(" ++ vn ++ " _RP)") vars) ++ ") " ++ +             dn ++ "\n  " ++ snd (genLetsExpr vars ldefs expr) ++ ")\n"+        -}+    in (fn, mds, mdts, vc, vars) ++-- genSmplDef has to use the typing information to produce the+-- correct type.  This is TEKITOU.+genSmplDef :: (Show a) => [String] -> DSmplDef (Ty a) -> String+genSmplDef env (DDefFun (DFun fn _) vars defs expr _) =+  genZ3DefineFun+    fn+    (genParenedStr (map genArg vars))+    tRP+    (snd (genLetsExpr env defs expr))+    True+  where genArg (DVar vn _) = genParenedStr [genZ3var vn, tRP]+--  where genArg (DVar vn _) = genParenedStr [vn, tRP]++genSmplDef env (DDefVar (DVar vn _) defs expr _) =+  genZ3DeclareConst vn' tRP True +++  genZ3AssertEq vn' (snd (genLetsExpr env defs expr)) True+  where vn' = genZ3var vn++{-+genSmplDef env (DDefVar (DVar vn _) defs expr _) =+  genZ3DeclareConst vn tRP True +++  genZ3AssertEq vn (snd (genLetsExpr env defs expr)) True+-}++type Env = [String]++mapE :: (Show a) =>+  (Env -> m a -> (Env, String)) -> Env -> [m a] -> (Env, [String])+mapE f env [] = (env,[])+mapE f env (a:x) = let (env',a') = f env a +                       (env'', x') = mapE f env' x+                   in (env'', a':x')++genLetsExpr :: (Show a) =>+  Env -> [DSmplDef (Ty a)] -> DExpr (Ty a) -> (Env, String)+genLetsExpr env [] expr = genExpr env expr+genLetsExpr env defs expr = +  let ds = zip defs (map collectDependDSmplDef defs)+      defs' = map fst (sortBy compareDefs ds)+  in -- ppp defs `seq` ppp ds `seq` ppp defs' `seq`+     genLetsExpr' env defs' expr++genLetsExpr' :: (Show a) =>+  Env -> [DSmplDef (Ty a)] -> DExpr (Ty a) -> (Env, String)+genLetsExpr' env [] expr = genExpr env expr+genLetsExpr' env (d:ds) expr = +  let (env', dr) = genLet env d+      (env'', er) = genLetsExpr' env' ds expr+  in (env'', genSexpr "let" [genParenedStr [dr], er] False)++{-+genLetsExpr env defs expr = +  let (env', dr) = mapE genLet env defs+      (env'', er) = genExpr env' expr+      ds = zip defs (map collectDependDSmplDef defs)+      defs' = map fst (sortBy compareDefs ds)+  in ppp defs `seq` ppp ds `seq` ppp defs' `seq`+     (env'', genSexpr "let" [genParenedStr dr, er] False)+-}++compareDefs :: (DSmplDef (Ty a), [String]) -> (DSmplDef (Ty a), [String]) ->+               Ordering+compareDefs (sdef1, dep1) (sdef2, dep2) =+  let (n1:_) = getNames sdef1+      (n2:_) = getNames sdef2+  in if n2 `elem` dep1 then GT+     else if n1 `elem` dep2 then LT+     else EQ++genLet :: (Show a) => Env -> DSmplDef (Ty a) -> (Env, String)+genLet env (DDefVar (DVar vn _) defs expr _) =+  let (env', dr) = genLetsExpr env defs expr+  in  (env', genSexpr (genZ3var vn) [dr] False)+-- in  (env', genSexpr vn [dr] False)++genExpr :: (Show a) => Env -> DExpr (Ty a) -> (Env, String)+genExpr env (DIf e1 e2 e3 _) =+  let (env', es) = mapE genExpr env [e1,e2,e3]+  in (env', genSexpr "ite" es False)++genExpr env (DFunAp f@(DBinOp "!=" (tne,_)) exprs _) =+  let at1 = argTypeName1 tne+      (env', es) = mapE genExpr env exprs+  in (env', genSexpr (genEqOp "!=" at1) es False)++genExpr env (DFunAp f exprs _) +    = let (env', es) = mapE genExpr env exprs+      in (env', genSexpr (genFunOp f) es False)++genExpr env (DConsAp (DConstructor cn _) exprs _) +    = let (env', es) = mapE genExpr env exprs+      in (env', genSexpr (toHL cn) es False)+genExpr env (DFieldAcc _ fns _) +    = let es = foldr (\(DField fn _) r -> genSexpr fn [r] False) "|vx|" fns+      in (env, es) +      -- it is assumed that Curr is not used++genExpr env (DFieldAccE (DEdge _) [] _) = (env, vE)+genExpr (m : env) (DAggr agop e1 ge e2 _) = (env, m)+-- genExpr env (DVExp (DVar vn _) _) = (env, vn)+genExpr env (DVExp (DVar vn _) _) = (env, genZ3var vn)+genExpr env (DCExp c _) = (env, genConst c)+genExpr _ d = traceShow d undefined++genConst :: (Show a) => DConst (Ty a) -> String+genConst (DCInt i _) = "(_rv " ++ show i ++ ")"+genConst (DCBool True _) = "true"+genConst (DCBool False _) = "false"+genConst (DCDouble d _) = show d++genFunOp :: (Show a) => DFun (Ty a) -> String+genFunOp (DFun fn t) = genOF fn (argTypeName1 . fst $ t)+genFunOp (DBinOp opn t) = genOF opn (argTypeName1 . fst $ t)++genOF :: String -> String -> String+genOF "==" "Bool" = "="+genOF "==" _ = "_eq"+genOF "+"  _ = "_add"+genOF "*"  _ = "_mult"+genOF "/"  _ = "_div"+genOF "neg"_ = "_neg"+genOF "min"_ = "_min"+genOF "max"_ = "_max"+genOF "||" _ = "or"+genOF "&&" _ = "and"+genOF ">"  _ = "_gt"+genOF "<"  _ = "_lt"+genOF a    _ = a++genEqOp :: String -> String -> String+genEqOp "!=" "Int" = "_neq"+genEqOp "!=" "Float" = "_neq"+genEqOp "!=" "Bool" = "xor"++-- extracts aggregators concering message+messageAggrs :: (Show a) =>+  String -> [DSmplDef (Ty a)] -> DExpr (Ty a) ->+  [(DAgg (Ty a), DExpr (Ty a), DGen (Ty a), [DExpr (Ty a)])]+messageAggrs dn ldefs expr = msag expr ++ concatMap msagLet ldefs+  where msag (DIf e1 e2 e3 _)  = concatMap msag [e1, e2, e3]+        msag (DFunAp _ exprs _) = concatMap msag exprs+        msag (DConsAp (DConstructor cn _) exprs _)  = concatMap msag exprs+        msag (DAggr agop e1 ge e2 _) = [(agop, e1, ge, e2)]+        msag a = []+        msagLet (DDefVar (DVar vn _) defs expr _)+          = msag expr ++ concatMap msagLet defs ++genAggr :: DAgg (Ty a) -> String+genAggr (DAggMin _) = "_min"+genAggr (DAggMax _) = "_max"+genAggr (DAggSum _) = "_add"+genAggr (DAggProd _) = "_mult"+genAggr (DAggAnd _) = "and"+genAggr (DAggOr _) = "or"++genCommElimSpec :: (Show a) =>+  [DGroundDef (Ty a)] -> PregelStepfn (Ty a) -> String+genCommElimSpec gdefs ps@(fname, ldefs, expr, term, recspec) =+  prelude ++ unlines (genAuxDecls recspec gdefs) ++ mdfs ++ +  vc ++ vdefs ++ cnd ++ genZ3CheckSat True+  where DRecordSpec (DConstructor dn _) dflds _ = recspec+        mdfs = unlines $ zipWith3 (genAop dn) mds mdts [1..]+        (fn, mds, mdts, vc, vars) = genVC dn (fname, ldefs, expr)+        vars2 = map (\(a:vn) -> a : '2' : vn) vars+        dcfld v t = genDC v t ++ genFldcon v dflds ++ "\n"+        vdefs = dcfld v1 dn ++ dcfld v2 dn +++                genDC e tRP ++ genDC w dn ++ "\n" +++                unwords (zipWith genDC vars mdts) ++ "\n" +++                unwords (zipWith genDC vars2 mdts) ++ "\n"+        aopApp (v,n) =+          genSexpr (genZ3var ("aop" ++ show n)) [v, w, e] False+        vcApp v f vs = genSexpr (genZ3var f) (v:vs) False+        cnd = genZ3AssertEq v2 (vcApp v1 fn (map aopApp (zip vars [1..]))) True+              +++              genZ3AssertNotEq+                (vcApp v2 fn vars2)+                (vcApp v2 fn (map aopApp (zip vars2 [1..])))+                True+        v1 = genZ3var "v1"+        v2 = genZ3var "v2"+        e = genZ3var "e"+        w = genZ3var "w"++{-+genInactivateSpec pr@(DProgramSpec rs p _) = +    let (DRecordSpec (DConstructor dn _) dflds _) : _ = rs+        [(fn, mds, vc, vars)] = map (genVC dn) $ getVC pr+        vcApp v f vs = "(|" ++ f ++ "| " ++ v ++ " " ++ unwords vs ++")"+        fldcon v = concat ["(assert (_isReal (" ++ fn ++ " " ++ v ++ ")))" | +                           (DField fn _, DTInt _) <- dflds] +        dc t v = let ass = if t == tRP +                           then "(assert (_isReal " ++ v ++ ")) "+                           else ""+                 in "(declare-const "  ++ v ++ " " ++ t ++ ") " ++ ass+        units = map (\(aop,_,_,_) -> toUnit aop) mds+        allOf = foldr (\a r -> "(and " ++ a ++ " " ++ r ++")") "true"+        genFilter (_,_,_,es) = map (snd . genExpr []) es +        cnd1 = "(assert " ++ allOf (concatMap genFilter mds) ++ ")\n"+        cnd2 = "(assert (not (= |vx| " ++ vcApp "|vx|" fn units ++ ")))\n"+    in prelude ++ unlines (genAuxDecls pr) ++ vc ++ +       dc dn "|vx|" ++ fldcon "|vx|" ++ "\n" ++ +       cnd1 ++ cnd2  ++ "(check-sat)\n"+-}++genInactivateSpec :: (Show a) =>+  [DGroundDef (Ty a)] -> PregelStepfn (Ty a) -> String+genInactivateSpec gdefs (fname, ldefs, expr, term, recspec) =+  prelude ++ unlines (genAuxDecls recspec gdefs) ++ vc ++ dcfld vx dn +++  "\n" ++ vdefs ++ cnd1 ++ cnd2 ++ genZ3CheckSat True+  where DRecordSpec (DConstructor dn _) dflds _ = recspec+        (fn, mds, mdts, vc, vars) = genVC dn (fname, ldefs, expr)+        dcfld v t = genDC v t ++ genFldcon v dflds ++ "\n"+        vdefs = genDC e tRP ++ "\n"+        vcApp v f vs = genSexpr (genZ3var f) (v:vs) False+        units = map (\(aop,_,_,_) -> toUnit aop) mds+        allOf = foldr (\a r -> genSexpr "and" [a,r] False) "true"+        genFilter (_,_,_,es) = map (snd . genExpr []) es +        cnd1 = genSexpr "assert" [allOf (concatMap genFilter mds)] True+        cnd2 = genZ3AssertNotEq vx (vcApp vx fn units) True+        e = genZ3var "e"+        vx = genZ3var "vx"++toUnit :: DAgg (Ty a) -> String+toUnit (DAggMin _) = "_pinf"+toUnit (DAggMax _) = "_ninf"+toUnit (DAggSum _) = "(_rv 0)"+toUnit (DAggProd _) = "(_rv 1)"+toUnit (DAggAnd _) = "true"+toUnit (DAggOr _) = "false"++genParenedStr :: [String] -> String+genParenedStr ss = "(" ++ unwords ss ++ ")"++genSexpr :: String -> [String] -> Bool -> String+genSexpr fn args nl = genParenedStr (fn : args) ++ if nl then "\n" else ""++genAop :: (Show a) =>+  String -> (DAgg (Ty a), DExpr (Ty a), DGen (Ty a), [DExpr (Ty a)]) ->+  String -> Int -> String+genAop dn p@(aop, e1, _ , _) t n =+  genZ3DefineFun+    ("aop" ++ show n)+    (genSexpr (genZ3VarTy mx t) [genZ3VarTy vx dn, genZ3VarTy vE tRP] False)+    t     -- Is this tekitou?+    (genSexpr (genAggr aop) [snd (genExpr [] e1), mx] False)+    True+  where mx = genZ3var "mx"+        vx = genZ3var "vx"++genFldcon :: (Show a) => String -> [(DField (Ty a), DType (Ty a))] -> String+genFldcon v dflds =+   -- concat [genZ3AssertIsReal ("(" ++ fn ++ " " ++ v ++ ")") False+   concat [genZ3AssertIsReal (genSexpr fn [v] False) False+             | (DField fn _, DTInt _) <- dflds] ++genDC :: String -> String -> String+genDC v t = let ass = if t == tRP+                      then genZ3AssertIsReal v False ++ " "+                      else ""+            in genZ3DeclareConst v t False ++ " " ++ ass++genZ3DefineFun :: String -> String -> String -> String -> Bool -> String+genZ3DefineFun fname formals rty body nl =+  genSexpr "define-fun" [genZ3var fname, formals, rty, body] nl++genZ3DeclareDatatypes :: String -> Bool -> String+genZ3DeclareDatatypes dt nl = genSexpr "declare-datatypes" ["()", dt] nl+         +genZ3DeclareConst :: String -> String -> Bool -> String+genZ3DeclareConst cname ty nl = genSexpr "declare-const" [cname, ty] nl++genZ3AssertEq :: String -> String -> Bool -> String+genZ3AssertEq op1 op2 nl =+  genSexpr "assert" [genSexpr "=" [op1, op2] False] nl++genZ3AssertNotEq :: String -> String -> Bool -> String+genZ3AssertNotEq op1 op2 nl =+  genSexpr "assert" [genSexpr "not" [genSexpr "=" [op1, op2] False] False] nl++genZ3AssertIsReal :: String -> Bool -> String+genZ3AssertIsReal op nl =+  genSexpr "assert" [genSexpr "_isReal" [op] False] nl++genZ3VarTy :: String -> String -> String+genZ3VarTy v t = genParenedStr [v,t]++genZ3var :: String -> String+genZ3var v = "|" ++ v ++ "|"++genZ3CheckSat :: Bool -> String+genZ3CheckSat nl = "(check-sat)" ++ if nl then "\n" else ""++nthArgType :: Int -> DTypeTerm -> DTypeTerm+nthArgType n (DTypeTerm "->" [t1, t2]) | n == 1 = t1+                                       | otherwise = nthArgType (n - 1) t2+nthArgType _ _ = undefined++argType1, argType2 :: DTypeTerm -> DTypeTerm+argType1 = nthArgType 1+argType2 = nthArgType 2++resultType :: DTypeTerm -> DTypeTerm+resultType (DTypeTerm "->" [_, t2]) = resultType t2+resultType t = t++dTypeName :: DTypeTerm -> String+dTypeName (DTypeTerm name _) = name+dTypeName (DTypeVar id) = id++argTypeName1, argTypeName2, resultTypeName :: DTypeTerm -> String+argTypeName1 = dTypeName . argType1+argTypeName2 = dTypeName . argType2+resultTypeName = dTypeName . resultType
+ compiler/IR.hs view
@@ -0,0 +1,178 @@+module IR where
+import Debug.Trace
+import Spec
+import ASTData
+
+data IRType = IRSimpleType (DType ())
+            | IRGenericsType String [IRType] -- vector<int> $B$J$I$N$D$b$j(B
+            | IRUserType String [IRType] -- Pair, Tuple, Record$B$?$A(B
+            | IRVoidType
+            deriving (Eq, Show)
+
+-- type IRType = DType ()
+type IRNameAndType = (String, IRType)
+
+-- Emoto 2018/01/16: added the origianl state ID
+type IRNameAndTypeWithId = (IRNameAndType, Int)
+
+
+type IRVertexComputeState = (Int, Int)    -- Phase number and Step number
+
+-- $BA4BN(B
+data IRProg = IRProg String       -- $B%W%m%0%i%`L>(B
+                     [IRTypeDecl] -- $B3F%U%'!<%:$,;H$&%G!<%?7?(B
+                     IRVertexStruct -- $BD:E@$N%G!<%?7?(B
+                     IREdgeStruct -- $B;^$NCM$N%G!<%?7?(B
+                     IRMsgStruct -- $B%a%C%;!<%8$N%G!<%?7?(B
+                     IRAggStruct -- Aggregator $B$N%G!<%?7?(B
+                     Bool         -- $B5U8~$-JU$r;H$($P(B True $B$=$&$G$J$1$l$P(B False
+                     [String]     -- message names to put message tag
+                     OptimizeInfo -- optimization information
+                     [IRConstant] -- $BDj?t(B
+                     IRPhaseCompute -- Vertex.compute() / Master.compute() $B$r@8@.(B
+                     IRVertexComputeState -- $B=i4|>uBV(B
+                     [IRMethod]      -- $BB>$N%a%=%C%I(B
+            deriving (Eq, Show)
+
+------------------------------------------------------------------------
+-- $B7?Dj5A4X78(B
+------------------------------------------------------------------------
+
+-- $B%G!<%?7?Dj5A(B
+data IRTypeDecl = IRTypeDecl String  -- $B9=B$BNL>(B
+                             [IRNameAndType] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B)
+                  deriving (Eq, Show)
+
+-- $BD:E@$N%G!<%?7?(B
+data IRVertexStruct =
+  IRVertexStruct String          -- "NData_??"
+                 String          -- $B%U%'!<%:HV9f(B
+                 String          -- $B%9%F%C%WHV9f(B
+                 -- Emoto 2018/01/16: modified to add the origianl pahse ids for fields
+                 [IRNameAndTypeWithId] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B) : Prev/Curr $BIU$-$N$b$N(B
+                 [IRNameAndTypeWithId] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B) : val + Prev/Curr $B$J$7$G$h$$$b$N(B
+  deriving (Eq, Show)
+
+-- $B;^$NCM$N%G!<%?7?(B
+data IREdgeStruct =
+  IREdgeStruct String  -- "EdgeData_??"
+               [IRNameAndType] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B)
+  deriving (Eq, Show)
+
+-- $BD:E@4V%a%C%;!<%8$N%G!<%?7?(B
+-- data IRMsgStruct = IRMsgStruct [IRNameAndType] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B)
+--                    deriving (Eq, Show)
+data IRMsgStruct = IRMsgStruct String          -- MsgData_??
+                               [IRNameAndType] -- $B9=B$BN%a%s%P!<(B ($BL>A0!$7?(B)
+                   deriving (Eq, Show)
+
+-- $BHw9M(B
+-- [("m1", int), ("m2", double)]
+-- sendToNeighbor(("m1", ival));
+-- sendToNeighbor(("m2", dval));
+-- class MsgData extends Writable {
+--   int mtype;
+--   IntWritable m1;
+--   DoubleWritable m2;
+--   serialize() {
+--     if (mtype == 1) { new IntWritable(1).serim1.serialize(); m1.serialize(); }
+--   }
+
+-- Aggregate $B$9$k%G!<%?(B
+-- data IRAggStruct = IRAggStruct [(IRNameAndType, -- $B$=$l$>$l$NL>A0$H7?(B
+--                                  IRAggOp)]    -- $BMQ$$$k1i;;(B
+--                    deriving (Eq, Show)
+data IRAggStruct = IRAggStruct String           -- AggData_??
+                               [(IRNameAndType, -- $B$=$l$>$l$NL>A0$H7?(B
+                                 IRAggOp)]    -- $BMQ$$$k1i;;(B
+                   deriving (Eq, Show)
+
+-- $BDj?t(B
+data IRConstant = IRConstant IRNameAndType -- $B7?$HL>A0(B
+                             IRExpr        -- $B<0(B
+                  deriving (Eq, Show)
+getIRConstantVar (IRConstant v e) = v
+getIRConstantExp (IRConstant v e) = e
+
+------------------------------------------------------------------------
+-- $B%a%=%C%IDj5A(B
+------------------------------------------------------------------------
+data IRMethod = IRMethod IRType  -- $BJV$jCM$N7?(B
+                         String  -- $B%a%=%C%IL>(B
+                         [IRNameAndType] -- $B0z?t$NL>A0$H7?(B
+                         IRBlock -- $BK\BN(B
+                deriving (Eq, Show)
+
+data IRPhaseCompute =
+   IRPhaseCompute [IRPhaseComputeProcess]  -- $B3F(B (phase,step) $B$K$*$1$k=hM}FbMF(B
+   deriving (Eq, Show)
+
+data IRPhaseComputeProcess =
+  IRPhaseComputeProcess IRVertexComputeState -- Phase $BHV9f!$(BStep $BHV9f(B
+                        Bool                 -- termination condition == Fix?
+                        [IRNameAndType]      -- $BI,MW$J6I=jJQ?t(B
+                        IRBlock              -- $BK\BN(B ($B4^$`<u?.=hM}(B)
+                        [(IRExpr, IRVertexComputeState, IRBlock)] -- $BA+0\>r7o!$(B(Phase, Step), $BDL?.(B
+  deriving (Eq, Show)
+
+data IRBlock = IRBlock [IRNameAndType] -- $B6I=jJQ?t(B
+                       [IRStatement] -- $BK\BN(B
+               deriving (Eq, Show)
+
+data IRStatement = IRStatementLocal IRVar IRExpr -- $B%m!<%+%k$J7W;;$K$h$kCM$NJQ?t$X$NBeF~(B
+                 | IRStatementMsg   IRVar IRAggOp IRExpr -- $BNY@\D:E@$NCM$N=8Ls(B
+                 | IRStatementReturn      IRExpr -- return$BJ8(B
+                 | IRStatementVTH                -- voteToHalt
+                 | IRStatementAggr  IRNameAndType IRExpr [IRExpr] -- Aggregator $B$X$N=q$-9~$_(B
+                 | IRStatementSendN IRNameAndType IRExpr [IRExpr] -- ($BDL>o$NJU$K1h$C$?(B) $BAw?.%a%C%;!<%8$N%a%s%P!<$NL>A0(B/$B7?$HCM(B
+                 | IRStatementSendR IRNameAndType IRExpr [IRExpr] -- ($BJU$r5U9T$9$k(B) $BAw?.%a%C%;!<%8$N%a%s%P!<$NL>A0(B/$B7?$HCM(B
+                 | IRStatementIfThen IRExpr IRBlock
+                   deriving (Eq, Show)
+
+-- IRStatementMsg "v.foo" min (mval + 1)
+-- $B$3$N$/$i$$$N>pJs$+$i<!$N%3!<%I$r=P$7$?$$(B
+-- int foo = Integer.MAX_VALUE;
+-- for (IntWritable msg : messages) {
+--   foo = Math.min(foo, msg.getValue());
+-- }
+-- v.foo = new IntWritable(foo);
+
+data IRVar = IRVarLocal IRNameAndType  -- $B6I=jJQ?t(B
+--         | IRVarVertex IRNameAndType -- $BD:E@$N%a%s%P!<(B
+           | IRVarVertex IRNameAndType IRPrevCurr [IRNameAndType] -- $BD:E@$N%a%s%P!<(B
+           | IRVarEdge IRNameAndType [IRNameAndType]   -- $B;^$NCM!$%U%#!<%k%I%"%/%;%9(B
+           | IRVarAggr IRNameAndType   -- Aggregator
+             deriving (Eq, Show)
+
+data IRPrevCurr = IRPrev    -- prev
+                | IRCurr    -- curr
+                | IRNone
+                  deriving (Eq, Show)
+
+data IRExpr = IRIf IRExpr IRExpr IRExpr
+            | IRFunAp IRFun [IRExpr]
+            | IRVExp IRVar
+            | IRMVal IRNameAndType  -- $BAw?.%a%C%;!<%8MQ(B
+            | IRCExp IRType IRConst
+            | IRAggr IRNameAndType
+              deriving (Show, Eq)
+
+data IRFun = IRFun String
+           | IRBinOp String
+             deriving (Show, Eq)
+
+data IRAggOp = IRAggMin
+             | IRAggMax
+             | IRAggSum
+             | IRAggProd
+             | IRAggAnd
+             | IRAggOr
+             | IRAggChoice IRConst     -- used?
+             | IRTupledAgg [IRAggOp]   -- for internal use?
+               deriving (Show, Eq)
+
+data IRConst = IRCInt Int
+             | IRCBool Bool
+             | IRCString String
+             | IRCDouble Double
+             deriving (Eq, Show)
+ compiler/IRtoPregel.hs view
@@ -0,0 +1,2090 @@+module IRtoPregel where++import Parser+import Spec+import Normalization+import ASTData+import IR+import NtoIR+import GenSMT+import Data.Foldable+import Data.Char+import Text.Groom+import System.Environment+import System.IO+import System.IO.Unsafe++{-+                                Pregel+            Giraph+  -----------------------------------------------------------------------+  gets the current SS number    step_num()         getSuperstep()+  integer value n               n                  new IntWritable(n)+  obtain an integer value       v                  v.get()+    stored in variable v+  id of a vertex                id                 vertex.getId()+  structure data of a vertex    value()            vertex.getValue()+  vote to halt                  vote_to_halt()     vertex.voteToHalt()+  -----------------------------------------------------------------------++-}++{- datatype definitions -}++-- data TargetSystem = Giraph | PregelPlus | NoSystem deriving (Eq, Show)+-- moved to ASTData.hs++data TargetLanguage = Java | CPlusPlus deriving (Eq, Show)++-- indent level+type Depth = Int++-- a single line of a program+type ProgramLine = (Depth, String)++-- list of ProgramLine+type ProgramLines = [ProgramLine]++-- comment+type Comment = String++-- context: tuple of various datatypes and flag+--   dts  :: [IRTypeDecl]    datatype defs of vertex data for each computation+--   vert :: IRVertexStruct  datatypes for vertex (including phase, subphase etc.)+--   edgt :: IREdgeStruct    datatypes for edge+--   msgt :: IRMsgStruct     datatypes for messages+--   aggt :: IRAggStruct     datatypes for aggregator+--   rs   :: Bool            flag whether to use reversed edges+--   ts   :: [(String, Int)] list of pairs of message name and tag value+type IRcxt =+  ([IRTypeDecl], IRVertexStruct, IREdgeStruct, IRMsgStruct, IRAggStruct,+   Bool, [(String, Int)])++-- Type conversion+--   NoTypeConv:       no conversion is necessary+--   WritableTypeConv: conversion such as int -> IntWritable is necessary+data TypeConv = NoTypeConv | WritableTypeConv deriving (Eq, Show)++-- Variable declaration+--   MemberVarDecl: declration of member variables in Class / Struct+--   BlockVarDecl : normal variable declaration in a block+data VarDecl = MemberVarDecl | BlockVarDecl deriving (Eq, Show)++-- place where master class is defined+--   MCOuter: master class is defined at the outermost place.+--   MCInner: master class is defined as an inner class of VertexComputation+--   MCNone:  master class is unnecessary+data MasterClassDef = MCOuter | MCInner | MCNone deriving (Eq, Show)++-- operators that are overloaded when C++ is used+--   LTLT:  <<+--   GTGT:  >>+--   EQEQ:  ==+data OOperator = LtLt | GtGt | EqEq deriving (Eq, Show)++-- IRType definitions+irInt, irBool, irDouble :: IRType+irInt = IRSimpleType (DTInt ())+irBool = IRSimpleType (DTBool ())+irDouble = IRSimpleType (DTDouble ())++-- utility+pow2 :: Int -> Int+pow2 n = product $ take n $ repeat 2++           +-- Moved from IR.hs+-- This datatype is only used in the Pregel+ generator+data IRModifier = IRModVirtual | IRInline | IRNoModifier++{-+   naming convention for functions+     sXxxx returns a String+     gXxxx returns a ProgramLine+     ggXxxx returns a ProgramLines+-}++{- class definiton of PregelGenerator -}+class PregelGenerator g where+  {-- Target --}+  -- target system+  targetSystem :: g -> TargetSystem++  -- target language+  targetLanguage :: g -> TargetLanguage++  {-- Vertex --}+  -- vertex data structure name+  sVertStructName :: g -> String+  sVertStructName g = "VertData"++  -- typename of the vertex id+  sVertexIDType :: g -> String++  -- obtaining the vertex id+  sVertexGetId :: g -> String++  -- obtaining the vertex data structure+  sVertexGetValue :: g -> String++  -- storing the vertex data structure+  -- If it is "", it is not necessary to store the vertex data structure.+  sVertexSetValue :: g -> String+  sVertexSetValue g = ""++  -- flag whether the type of sVertexGetValue has &, i.e., VertData&+  fVertexTypeRef :: g -> Bool+  fVertexTypeRef g = False++  -- flag whether vertex has a member for edges+  fVertexHasEdges :: g -> Bool+  fVertexHasEdges g = False++  -- flag whether vertex has a member for aggregated value or not+  fVertexHasAggr :: g -> Bool+  fVertexHasAggr g = False++  {-- Edge --}+  -- flag whether edge data class is to be generated or not+  fEdgeClass :: g -> Bool+  fEdgeClass g = False++  -- edge data structure name+  sEdgeStructName :: g -> String+  sEdgeStructName g = "EdgeData"++  -- accessor for a mamber of an edge+  sEdgeMember :: g -> String -> [IRNameAndType] -> String+  sEdgeMember g name fs = name++  -- id of the target vertex of an edge+  sEdgeVertexId :: g -> String+  sEdgeVertexId g = "sEdgeVertexId"++  -- judges whether an edge is a forward edge+  sIsForwardEdge :: g -> String+  sIsForwardEdge g = "0"++  -- judges whether an edge is a reverse edge+  sIsReverseEdge :: g -> String+  sIsReverseEdge g = "0"++  {-- Message --}+  -- message data structure name+  sMsgStructName :: g -> String+  sMsgStructName g = "MsgData"++  -- flag whether message struct needs ``from'' field+  fMsgNeedFrom :: g -> Bool+  fMsgNeedFrom g = False++  -- type of the ``from'' field when fMsgNeedFrom is True+  tMsgFromType :: g -> IRType+  tMsgFromType g = irInt++  -- flag whether message struct needs ``tag'' field+  fMsgNeedTag :: g -> Bool+  fMsgNeedTag g = False++  -- type of the ``tag'' field when fMsgNeedTag is True+  tMsgTagType :: g -> IRType+  tMsgTagType g = irInt++  -- iteration string for receiving messages sent to a vertex+  sMsgRecvIter :: g -> String++  -- string for accessing each message sent to a vertex+  sMsgRecvMsg :: g -> String++  -- iteration string for sending messages to adjacent vertices+  sMsgSendIter :: g -> String++  -- variable declaration string that should be put just before sMsgSendIter+  sMsgSendVardecl :: g -> String -> String+  sMsgSendVardecl g mem = ""++  -- string for sending a message+  -- Bool indicates that the message is sent along a forward / reverse edge+  sSendMsg :: g -> Bool -> String++  -- flag whether to use message combiner+  fMsgCombiner :: g -> Bool+  fMsgCombiner g = False++  -- class name for message combiner+  sMsgCombClassName :: g -> String -> String+  sMsgCombClassName g pname = "Combiner_" ++ pname++  -- function that generates message combiner class+  ggMsgCombiner ::+    g -> Depth -> String -> IRMsgStruct -> IRPhaseCompute -> ProgramLines+  ggMsgCombiner g d pname msgt pcomp = []++  {-- Aggregator --}+  -- flag whether aggregator class is to be generated or not+  -- Note that aggregator class is NOT aggregator data structure+  fAggClass :: g -> Bool+  fAggClass g = False++  -- function that generates program lines for aggregator class definition+  ggAggClass :: g -> Depth -> String -> String -> IRcxt -> ProgramLines+  ggAggClass g d aclsnm vclsnm cxt = []++  -- aggregator data structure name+  sAggStructName :: g -> String+  sAggStructName g = "AggData"++  -- string for performing aggregate operation+  sAggregate :: g -> IRNameAndType -> String++  -- string for getting aggregated value+  sAggValue :: g -> IRNameAndType -> String++  {-- Aggregation of messages sent from neighboring vertices --}+  -- flag whether a specified operator's decl part is treated specially or not+  fStatementMsgDecl :: g -> IRAggOp -> Bool+  fStatementMsgDecl g op = False++  ggStatementMsgDecl :: g -> Depth -> IRVar -> IRAggOp -> ProgramLines+  ggStatementMsgDecl = ggStatementMsgStandardDecl++  -- flag whether a specified operator's loop part is treated specially or not+  fStatementMsgLoop :: g -> IRAggOp -> Bool+  fStatementMsgLoop g op = False++  ggStatementMsgLoop ::+    g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines+  ggStatementMsgLoop = ggStatementMsgStandardLoop ++  {-- Class --}+  -- string for defining class+  -- Its type is:+  -- g -> Modifier -> ClassName -> SuperClassName -> [ImplClassName] -> String+  sClassDecl :: g -> String -> String -> String -> [String] -> String++  -- string for defining sturct+  sStructDecl :: g -> String -> String++  -- flag whether struct defines constructors, write and readFields methos+  fStructHasMethods :: g -> Bool+  fStructHasMethods g = False++  -- function that generates method definitions+  ggStructMethods :: g -> Depth -> String -> [IRNameAndType] -> ProgramLines+  ggStructMethods g d name ms = []++  {-- Master --}+  -- how master class is to be defined+  fMasterClass :: g -> MasterClassDef+  fMasterClass g = MCNone++  -- name of the master class+  sMasterClassName :: g -> String -> String+  sMasterClassName g pname = "MasterComputation_" ++ pname++  -- string for the header of vertex computation class+  sMasterClassHeader :: g -> String -> String+  sMasterClassHeader g pname = "class " ++ sMasterClassName g pname++  -- string for declaring master.compute()+  sMasterCompHead :: g -> String+  sMasterCompHead g = ""++  -- function that generates method definitions except compute, e.g.,+  -- initialize+  ggMasterMethods :: g -> Depth -> IRcxt -> ProgramLines+  ggMasterMethods g d cxt = []++  {-- Basic Computation --}+  -- name of the basic vertex computation class+  sVertCompClassName :: g -> String -> String+  sVertCompClassName g pname = "VertexComputation_" ++ pname++  -- string for the header of vertex computation class+  sVertCompClassHeader :: g -> String -> IRcxt -> String+  sVertCompClassHeader g pname cxt = "class " ++ sVertCompClassName g pname++  -- string for declaring vertex.compute()+  sVertCompHead :: g -> String++  -- flag wheter this class contains ``toline'' method+  fToLine :: g -> Bool+  fToLine g = False++  -- function that generates ``toline'' method+  ggToLine :: g -> Depth -> IRcxt -> ProgramLines+  ggToLine g d cxt = []++  {-- Operator --}+  -- flag whether overloaded operators are to be generated or not+  fOperatorOverload :: g -> Bool+  fOperatorOverload g = False++  -- function that generates program lines for operator definition+  ggOperators :: g -> Depth -> [OOperator] -> String ->+                 [IRNameAndType] -> ProgramLines+  ggOperators g d ops strname ms = []++  {-- Types including Writable --}+  -- function that convers DType to a corresponding (primitive) typename+  sDTypeSimple :: g -> DType a -> String+  sDTypeSimple g _ = "primitive type"++  -- function that convers DType to a corresponding typename, which might+  -- be ``writable''+  sDType :: g -> DType a -> String+  sDType g = sDTypeSimple g++  -- flag whether writable datatypes are used or not+  fUseWritable :: g -> Bool+  fUseWritable g = False++  -- function that converts primitive value to writable value+  sMakeWritable :: g -> String -> IRType -> String+  sMakeWritable g s t = s++  -- function that converts writable value to primitive value+  sMakePrimitive :: g -> String -> String+  sMakePrimitive g s = sPutParen s `sClassMember` "get()"++  {-- Misc --}+  -- flag whether structured data types are embedded+  fEmbedStruct :: g -> Bool+  fEmbedStruct g = False+  -- fEmbedStruct g = True++  -- string for getting the current superstep number+  sSSNumber :: g -> String++  -- string for vote to halt+  sVoteToHalt :: g -> String++  -- conversion function of a function name+  sFunName :: g -> String -> String+  sFunName g s = s++  -- initializes random number generator+  sInitRand :: g -> String+  sInitRand g = ""++  -- generates random number within [0,1]+  sGenRand :: g -> String+  sGenRand g = "rand()"++  {-- Prologue and Epilogue code --}+  -- flag whether to generate prologue code+  fGeneratePrologue :: g -> Bool+  fGeneratePrologue g = False++  -- function for generating epilog code+  ggGeneratePrologue ::+    g -> String -> IRcxt -> String -> String -> Option -> ProgramLines+  ggGeneratePrologue g pname cxt vclsnm aclsnm opt = []++  -- flag whether to generate epilogue code, e.g, main function+  fGenerateEpilogue :: g -> Bool+  fGenerateEpilogue g = False++  -- function for generating epilogue code+  ggGenerateEpilogue ::+    g -> String -> IRcxt -> String -> String -> Option -> ProgramLines+  ggGenerateEpilogue g pname cxt vclsnm aclsnm opt = []++  -- Emoto 2018/01/16: added+  -- flag whether to generate I/O code, e.g, input/output formats+  fGenerateIO :: g -> Bool+  fGenerateIO g = False++  -- Emoto 2018/01/16: added+  -- function for generating I/O code+  ggGenerateIO ::+    g -> String -> IRcxt -> IRVertexComputeState -> ProgramLines+  ggGenerateIO g pname cxt ist = []++-- end of class PregelGenerator++{- Pregel+ -}+data PregelPlusGenerator = PregelPlusGenerator deriving (Eq, Show)++instance PregelGenerator PregelPlusGenerator where+  targetSystem PregelPlusGenerator = PregelPlus++  targetLanguage PregelPlusGenerator = CPlusPlus++  -- sVertStructName PregelPlusGenerator = "VertData"++  sVertexIDType PregelPlusGenerator = "VertexID"++  sVertexGetId PregelPlusGenerator = "id"++  sVertexGetValue PregelPlusGenerator = "value()"+  +  fVertexTypeRef PregelPlusGenerator = True++  fVertexHasEdges PregelPlusGenerator = True++  fVertexHasAggr PregelPlusGenerator = True++  fEdgeClass PregelPlusGenerator = True++  sEdgeMember PregelPlusGenerator name fs = "nbs[i]." ++ name++  sEdgeVertexId PregelPlusGenerator = "nbs[i].nb"++  --fMsgNeedFrom PregelPlusGenerator = True++  sMsgRecvIter PregelPlusGenerator =+    "for (int i = 0; i < messages.size(); i++)"++  sMsgRecvMsg PregelPlusGenerator = "messages[i]"++  sMsgSendIter PregelPlusGenerator = "for (int i = 0; i < nbs.size(); i++)"++  sMsgSendVardecl PregelPlusGenerator mem =+    "vector<" ++ sEdgeStructName PregelPlusGenerator ++ ">& nbs = " ++ e ++ ";"+    where e = sVertex `sClassMember` mem++  sSendMsg PregelPlusGenerator dir = "send_message(nbs[i].nb, " ++ sMsg ++ ")"++  fMsgCombiner PregelPlusGenerator = True++  ggMsgCombiner PregelPlusGenerator d pname msgt ph = ws+    where mstr = sMsgStructName PregelPlusGenerator+          ws = [ (0,"class " ++ clazz ++ ": public Combiner<" ++ mstr ++ ">")+               , (0,"{")+               , (0,"public:")+               , (1,"virtual void combine("++ mstr ++"& old, const "++ mstr+                     ++"& neu)")+               , (1,"{")+               ]+               +++               as+               +++               [ (1,"}")+               , (0,"};")+               ]+          clazz = sMsgCombClassName PregelPlusGenerator pname+          IRMsgStruct _ members = msgt+          IRPhaseCompute phases = ph+          stmts = concatMap getstmts phases+          getstmts (IRPhaseComputeProcess _ _ _ (IRBlock _ stmts) _) = stmts+          as = map comb members+          comb (memname, _) = putDS 2 (combcond (getAgg stmts))+            where oldmem = "old." ++ memname+                  newmem = "neu." ++ memname+                  ifcomb c s = "if (" ++ c ++ ") " ++ s+                  bin op = oldmem ++ " " ++ op ++ " " ++ newmem+                  combcond IRAggMin = ifcomb (bin ">") (bin "=")+                  combcond IRAggMax = ifcomb (bin "<") (bin "=")+                  combcond IRAggAnd = ifcomb oldmem (bin "=")+                  combcond IRAggOr = ifcomb ("!" ++ oldmem) (bin "=")+                  combcond IRAggSum = bin "+="+                  combcond IRAggProd = bin "*="+                  getAgg [] = undefined+                  getAgg (IRStatementMsg _ agg (IRMVal (v, _)) : xs) =+                    if v == memname then agg else getAgg xs +                  getAgg (x:xs) = getAgg xs++  fAggClass PregelPlusGenerator = True++  sAggregate PregelPlusGenerator (n, t) =+    sAssignExpr left n+    where left = sAggInVertexMember PregelPlusGenerator sVertex n++  sAggValue PregelPlusGenerator (n,t) =+    "(*(" ++ sAggStructName PregelPlusGenerator ++ " *)(getAgg()))"+    `sClassMember` n++  sClassDecl PregelPlusGenerator mod name super impls =+    mod ++ c ++ name ++ ": public " ++ super+    where c = if mod == "" then "class " else " class "++  sStructDecl PregelPlusGenerator name = "struct " ++ name++  sVertCompClassHeader PregelPlusGenerator pname cxt =+    "class " ++ sVertCompClassName g pname ++ ": public " ++ sup+    where sup = sIRType+                 g+                 NoTypeConv+                 (IRGenericsType "Vertex"+                    (map+                       simpleUserType+                       [sVertexIDType g, sVertStructName g, sMsgStructName g]))+          g = PregelPlusGenerator++  sVertCompHead PregelPlusGenerator =+    "public: virtual void compute(MessageContainer& messages)"++  fToLine PregelPlusGenerator = True++  ggToLine PregelPlusGenerator d (dts,vt,_,_,_,_,_) =+    (d, "public: void toline(char *buf)") : ggPutCBracket d [(d + 1, p)]+    where p = "sprintf(buf, " ++ f ++ ", id, " ++ args ++ ");"+          -- p = "sprintf(buf, " ++ ", id, " ++ args ++ ");"+          IRVertexStruct name phase subphase pcms nopcms = vt+          -- Emoto 2018/01/16: modified to deal with the original phase ids+          mems = if fEmbedStruct PregelPlusGenerator+                 then map f (concatMap (inlineStruct True dts . fst) pcms)+                 else concatMap (g.fst) pcms+                 where f (n,t) = (sCurrName n, t)+                       g m@(n,t) = map (h n) (inlineStruct False dts m)+                       h n (n2,t2) = (sCurrName n `sClassMember` n2, t2)+          args = concat (mapInsert vf ", " False (map fst mems))+                 where vf = ("value()" `sClassMember`)+          f = "\"%d  " +++              concat (mapInsert per " " False (map snd mems)) ++ "\\n\""+          per t = if t == irInt then "%d"+                  else if t == irBool then "%d"+                  else if t == irDouble then "%f"+                  else "%p"++  fOperatorOverload PregelPlusGenerator = True++  sDTypeSimple PregelPlusGenerator (DTInt _) = "int"+  sDTypeSimple PregelPlusGenerator (DTBool _) = "bool"+  sDTypeSimple PregelPlusGenerator (DTString _) = "char*"+  sDTypeSimple PregelPlusGenerator (DTDouble _) = "double"+  sDTypeSimple PregelPlusGenerator (DTTuple _ _) = "dttuple"+  sDTypeSimple PregelPlusGenerator (DTRecord con ts _) = "dtrecord"++  fEmbedStruct PregelPlusGenerator = True++  sSSNumber PregelPlusGenerator = "step_num()"++  sVoteToHalt PregelPlusGenerator = "vote_to_halt()"++  sFunName PregelPlusGenerator "mod" = sOperator ++ "%"+  sFunName PregelPlusGenerator s = s++  sInitRand PregelPlusGenerator = "srand((unsigned)time(NULL));"++  sGenRand PregelPlusGenerator = "((double)rand() / RAND_MAX)"++  ggAggClass PregelPlusGenerator d aclsnm vclsnm cxt@(_,_,_,_,aggt,_,_) =+    ggClass g d (sClassDecl g "" aclsnm (sIRType g NoTypeConv super) [])+            aclsbody+    where g = PregelPlusGenerator+          IRAggStruct _ apairs = aggt+          astr = sAggStructName g+          super = IRGenericsType "Aggregator"+                    (map simpleUserType [vclsnm, astr, astr])+          d1 = d + 1+          d2 = d + 2+          aclsbody = (d, "private:") :+                     putDS d1 (sIRNameAndType g (aggv, IRUserType astr [])) :+                     -- putDS d1 (sIRNameAndType g (sNeedAgg, irInt)) :+                     (d, "public:") :+                     concat [ minit, mspar, msfin, mfpar, mffin ]+          aggv  = sAgg+          vir   = "virtual "+          minit = (d1, vir ++ sMethodDefHead g IRVoidType "init" []) :+                  --ggPutCBracket d1 (gAssignStmt d2 sNeedAgg "0" ++ map (gAggInit d2 aggv) apairs)+                  ggPutCBracket d1 (map (gAggInit d2 aggv) apairs)+          mspar = (d1, vir ++ sMethodDefHead g IRVoidType "stepPartial"+                                [("v", IRUserType (vclsnm ++ "*") [])]) :+                  ggPutCBracket d1+                    (ggAggIfs d2 aggv lop apairs gAggStepPartial +++                     []) --[gUpdateWithOrStmt d2 sNeedAgg lop])+                     --[gAssignStmt d2 sNeedAgg lop])+                  where lop = "v->value()" `sClassMember` sNeedAgg+          msfin = (d1, vir ++ sMethodDefHead g IRVoidType "stepFinal"+                         [("p", astrp)]) :+                  ggPutCBracket d1+                      ( map (\p -> gAggStepFinal (d1 + 1) aggv p) apairs )+                    --(ggAggIfs d2 aggv sNeedAgg apairs gAggStepFinal)+          mfpar = (d1, vir ++ sMethodDefHead g astrp "finishPartial" [])+                  : ggPutCBracket d1 [gAggFinishPartial d2 aggv]+          mffin = (d1, "virtual " ++ sMethodDefHead g astrp "finishFinal" []) :+                  ggPutCBracket d1+                    [gAggFinishFinal d2 aggv]+                    --[gAssignStmt d2 sNeedAgg "0", gAggFinishFinal d2 aggv]+          astrp = IRUserType (astr ++ "*") []+          ggAggIfs ::+            Depth -> String -> String -> [(IRNameAndType, IRAggOp)] ->+            (Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine) ->+            ProgramLines+          ggAggIfs d aggv lop [] gfn = []+          ggAggIfs d aggv lop (p:ps) gfn =+            ggAggIf d aggv "1" lop p gfn ++ ggAggIfs' 2 ps+            where ggAggIfs' n [] = []+                  ggAggIfs' n (p:ps) = ggAggIf d aggv (show (pow2 (n-1))) lop p gfn +++                                       ggAggIfs' (n + 1) ps+                  --ggAggIfs' n (p:ps) = ggAggIf d aggv (show (n)) lop p gfn +++                  --                     ggAggIfs' (n + 1) ps+          ggAggIf ::+            Depth -> String -> String -> String -> (IRNameAndType, IRAggOp) ->+            (Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine) ->+            ProgramLines+          ggAggIf d aggv n lop p gfn =+            f d cond (ggPutCBracket d [gfn (d + 1) aggv p])+            where cond = sBinopExpr "&" lop n+                  f = ggIfThenStmt+            --where cond = sBinopExpr "==" lop n+            --      f = if n == "1" then ggIfThenStmt else ggElseIfThenStmt+          gAggInit ::+            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine+          gAggInit d aggv ((n, t), op) =+            gAssignStmt d (aggv `sClassMember` n) (aggOpUnit op)+          gAggStepPartial ::+            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine+          gAggStepPartial d aggv ((n, t), op) =+            gAssignStmt d left+              (sIRExpr g cxt+                       (IRFunAp (aggOp2Fun g op)+                                [IRVExp (IRVarLocal (left, t)),+                                 IRVExp (IRVarLocal (right, t))]))+            where left = aggv `sClassMember` n+                  right = sAggInVertexMember PregelPlusGenerator "v->value()" n+          gAggStepFinal ::+            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine+          gAggStepFinal d aggv ((n, t), op) =+            gAssignStmt d left+              (sIRExpr g cxt+                       (IRFunAp (aggOp2Fun g op)+                                [IRVExp (IRVarLocal (left, t)),+                                 IRVExp (IRVarLocal (right, t))]))+            where left = aggv `sClassMember` n+                  right = "(*p)" `sClassMember` n+          gAggFinishPartial :: Depth -> String -> ProgramLine+          gAggFinishPartial d aggv = gReturnStmt d ("&" ++ aggv)+          gAggFinishFinal :: Depth -> String -> ProgramLine+          gAggFinishFinal d aggv = gReturnStmt d ("&" ++ aggv)++  ggOperators PregelPlusGenerator d ops strname ms =+    concatMap opdef ops+    where opdef LtLt =+            (d, opdefhead "<<") :+            ggPutCBracket d+              (putDSs (d + 1) (map (opdefbody "<<") ms ++ ["return m"]))+          opdef GtGt =+            (d, opdefhead ">>") :+            ggPutCBracket d+              (putDSs (d + 1) (map (opdefbody ">>") ms ++ ["return m"]))+          opdef EqEq =+            (d, opdefheadeqeq) :+            ggPutCBracket d+              [gReturnStmt (d + 1)+                           (if null ms+                            then "true"+                            else concatMapInsert eqcheck "&&" False ms)]+            where eqcheck (m,_) = sBinopExpr "=="+                                             ("t1" `sClassMember` m)+                                             ("t2" `sClassMember` m)+          opdefhead op =+            stream ++ "& operator" ++ op ++ "(" ++ stream ++ "& m, " +++            cons ++ strname ++ "& v)"+            where stream = if op == "<<" then "ibinstream" else "obinstream"+                  cons = if op == "<<" then "const " else ""+          opdefheadeqeq =+            "inline bool operator==(const " ++ strname ++ "& t1, const " +++            strname ++ "& t2)"+          opdefbody op (name,_) = "m " ++ op ++ " v." ++ name++  fGeneratePrologue PregelPlusGenerator = True+ +  ggGeneratePrologue PregelPlusGenerator pname cxt vclsnm aclsnm opt =+    [ (0, "#include \"basic/pregel-dev.h\"")+    , (0, "using namespace std;")+    , (0, "inline int stateToCaseval(int p, int s) {")+    , (1, "return p * 10 + s;")+    , (0, "}")+    ]++  fGenerateEpilogue PregelPlusGenerator = True++  ggGenerateEpilogue+    PregelPlusGenerator pname cxt@(_,_,_,_,_,rv,_) vclsnm aclsnm opt =+    ws ++ fs ++ rs ++ us ++ ps ++ ms+    where ag = if aclsnm == "" then "DummyAgg" else aclsnm+          vt = sIRType PregelPlusGenerator NoTypeConv (getValType cxt)+          et = sIRType PregelPlusGenerator NoTypeConv (getEType cxt)+          ws = [ (0, "class Worker_" ++ pname ++ ": public Worker<" +++                     vclsnm ++ "," ++ ag ++ ">")+               , (0, "{")+               , (1, "char buf[1000];")+               , (0, "public:")+               , (1, "// input line:")+               , (1, "// vid \\t val degree nb1 len1 nb2 len2 ...")+               , (1, "virtual " ++ vclsnm ++ " *toVertex(char *line) {")+               , (2, "char *pch;")+               , (2, "pch = strtok(line, \"\\t\");")+               , (2, vclsnm ++ " *v = new " ++ vclsnm ++ ";")+               , (2, "int id = atoi(pch); // vertex id")+               --, (2, "printf(\"id = %d\\n\", id);")+               , (2, "v->id = id;")+               , (2, "pch = strtok(NULL, \" \");")+               , (2, if vt == "int" then "int val = atoi(pch);"+                     else if vt == "double"+                          then "double val = (double)atof(pch);"+                     else "int val = atoi(pch);")+               , (2, "v->value().val = val;")+               --, (2, "printf(\"val = %d\\n\", val);")+               ]+          readEdges fd = +               [ (2, "{")+               , (3, "pch = strtok(NULL, \" \");")+               , (3, "int deg = atoi(pch);")+               , (3, "for (int i = 0; i < deg; i++) {")+               , (4, "pch = strtok(NULL, \" \");")+               , (4, "int nb = atoi(pch); // neighbor")+               , (4, "pch = strtok(NULL, \" \");")+               , (4, if et == "int" then "int e = atoi(pch);"+                     else if et == "double"+                          then "double e = (double)atof(pch);"+                     else "int val = atoi(pch);")+               --, (4, "printf(\"nb = %d, e = %d\\n\", nb, e);")+               , (4, sEdgeStructName PregelPlusGenerator +++                     " edge = { nb, e };")+               , (4, "v->value()." ++ (if fd then "edges" else "redges") +++                     ".push_back(edge);")+               , (3, "}")+               , (2, "}")+               ]+          fs = readEdges True+          rs = if rv then readEdges False else []+          us = [ (2, "return v;")+               , (1, "}")+               , (1, "// output line")+               , (1, "// vid \\t val")+               , (1, "virtual void toline(" ++ vclsnm +++                     " *v, BufferedWriter& writer) {")+               , (2, "v->toline(buf);")+               , (2, "writer.write(buf);")+               , (1, "}")+               , (0, "};")+               ]+          ps = [ (0, "void pregel_" ++ pname ++ "(string inp, string outp) {")+               , (1, "WorkerParams param;")+               , (1, "param.input_path = inp;")+               , (1, "param.output_path = outp;")+               , (1, "param.force_write = true;")+               , (1, "param.native_dispatcher = false;")+               , (1, "Worker_" ++ pname ++ " worker;")+               ]+               +++               ( if aclsnm /= "" then+               [ (1, aclsnm ++ " agg;")+               , (1, "worker.setAggregator(&agg);")+               ] else [])+               +++               (if fMsgCombiner PregelPlusGenerator && useMsgCombOpt opt then+               [ (1, sMsgCombClassName PregelPlusGenerator pname ++ " comb;")+               , (1, "worker.setCombiner(&comb);")+               ] else [])+               +++               [ (1, "worker.run(param);")+               , (0, "}")+               ]+          ms = [ (0, "int main(int argc, char *argv[]) {")+               , (1, "init_workers();")+               , (1, "pregel_" ++ pname ++ "(\"/" ++ pname ++ "/input\"" +++                     ", \"/" ++ pname ++ "/output\");")+               , (1, "worker_finalize();")+               , (1, "return 0;")+               , (0, "}")+               ]++-- end of instance PregelGenerator PregelPlusGenerator++{- Giraph -}+data GiraphGenerator = GiraphGenerator deriving (Eq, Show)++instance PregelGenerator GiraphGenerator where+  targetSystem GiraphGenerator = Giraph++  targetLanguage GiraphGenerator = Java++  -- sVertexIDType GiraphGenerator = "LongWritable"+  sVertexIDType GiraphGenerator = "IntWritable"++  sVertexGetId GiraphGenerator = "vertex.getId()"++  sVertexGetValue GiraphGenerator = "vertex.getValue()"++  sVertexSetValue GiraphGenerator = "vertex.setValue(" ++ sVertex ++ ")"++  sEdgeMember GiraphGenerator name fs = "edge.getValue()"++  sEdgeVertexId GiraphGenerator = "edge.getTargetVertexId()"++  sIsForwardEdge GiraphGenerator =+    sPutParen (sMakePrimitive GiraphGenerator (sEdgeVertexId GiraphGenerator)+               ++ " > 0")++  sIsReverseEdge GiraphGenerator =+    sPutParen (sMakePrimitive GiraphGenerator (sEdgeVertexId GiraphGenerator)+               ++ " < 0")++  -- fMsgNeedTag GiraphGenerator = True++  -- tMsgTagType GiraphGenerator = IRUserType "Text" []++  sMsgRecvIter GiraphGenerator =+    "for (" ++ sMsgStructName GiraphGenerator ++ " msg : messages)"++  sMsgRecvMsg GiraphGenerator = "msg"++  sMsgSendIter GiraphGenerator =  -- TODO: IntWritable -> EdgeData+    "for (Edge<" ++ sVertexIDType GiraphGenerator ++ ", IntWritable> edge : vertex.getEdges())"++  sSendMsg GiraphGenerator True =+    "sendMessage(" ++ sEdgeVertexId GiraphGenerator ++ ", " ++ sMsg ++ ")"+  sSendMsg GiraphGenerator False =+    "sendMessage(new " ++ sVertexIDType GiraphGenerator ++ "(-(" ++ sEdgeVertexId GiraphGenerator +++    ".get())), " ++ sMsg ++ ")"++  fAggClass GiraphGenerator = False++  sAggregate GiraphGenerator (n, t) =+    "aggregate(\"" ++ n ++ "\", " ++ sMakeWritable GiraphGenerator n t ++ ")"++  sAggValue GiraphGenerator (n,t) =+    "(" ++ sIRType GiraphGenerator WritableTypeConv t +++    ")(getAggregatedValue(\"" ++ n ++ "\"))"++  sClassDecl GiraphGenerator mod name super impls =+    mod ++ c ++ name ++ sup ++ imp+    where c = if mod == "" then "class " else " class "+          sup = if super == "" then "" else (" extends " ++ super)+          imp = if impls == [] then "" else (" implements " ++ foldl1 f impls)+                where f c1 c2 = c1 ++ ", " ++ c2++  sStructDecl GiraphGenerator name =+    "public static class " ++ name ++ " implements Writable"++  fStructHasMethods GiraphGenerator = True++  ggStructMethods GiraphGenerator d name ms =+    ggConstr ++ ggWrite ++ ggRead+    where ggConstr = ggMethod mhead mbody+                     where mhead = "public " ++ name ++ "()"+                           mbody = map initMem ms+                           initMem :: IRNameAndType -> String+                           initMem (n,t) =+                             sAssignExpr ("this" `sClassMember` n) (initVal t)+                           initVal :: IRType -> String+                           initVal t@(IRSimpleType dt) =+                             sMakeWritable GiraphGenerator "" t+                           initVal (IRUserType s _) = "new " ++ s ++ "()"+                           initVal _ = error "error in initVal"+          ggWrite = ggMethod mhead mbody+                    where mhead = "public void write(DataOutput out) " ++ th+                                  +                          mbody = map wrMem ms+                          wrMem :: IRNameAndType -> String+                          wrMem (n,_) = n `sClassMember` "write(out)"+          ggRead = ggMethod mhead mbody+                   where mhead = "public void readFields(DataInput in) " ++ th+                         mbody = map rdMem ms+                         rdMem :: IRNameAndType -> String+                         rdMem (n,_) = n `sClassMember` "readFields(in)"+          ggMethod h b = (d, h) : ggPutCBracket d (putDSs (d + 1) b)+          th = "throws IOException"++  fMasterClass GiraphGenerator = MCOuter++  sMasterClassHeader GiraphGenerator pname =+    sClassDecl GiraphGenerator "public static"+               (sMasterClassName GiraphGenerator pname)+               "DefaultMasterCompute" []++  sMasterCompHead GiraphGenerator = "public void compute()"++  ggMasterMethods GiraphGenerator d (_, _, _, _, IRAggStruct _ ps, _, _) =+    concat [ [(d, "public void initialize() throws " +++                  "InstantiationException, IllegalAccessException")]+           , ggPutCBracket d (putDSs (d + 1) (map f ps))+           ]+    where f ((n, t), op) = "registerAggregator(\"" ++ n ++ "\", " +++                           aggopcls op t ++ ")"+          aggopcls IRAggAnd _ = "BooleanAndAggregator.class"+          aggopcls IRAggOr _ = "BooleanOrAggregator.class"+          aggopcls IRAggMax t = aggtcls t ++ "MaxAggregator.class"+          aggopcls IRAggMin t = aggtcls t ++ "MinAggregator.class"+          aggopcls IRAggProd t = aggtcls t ++ "ProductAggregator.class"+          aggopcls IRAggSum t = aggtcls t ++ "SumAggregator.class"+          aggopcls _ _ = "AAAAA.class"+          aggtcls (IRSimpleType (DTInt ())) = "Int"+          aggtcls (IRSimpleType (DTDouble ())) = "Double"+          aggtcls _ = "XXXX"+++  sVertCompClassHeader GiraphGenerator pname (_,_,edgt,_,_,_,_) =+    sClassDecl GiraphGenerator "public static"+               (sVertCompClassName GiraphGenerator pname) super []+    where super =+           sIRType+             g+             NoTypeConv+             (IRGenericsType "BasicComputation"+               (map simpleUserType+                    [sVertexIDType g, sVertStructName g,+                     sDType g t, sMsgStructName g]))++          IREdgeStruct _ [("e", IRSimpleType t)] = edgt+          g = GiraphGenerator++  sVertCompHead GiraphGenerator =+    "public void compute(Vertex<" ++ sVertexIDType GiraphGenerator ++ ", " +++    sVertStructName GiraphGenerator +++    ", IntWritable> vertex, Iterable<" ++ -- TODO: IntWritable -> EdgeData+    sMsgStructName GiraphGenerator ++ "> messages)"++  fOperatorOverload GiraphGenerator = False++  sDTypeSimple GiraphGenerator (DTInt _) = "int"+  sDTypeSimple GiraphGenerator (DTBool _) = "boolean"+  sDTypeSimple GiraphGenerator (DTString _) = "String"+  sDTypeSimple GiraphGenerator (DTDouble _) = "double"+  sDTypeSimple GiraphGenerator (DTTuple _ _) = "DTTuple"+  sDTypeSimple GiraphGenerator (DTRecord con ts _) = "DTRecord"++  sDType GiraphGenerator (DTInt _) = "IntWritable"+  sDType GiraphGenerator (DTBool _) = "BooleanWritable"+  sDType GiraphGenerator (DTString _) = "Text"+  sDType GiraphGenerator (DTDouble _) = "DoubleWritable"+  sDType GiraphGenerator (DTTuple _ _) = error "tuple is not supported yet"+  sDType GiraphGenerator (DTRecord con ts _) = error "user record is not supported yet"++  fUseWritable GiraphGenerator = True++  sMakeWritable GiraphGenerator s (IRSimpleType t) =+    "new " ++ sDType GiraphGenerator t ++ "(" ++ s ++ ")"+  sMakeWritable GiraphGenerator s (IRGenericsType t ts) = "new_g " ++ t+  sMakeWritable GiraphGenerator s (IRUserType t ts) = "new_u " ++ t+  sMakeWritable GiraphGenerator s IRVoidType = "new_void"++  fEmbedStruct GiraphGenerator = True++  sSSNumber GiraphGenerator = "getSuperstep() + 1"++  sVoteToHalt GiraphGenerator = "vertex.voteToHalt()"++  sFunName GiraphGenerator "min" = "Math.min"+  sFunName GiraphGenerator "max" = "Math.max"+  sFunName GiraphGenerator "not" = "!"+  sFunName GiraphGenerator "neg" = "-"+  sFunName GiraphGenerator "mod" = sOperator ++ "%"+  sFunName GiraphGenerator s = s  ++  sGenRand GiraphGenerator = "Math.random()"++  fGeneratePrologue GiraphGenerator = True+ +  ggGeneratePrologue GiraphGenerator pname cxt vclsnm aclsnm opt =+    putDSs 0 is ++ [(0, cls)] ++ opeM+    where is = ["import com.google.common.collect.Lists"] +++               map ("import java." ++)+                   [ "io.DataInput"+                   , "io.DataOutput"+                   , "io.IOException"+                   , "util.List"+                   ] +++               map ("import org.apache.giraph." ++)+                   [ "aggregators.*"+                   , "edge.Edge"+                   , "edge.EdgeFactory"+                   , "graph.BasicComputation"+                   , "graph.Vertex"+                   , "io.formats.*"+                   , "master.DefaultMasterCompute"+                   ] +++               map ("import org.apache.hadoop.io." ++)+                   [ "BooleanWritable"+                   , "DoubleWritable"+                   , "FloatWritable"+                   , "IntWritable"+                   , "LongWritable"+                   , "NullWritable"+                   , "Text"+                   , "Writable"+                   ] +++               map ("import org.apache.hadoop.mapreduce." ++)+                   [ "InputSplit"+                   , "TaskAttemptContext"+                   ] +++               map ("import org.json.JSON" ++)+                   [ "Array"+                   , "Exception"+                   ]+          cls = "class " ++ [toUpper (head pname)] ++ tail pname ++ " {"+          opeM = []+          {-+          -- Emoto 2018/01/11: added for operators mod and choice.+          opeM = [ (1, "static class OperatorMapper {")+                 , (2, "static int mod(int x, int y) { return x % y; }")+                 , (2, "static long mod(long x, long y) { return x % y; }")+                 , (1, "}")+                 , (1, "static class Chooser {")+                 , (2, "int n;")+                 , (2, "Chooser() { n = 0; }")+                 , (2, "int choice(int x, int y) {")+                 , (3, "n++; return Math.random() <= 1.0 / n? y: x;")+                 , (2, "}")+                 , (1, "}")+                 ]+           -}+                +  fGenerateEpilogue GiraphGenerator = True++  ggGenerateEpilogue GiraphGenerator pname cxt vclsnm aclsnm opt = [(0, "}")]++  -- Emoto 2018/01/16: added+  fGenerateIO g = True++  -- Emoto 2018/01/16: added+  ggGenerateIO g pname cxt ist = ifs ++ ofs+    where vsn = sVertStructName g+          -- TODO: use of "sEdgeStructName g" is the correct way, but currently type of e (=Int) is used directly (in many places).... X(+          esn = sIRType g WritableTypeConv (getEType cxt) -- sEdgeStructName g +          typeParams = sVertexIDType g ++ ", " ++ vsn ++ ", " ++ esn+          ofs :: ProgramLines             +          ofs = [(1,"public static class OutputFormat extends TextVertexOutputFormat<" ++ typeParams ++ "> {"),+                 (2,"@Override public TextVertexWriter createVertexWriter(TaskAttemptContext context) {"),+                 (3, "return new VertexWriter();"),+                 (2, "}"),+                 (2, "private class VertexWriter extends TextVertexWriterToEachLine {"),+                 (3, "@Override public Text convertVertexToLine(Vertex<" ++ typeParams ++ "> vertex) throws IOException {"),+                 (4, "return new Text(\"\" + vertex.getId().get()")]+                ++ ( map (\x -> (5,x)) $ map getFldStr $ flds )+                ++ [(5,");"),+                    (3, "}"),+                    (2, "}"),+                    (1, "}")]+          getFldStr ((nm, ty), pid) = "+ \" \" + vertex.getValue()." ++ nm ++ ".get()"+          -- TODO: want to output only the original final result (before the normalization)+          flds = filter ((>=0).snd) (genVertexUserDataFields g cxt)+          vt = sIRType g WritableTypeConv (getValType cxt)+          edgeTypeParams = sVertexIDType g ++ ", " ++ esn+          ifs:: ProgramLines+          ifs = [(1, "public static class InputFormat extends TextVertexInputFormat<" ++ typeParams ++ "> {"),+                 (2,"@Override public TextVertexReader createVertexReader(InputSplit split, TaskAttemptContext context) {"),+                 (3, "return new VertexReader();"),+                 (2,"}"),+                 (2, "class VertexReader extends TextVertexReaderFromEachLineProcessedHandlingExceptions<JSONArray, JSONException> {"),+                 (3, "@Override protected JSONArray preprocessLine(Text line) throws JSONException {"),+                 (4, "return new JSONArray(line.toString());"),+                 (3, "}"),+                 (3, "@Override protected " ++ sVertexIDType g ++ " getId(JSONArray jsonVertex) throws JSONException, IOException {"),+                 (4, "return new " ++ sVertexIDType g ++ "(jsonVertex." ++ jsonGet (sVertexIDType g) ++ "(0));"),+                 (3, "}"),+                 (3, "@Override protected " ++ vsn ++ " getValue(JSONArray jsonVertex) throws JSONException, IOException {"),+                 (4, vsn ++ " ret = new " ++ vsn ++ "();"),+                 (4, "ret.val = new " ++ vt ++ "(jsonVertex." ++ jsonGet vt ++ "(1));\n"),+                 (4, "return ret;"),+                 (3, "}"),+                 (3, "@Override protected Iterable<Edge<" ++ edgeTypeParams ++ ">> getEdges(JSONArray jsonVertex) throws JSONException, IOException {"),+                 (4, "JSONArray jsonEdgeArray = jsonVertex.getJSONArray(2);"),+                 (4, "List<Edge<" ++ edgeTypeParams ++ ">> edges = Lists.newArrayListWithCapacity(jsonEdgeArray.length());"),+                 (4, "for (int i = 0; i < jsonEdgeArray.length(); ++i) {"), +                 (5, "JSONArray jsonEdge = jsonEdgeArray.getJSONArray(i);"),+                 (5, "edges.add(EdgeFactory.create(new " ++ sVertexIDType g++ " (jsonEdge." ++ jsonGet (sVertexIDType g)  ++ "(0)), new " ++ esn ++ "(jsonEdge." ++ jsonGet esn ++ "(1))));"),+                 (4, "}"),+                 (4, "return edges;"),+                 (3, "}"),+                 (3, "@Override protected Vertex<" ++ typeParams ++ ">" ++ "handleException(Text line, JSONArray jsonVertex, JSONException e) {"),+                 (4, "throw new IllegalArgumentException(\"Couldn't get vertex from line \" + line, e);"),+                 (3, "}"),+                 (2, "}"),+                 (1, "}")]+          -- FIXME: 20161129 Matsuzaki, 20180116 Emoto+          -- val might be a user-defined record...+          -- I don't know how to define a record reader?+          jsonGet nm = case nm of +                         "IntWritable" -> "getInt"+                         "LongWritable" -> "getLong"+                         "BooleanWritable" -> "getBoolean"+                         "DoubleWritable" -> "getDouble"+                         "Text" -> "get"                   -- not checked yet+                         _ -> error "the type " ++ nm ++ " is not supported yet in reading json"+  -- Emoto 2018/01/16: simplified (becuase of the use of inner classes)+  sMasterClassName g pname = "MasterComputation"+  sVertCompClassName g pname = "VertexComputation" ++-- end of instance PregelGenerator GiraphGenerator++{- String constants for variable / member names -}++-- local variable name of a vertex value in vertex.compute+sVertex :: String+sVertex = "_v"++-- member names in message structure, if necessary+sFromInMsg, sTagInMsg :: String+sFromInMsg = "from"+sTagInMsg = "tag"++-- member name of an aggregated value in vertex structure, if necessary+sAggInVertex :: String+sAggInVertex = "aggv"++sAggInVertexMember :: (PregelGenerator g) => g -> String -> String -> String+sAggInVertexMember g pre n =+  if fEmbedStruct g then pre `sClassMember` (sAggInVertex ++ "_" ++ n)+  else (pre `sClassMember` sAggInVertex) `sClassMember` n++-- member name of edges (vector of edges) in vertex structure, if necesary+sEdgesInVertex :: String+sEdgesInVertex = "edges"++sREdgesInVertex :: String+sREdgesInVertex = "redges"++sNeedAgg :: String+sNeedAgg = "needAgg"++sMsg :: String+sMsg = "msg"++sAgg :: String+sAgg = "aggvar"++sOperator :: String+sOperator = "operator"++sDoAgain :: String+sDoAgain = "doagain"++{- Utility functions -}++-- mapInsert f s [a0,a1,a2] True   ==> [f a0, s, f a1, s, f a2, s]+-- mapInsert f s [a0,a1,a2] Falsee ==> [f a0, s, f a1, s, f a2]+mapInsert :: (a -> String) -> String -> Bool -> [a] -> [String]+mapInsert f delim lastins xs =+  let fn x = f x ++ delim in+    if null xs then []+    else if lastins then map fn xs+    else map fn ys ++ [f y]+         where ys = init xs+               y = last xs++concatMapInsert :: (a -> String) -> String -> Bool -> [a] -> String+concatMapInsert f delim lastins xs = concat (mapInsert f delim lastins xs)++sMayMakePrimitive :: (PregelGenerator g) => g -> String -> String+sMayMakePrimitive g s = if fUseWritable g then sMakePrimitive g s else s++-- put depth d to a string+putDepth :: Depth -> String -> ProgramLine+putDepth d s = (d,s)++putDepths :: Depth -> [String] -> ProgramLines+putDepths d = map (putDepth d)++-- append a semicolon at the end of a string+sPutSemi :: String -> String+sPutSemi = (++ ";")++-- append a semicolon and put a depth+putDS :: Depth -> String -> ProgramLine+putDS d = putDepth d . sPutSemi++putDSs :: Depth -> [String] -> ProgramLines+putDSs d = map (putDS d)++-- shift the depth by delta+shiftDS :: Depth -> ProgramLine -> ProgramLine+shiftDS delta (d,s) = (d + delta, s)++shiftDSs :: Depth -> [ProgramLine] -> [ProgramLine]+shiftDSs delta = map (shiftDS delta)++ggPutCBracket :: Depth -> ProgramLines -> ProgramLines+ggPutCBracket d bs = (d, "{") : (bs ++ [(d, "}")])++ggPutCBracketSemi :: Depth -> ProgramLines -> ProgramLines+ggPutCBracketSemi d bs = (d, "{") : (bs ++ [(d, "};")])++sPutCBracket :: String -> String+sPutCBracket s = "{" ++ s ++ "}"++sPutParen :: String -> String+sPutParen s = "(" ++ s ++ ")"++sConcatName :: String -> IRNameAndType -> IRNameAndType+sConcatName s (n,t) = (s ++ "_" ++ n, t)++simpleUserType :: String -> IRType+simpleUserType n = IRUserType n []++{- Utility functions for constructs of C++ / Java -}++-- do <body> while <cond>+ggDoWhileStmt :: Depth -> ProgramLines -> String -> ProgramLines+ggDoWhileStmt d body cond =+  (d, "do {") : (body ++ [(d, "} while " ++ sPutParen(cond) ++ ";")])++-- if <cond> then <body>+ggIfThenStmt :: Depth -> String -> ProgramLines -> ProgramLines+ggIfThenStmt d cond body = (d, "if " ++ sPutParen(cond)) : body++-- else if <cond> then <body>+ggElseIfThenStmt :: Depth -> String -> ProgramLines -> ProgramLines+ggElseIfThenStmt d cond body = (d, "else if " ++ sPutParen(cond)) : body++-- if <cond> then <body1> else <body2>+ggIfThenElseStmt ::+  Depth -> String -> ProgramLines -> ProgramLines -> ProgramLines+ggIfThenElseStmt d cond body1 body2 =+  ggIfThenStmt d cond body1 ++ [(d, "else")] ++ body2++-- <cond>? <expr1>: <expr2>+sConditionalExpr :: String -> String -> String -> String+sConditionalExpr cond e1 e2 =+  sPutParen (sPutParen cond ++ "? " ++ sPutParen e1 ++ ": " ++ sPutParen e2)++-- switch <cond>+ggSwitch :: Depth -> String -> ProgramLines -> ProgramLines+ggSwitch d cond bs = (d, "switch " ++ sPutParen(cond)) : bs++-- case <n>:+gCase :: Depth -> Int -> ProgramLine+gCase d n = (d, "case " ++ show n ++ ":")++-- case <sVertCompState state>:+gCaseState :: Depth -> IRVertexComputeState -> ProgramLine+gCaseState d state = (d, "case " ++ sVertCompState state ++ ":")++sStateToCaseval :: (PregelGenerator g) => g -> String -> String -> String+sStateToCaseval g p s =+  "(" ++ sMayMakePrimitive g p ++ ") * 10 + (" ++ sMayMakePrimitive g s ++ ")"+-- sStateToCaseval p s = "stateToCaseval(" ++ p ++ ", " ++ s ++ ")"++-- break+sBreak :: String+sBreak = "break"++-- cast+sCast :: (PregelGenerator g) => g -> IRType -> String -> String+sCast g t e = "(" ++ sIRType g NoTypeConv t ++ ")(" ++ e ++ ")"++-- new+sNew :: String -> [String] -> String+sNew clazz args =+  "new " ++ clazz ++ "(" ++ concatMapInsert id "," False args ++ ")"++-- binary operator expression: <left> binop <right>+sBinopExpr :: String -> String -> String -> String+sBinopExpr op left right = left ++ " " ++ op ++ " " ++ right++-- assignment: <left> = <right>+sAssignExpr :: String -> String -> String+sAssignExpr left right = left ++ " = " ++ right++gAssignStmt :: Depth -> String -> String -> ProgramLine+gAssignStmt d left right = putDS d (sAssignExpr left right)++-- updateWithOr: <left> |= <right>+sUpdateWithOrExpr :: String -> String -> String+sUpdateWithOrExpr left right = left ++ " |= " ++ right++gUpdateWithOrStmt :: Depth -> String -> String -> ProgramLine+gUpdateWithOrStmt d left right = putDS d (sUpdateWithOrExpr left right)++-- return <str>+gReturnStmt :: Depth -> String -> ProgramLine+gReturnStmt d str = putDS d ("return " ++ str)++-- member selection of struct / class+sClassMember :: String -> String -> String+sClassMember s m = s ++ "." ++ m++-- judges whether the program uses an aggregator or not+useAgg :: IRAggStruct -> Bool+useAgg (IRAggStruct _ ms) = ms /= []++-- judges whether to generate an aggregator class or not+needAggClass :: (PregelGenerator g) => g -> IRAggStruct -> Bool+needAggClass g at = fAggClass g && useAgg at++{- Utility functions for debugging -}++-- debug print+dPrint :: Show a => a -> a+dPrint x = unsafePerformIO $ do { putStrLn (show x); return x }++(##) :: Show a => a -> b -> b+x ## y = dPrint x `seq` y++infixr 0 ##++{- +   ggIRProg   generates a program for the given program+   The argument given to this funciton is the data of type IRProg,+   which consists of the following information.+     pname :: String              name of the program+     dts :: [IRTypeDecl]          datatypes+     vert :: IRVertexStruct       datatype of vertices+     edgt :: IREdgeStruct         datatype of edges+     msgt :: IRMsgStruct          datatype of messsages+     aggt :: IRAggStruct          datatype of aggregator+     rs :: Bool                   whether to use reversed edges+     ts :: [String]               message names to put message tag+     (_,vth,msgcomb) :; Bool      optimization information+     cs :: [IRConstant]           constants+     pcomp :: IRPhaseCompute      phase computation+     ist :: IRVertexComputeState  init state+     ms :: [IRMethod]             other methods+-}++ggIRProg :: (PregelGenerator g) => g -> Depth -> Option -> IRProg -> ProgramLines+ggIRProg g d ops (IRProg pname dts vert edgt msgt aggt rs ts oinfo cs pcomp ist ms) =+  let (_, vth, msgcomb) = oinfo+      dtdef  = if fEmbedStruct g+               then [] else concatMap (ggIRTypeDecl g d) dts+      cxt   = (dts, vert, edgt, msgt, aggt, rs, zip ts [101..])+      vtdef  = ggIRVertexStruct g d cxt+      etdef  = if fEdgeClass g == True then ggIREdgeStruct g d cxt else []+      mtdef  = ggIRMsgStruct g d cxt+      atdef  = if useAgg aggt then ggIRAggStruct g d cxt else []+      cdef   = map (gIRConstant g d cxt) cs+      mclass = if fMasterClass g == MCNone then []+               else ggClass g d (sMasterClassHeader g pname) mcomp+               where mcomp = ggMasterMethods g (d + 1) cxt +++                             ggIRMasterCompute g (d + 1) cxt pcomp+      vclass = ggClass g d (sVertCompClassHeader g pname cxt) vv+               where vcomp = ggIRVertexCompute g (d + 1) cxt vth pcomp ist+                     toln = if fToLine g then ggToLine g (d + 1) cxt else []+                     vv = if fMasterClass g == MCInner +                          then (shiftDSs 1 mclass ++ vcomp ++ toln)+                          else (vcomp ++ toln)+      vclsnm = sVertCompClassName g pname+      aclass = if needAggClass g aggt+               then ggAggClass g d aclsnm vclsnm cxt else []+      aclsnm = if needAggClass g aggt then "Aggr_" ++ pname else ""+      -- Kato and Iwasaki: message combiner+      mcclass = if fMsgCombiner g && useMsgCombOpt ops+                then ggMsgCombiner g d pname msgt pcomp+                else []+      pro    = if fGeneratePrologue g+               then ggGeneratePrologue g pname cxt vclsnm aclsnm ops else []+      epi    = if fGenerateEpilogue g+               then ggGenerateEpilogue g pname cxt vclsnm aclsnm ops else []+      -- Emoto 2018/01/16: added for generating Input/Output formats (for Giraph)+      iodef  = if fGenerateIO g+               then ggGenerateIO g pname cxt ist else []+  in concat [ pro+            , etdef+            , atdef+            , mtdef+            , dtdef+            , vtdef+            , cdef+            , if fMasterClass g == MCOuter then mclass else []+            , vclass+            , aclass+            , mcclass  -- Kato and Iwasaki+            , iodef   -- Emoto 2018/01/16: added+            , epi+            ]++{- generation of structured data -}++-- structured data for computation+ggIRTypeDecl :: (PregelGenerator g) => g -> Depth -> IRTypeDecl -> ProgramLines+ggIRTypeDecl g d (IRTypeDecl strname ms) =+  ggStruct g d strname ms +++  if fOperatorOverload g then ggOperators g d [LtLt, GtGt, EqEq] strname ms+  else []++-- Emoto 2018/01/16: split from gIRVertexStruct to be used in ggGenerateIO, and modified to deal with the original phase ids+-- this generates vertex data's fields about the user data in Fregel program+genVertexUserDataFields :: (PregelGenerator g) =>+  g -> IRcxt -> [IRNameAndTypeWithId]+genVertexUserDataFields g (dts,vt,et,mt,at,rs,ts) =+    concat [nomems, dupCurPrev mems]+  where IRVertexStruct name phase subphase pcms nopcms = vt+        mems = if fEmbedStruct g+               then concatMap inlineStruct' pcms else pcms+        nomems = if fEmbedStruct g+                 then concatMap inlineStruct' nopcms else nopcms+        inlineStruct' x = map (\y->(y, snd x)) $ inlineStruct True dts (fst x)+-- struct for vertex data+-- ggIRVertexStruct defines a struct / class for vertex data structure+ggIRVertexStruct :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> ProgramLines+ggIRVertexStruct g d (cxt@(dts,vt,et,mt,at,rs,ts)) =+  ggStruct g d strname ms +++  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []+  where IRVertexStruct name phase subphase pcms nopcms = vt+        IRAggStruct _ ps = at+        irvec = IRGenericsType "vector" [irInt]+        iragg = IRUserType (sAggStructName g) []+        iredg = IRGenericsType "vector" [IRUserType (sEdgeStructName g) []]+        strname = sVertStructName g+        -- Emoto 2018/01/16: split a part of code generation as genVertexUserDataFields+        ms = concat [ [(phase, irInt), (subphase, irInt)]+                    -- , nopcms+                    , map fst (genVertexUserDataFields g cxt)+                    , if fVertexHasAggr g && useAgg at then+                        ((sNeedAgg, irInt) :+                         (if fEmbedStruct g+                          then map (sConcatName sAggInVertex) (map fst ps)+                          else [(sAggInVertex, iragg)]))+                      else []+                    , if fVertexHasEdges g+                      then ((sEdgesInVertex, iredg) :+                            (if rs then [(sREdgesInVertex, iredg)] else []))+                      else []+                    ]++-- inlineStruct True tds ("soko", IRUserType "Bar" [])+--   where tds = [ IRTypeDecl "Foo" [("a", irInt), ("b", irBool)]+--               , IRTypeDecl "Bar" [("p", irInt), ("q", irBool)]+--               ]+--  ==> [("soko_p", irInt), ("soko_q", irBool)]+-- inlineStruct False tds ("soko", IRUserType "Bar" [])+--   where tds = [ IRTypeDecl "Foo" [("a", irInt), ("b", irBool)]+--               , IRTypeDecl "Bar" [("p", irInt), ("q", irBool)]+--               ]+--  ==> [("p", irInt), ("q", irBool)]+--++-- inlineStruct :: Bool -> [IRTypeDecl] -> IRNameAndType -> [IRNameAndType]+-- inlineStruct cflag dts nt@(n, IRUserType "Pair" [tfst, tsnd]) =+--   if cflag then map (sConcatName n) xs else xs+--   where xs = [("_fst", tfst), ("_snd", tsnd)]++-- inlineStruct cflag dts nt@(n, IRUserType "Pair" [_, IRUserType t _]) =+--   if cflag then map (sConcatName n) xs else xs+--   where Just (IRTypeDecl _ xs) = find pred dts+--         pred (IRTypeDecl tname _) = t == tname++-- inlineStruct cflag dts nt@(n, IRUserType t _) =+--   if cflag then map (sConcatName n) xs else xs+--   where Just (IRTypeDecl _ xs) = find pred dts+--         pred (IRTypeDecl tname _) = t == tname++inlineStruct :: Bool -> [IRTypeDecl] -> IRNameAndType -> [IRNameAndType]+inlineStruct cflag dts nt = inlineStruct' nt+ where inlineStruct' :: IRNameAndType -> [IRNameAndType]+       inlineStruct' nt@(n, IRSimpleType _) = [nt]+       inlineStruct' (n, IRUserType "Pair" [tfst, tsnd]) =+         concatMap inlineStruct' (if cflag then map (sConcatName n) xs else xs)+         where xs = [("_fst", tfst), ("_snd", tsnd)]+       inlineStruct' (n, IRUserType t _) =+         concatMap inlineStruct' (if cflag then map (sConcatName n) xs else xs)+         where Just (IRTypeDecl _ xs) = find pred dts+               pred (IRTypeDecl tname _) = t == tname++-- Emoto 2018/01/16: modified to deal with the original phase ids+dupCurPrev :: [IRNameAndTypeWithId] -> [IRNameAndTypeWithId]+dupCurPrev ms = concatMap f ms+                where f ((n, t),i) = [((sPrevName n, t),i), ((sCurrName n, t),-1)]+                                     -- curr values are tentative -> no corresponding phase+getValType :: IRcxt -> IRType+getValType (_, IRVertexStruct _ _ _ _ nopcms, _, _, _, _, _) = t+    -- Emoto 2018/01/16: modified to deal with the original phase ids+  where Just t = lookup "val" (map fst nopcms)++-- struct for edge data++ggIREdgeStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines+ggIREdgeStruct g d (_, _, IREdgeStruct name members, _, _, _, _) =+  ggStruct g d strname ms +++  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []+  where strname = sEdgeStructName g+        ms = ("nb", irInt) : members++getEType :: IRcxt -> IRType+getEType (_, _, IREdgeStruct _ ms, _, _, _, _) = t+  where Just t = lookup "e" ms++-- struct for message data+-- ggIRMsgStruct adds ``from'' fields to the message structure.++ggIRMsgStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines+ggIRMsgStruct g d (_, _, _, IRMsgStruct name members, _, _, ts) =+  ggStruct g d strname ms +++  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []+  where ms = (if fMsgNeedFrom g then [(sFromInMsg, tMsgFromType g)] else []) +++             (if needMsgTag g ts then [(sTagInMsg, tMsgTagType g)] else []) +++             members+        strname = sMsgStructName g+        needMsgTag g ts = fMsgNeedTag g || not (null ts)++-- struct for aggregation data+ggIRAggStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines+ggIRAggStruct g d (_, _, _, _, IRAggStruct name ps, _, _) =+  ggStruct g d strname ms +++  if fOperatorOverload g then ggOperators g d [LtLt, GtGt, EqEq] strname ms+  else []+  where ms = map fst ps+        strname = sAggStructName g++{- generation of struct (or class) -}++ggStruct :: (PregelGenerator g) =>+  g -> Depth -> String -> [IRNameAndType] -> ProgramLines+ggStruct g d name members =+  (d, sStructDecl g name) :+  ggPutCBracketSemi d (ggVardecls g d1 MemberVarDecl members ++ ds)+  where ds = if fStructHasMethods g then ggStructMethods g d1 name members+             else []+        d1 = d + 1++ggClass :: (PregelGenerator g) =>+  g -> Depth -> String -> ProgramLines -> ProgramLines+ggClass g d decl cs = (d, decl) : ggPutCBracketSemi d cs+--   g -> Depth -> String -> String -> String -> ProgramLines -> ProgramLines+-- ggClass g d m name super cs =+--   (d, sClassDecl g m name super []) : ggPutCBracketSemi d cs++-- declaration of (member) variables+ggVardecls :: (PregelGenerator g) =>+  g -> Depth -> VarDecl -> [IRNameAndType] -> ProgramLines+ggVardecls g d vd vss = putDepths d (mapInsert (f vd) ";" True vss)+  where f MemberVarDecl = sIRNameAndType2 g+        f BlockVarDecl = sIRNameAndType g++sIRNameAndType :: (PregelGenerator g) => g -> IRNameAndType -> String+sIRNameAndType g (name, t) = sIRType g NoTypeConv t ++ " " ++ name++sIRNameAndType2 :: (PregelGenerator g) => g -> IRNameAndType -> String+sIRNameAndType2 g (name, t) = sIRType g WritableTypeConv t ++ " " ++ name++gIRConstant :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRConstant -> ProgramLine+gIRConstant g d cxt (IRConstant nt expr) =+  gAssignStmt d (sIRNameAndType g nt) (sIRExpr g cxt expr)++{- master.compute -}++ggIRMasterCompute :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRPhaseCompute -> ProgramLines+ggIRMasterCompute g d cxt (IRPhaseCompute bs) =+  (d, sMasterCompHead g) : ggIRBlock g d cxt (IRBlock [] [])++{- vertex.compute -}++ggIRVertexCompute :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> Bool -> IRPhaseCompute -> IRVertexComputeState ->+  ProgramLines+ggIRVertexCompute g d cxt vth (IRPhaseCompute bs) ist =+  (d, sVertCompHead g) : ggVertCompBody g d cxt vth bs ist++ggVertCompBody :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> Bool -> [IRPhaseComputeProcess] ->+  IRVertexComputeState -> ProgramLines+ggVertCompBody g d cxt@(dts,vt,et,mt,at,_,ts) vth ps ist =+  ggPutCBracket d bs+  where IRVertexStruct _ ph st _ _ = vt+        pv = sVertex `sClassMember` ph+        sv = sVertex `sClassMember` st+        d' = d + 1+        sname = sVertStructName g+        assign = [gAssignStmt d'+                    (sIRNameAndType g (sVertex, IRUserType t []))+                    (sVertexGetValue g)]+                 ++ if fVertexHasAggr g && useAgg at then+                        [gAssignStmt d' (sVertex `sClassMember` sNeedAgg) "0"]+                      else []+                 where t = if fVertexTypeRef g then (sname ++ "&") else sname+        dowhile = vth && or (map getusefix ps)+                  where getusefix (IRPhaseComputeProcess _ x _ _ _) = x+        doagain = if dowhile then [gAssignStmt d'+                                    (sIRNameAndType g (sDoAgain, irBool))+                                    (sIRConst (IRCBool False))]+                  else []+        dsw = if dowhile then d + 2 else d'+        body = if dowhile then+                 ggDoWhileStmt+                   d'+                   (gAssignStmt dsw sDoAgain (sIRConst (IRCBool False)) : sw)+                   sDoAgain+                else sw+        sw = ggSwitch dsw+               (sStateToCaseval g pv sv)+               (ggPutCBracket+                  dsw (concatMap (ggVertCompProc g dsw ph st cxt) ps))+        vv = sVertexSetValue g+        cu = or (map choiceUsed ps)+        bs = concat [ assign+                    , doagain+                    , ggVertCompSS1 g d' cxt ph st cu ist+                    , body+                    , if vv == "" then [] else [putDS d' vv]+                    ]++ggVertCompProc :: (PregelGenerator g) =>+   g -> Depth -> String -> String -> IRcxt -> IRPhaseComputeProcess ->+   ProgramLines+ggVertCompProc g d pv sv cxt (IRPhaseComputeProcess state _ lvars body conds) =+  [gCaseState d state] +++  ggPutCBracket d1 (ggVardecls g d2 BlockVarDecl lvars +++                    ggIRBlock g d2 cxt body +++                    ggVertCompStateTrans g d2 cxt pv sv conds) +++  [putDS d1 sBreak]+  where d1 = d + 1+        d2 = d + 2++ggVertCompSS1 :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> String -> String -> Bool -> IRVertexComputeState ->+  ProgramLines++ggVertCompSS1 g d cxt@(_,_,_,_,at,_,_) p s cu (ip,is) =+-- ggVertCompSS1 g d cxt p s (ip,is) =+  ggIfThenStmt d (sBinopExpr "==" (sSSNumber g) "1") (ggPutCBracket d as)+  where d1 = d + 1+        as = concat [ ggSetPhaseStep g d1 cxt (p,ip) (s,is)+                    , if fVertexHasAggr g && useAgg at then+                        [gAssignStmt d1 (sVertex `sClassMember` sNeedAgg) "0"]+                      else []+                    , let srand = sInitRand g in+                      if cu && srand /= "" then [(d1, srand)] else []+                    ]++ggVertCompStateTrans :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> String -> String ->+  [(IRExpr, IRVertexComputeState, IRBlock)] -> ProgramLines+ggVertCompStateTrans g d _ _ _ [] = []+ggVertCompStateTrans g d cxt pv sv [(expr, (p,s), b)] =+  ggIfThenStmt d (sIRExpr g cxt expr) (if p == -1 then vth else novth)+  where d1 = d + 1+        novth = ggPutCBracket d (ggSetPhaseStep g d1 cxt (pv,p) (sv,s) +++                                 ggIRBlock g d1 cxt b ++ [putDS d1 sBreak])+        vth = ggPutCBracket d (putDSs d1 [sVoteToHalt g] +++                               ggIRBlock g d1 cxt b ++ [putDS d1 sBreak])+--      vth = ggPutCBracket d (putDSs d1 [sVoteToHalt g, sBreak])++ggVertCompStateTrans g d cxt pv sv (st:sts) =+  ggVertCompStateTrans g d cxt pv sv [st] +++  ggVertCompStateTrans g d cxt pv sv sts++sVertCompState :: IRVertexComputeState -> String+sVertCompState (p,s) = show (10 * p + s)++ggSetPhaseStep :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> (String, Int) -> (String, Int) -> ProgramLines+ggSetPhaseStep g d cxt (pname, pval) (sname, sval) =+  vf pname pval ++ vf sname sval+  where vf name val = ggIRStatementLocal g d cxt+                        (IRVarVertex (name, irInt) IRNone [])+                        (IRCExp irInt (IRCInt val))++{- generation of method definition -}++ggIRMethod :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRMethod -> ProgramLines+ggIRMethod g d cxt (IRMethod t name formals body) =+  (d, sMethodDefHead g t name formals) : ggIRBlock g d cxt body++sMethodDefHead :: (PregelGenerator g) =>+  g -> IRType -> String -> [IRNameAndType] -> String+sMethodDefHead g t name formals+  = sIRType g NoTypeConv t ++ " " +++    name ++ sFormalsList g formals++sFormalsList :: (PregelGenerator g) => g -> [IRNameAndType] -> String+sFormalsList g = sPutParen . sFormals g++sFormals :: (PregelGenerator g) => g -> [IRNameAndType] -> String+sFormals g = concatMapInsert (sIRNameAndType g) ", " False++sActuals :: (PregelGenerator g) => g -> IRcxt -> [IRExpr] -> String+sActuals g cxt = concatMapInsert (sIRExpr g cxt) ", " False++{- generation of block and statement -}++ggIRBlock :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRBlock -> ProgramLines+ggIRBlock g d cxt (IRBlock locals body) =+  ggPutCBracket d (ggVardecls g (d + 1) BlockVarDecl locals +++                   ggBlock g (d + 1) cxt body)++ggBlock :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> [IRStatement] -> ProgramLines+ggBlock g d cxt = concatMap (ggStatement g d cxt)++ggStatement :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRStatement -> ProgramLines+ggStatement g d cxt (IRStatementLocal v e) = ggIRStatementLocal g d cxt v e+ggStatement g d cxt (IRStatementAggr v e es) =+  ggIRStatementAggr g d cxt v e es+ggStatement g d cxt (IRStatementMsg v op e) = ggIRStatementMsg g d cxt v op e+ggStatement g d cxt (IRStatementReturn e) = [gReturnStmt d (sIRExpr g cxt e)]+ggStatement g d cxt IRStatementVTH = putDSs d [sVoteToHalt g, sBreak]+ggStatement g d cxt (IRStatementSendN nt e es) =+  ggIRStatementSend g d cxt True nt e es+ggStatement g d cxt (IRStatementSendR nt e es) =+  ggIRStatementSend g d cxt False nt e es+ggStatement g d cxt (IRStatementIfThen e blk) =+  ggIfThenStmt d (sIRExpr g cxt e) (ggIRBlock g d cxt blk)++ggIRStatementLocal :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRVar -> IRExpr -> ProgramLines++ggIRStatementLocal g d cxt v@(IRVarLocal (n,t)) e =+  [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]++-- we treat the case where `curr' value is assigned to `prev' value specially++ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_,_)+  v@(IRVarVertex (_, IRSimpleType _) _ [])+  e@(IRVExp (IRVarVertex (_, IRSimpleType _) _ [])) =+  [gAssignStmt d (sIRVar g v) r]+  where s = sIRExpr g cxt e+        r = if fUseWritable g then sMakeWritable g s t else s+        t = varType v++--- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)+---   v@(IRVarVertex nt1 pc1 [])+---   e@(IRVExp (IRVarVertex nt2 pc2 [])) | fEmbedStruct g =+---   concat (zipWith f ds ss)+---   where ds = inlineStruct True dts nt1+---         ss = inlineStruct True dts nt2+---         f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt+---                               (IRVarVertex (n1,t1) pc1 [])+---                               (IRVExp (IRVarVertex (n2,t2) pc2 []))++-- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)+--   v@(IRVarVertex (n1,t1) IRPrev [])+--   e@(IRVExp (IRVarVertex (n2,t2) IRCurr [])) | fEmbedStruct g =+--  concatMap f (inlineStruct False dts (n1,t1))+--  where f :: IRNameAndType -> ProgramLines+--        f nt = ggIRStatementLocal g d cxt+--                 (IRVarVertex (n1,t1) IRPrev [nt])+--                 (IRVExp (IRVarVertex (n2,t2) IRCurr [nt]))++--- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)+---   v@(IRVarVertex (n,_) pc1 [mt])+---   e@(IRVExp (IRVarVertex nt2 pc2 [])) | fEmbedStruct g =+---   concat (zipWith f ds ss)+---   where ds = inlineStruct True dts (sConcatName n mt)+---         ss = inlineStruct True dts nt2+---         f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt+---                               (IRVarVertex (n1,t1) pc1 [])+---                               (IRVExp (IRVarVertex (n2,t2) pc2 []))++-- We assume that the length of ds and that of ss are the same.+ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_,_)+  v@(IRVarVertex nt1 pc1 nts1)+  e@(IRVExp (IRVarVertex nt2 pc2 nts2)) | fEmbedStruct g =+  concat (zipWith f ds ss)+  where scn (n,_) nt = sConcatName n nt+        ds = inlineStruct True dts (foldl scn nt1 nts1)+        ss = inlineStruct True dts (foldl scn nt2 nts2)+        f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt+                              (IRVarVertex (n1,t1) pc1 [])+                              (IRVExp (IRVarVertex (n2,t2) pc2 []))++-- ggIRStatementLocal g d cxt v@(IRVarAggr (n1,t1)) e@(IRAggr (n2,t2)) =+--   [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]++ggIRStatementLocal g d cxt v@(IRVarAggr (n,t)) e =+  [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]+ +ggIRStatementLocal g d cxt v e = [gAssignStmt d (sIRVar g v) r]+  where s = sIRExpr g cxt e+        r = if fUseWritable g then sMakeWritable g s t else s+        t = varType v++ggIRStatementAggr :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRNameAndType -> IRExpr -> [IRExpr] -> ProgramLines+ggIRStatementAggr g d cxt@(_, _, _, _, IRAggStruct _ ps, _, _) nt@(n,t) e es =+  {-+  putDSs d (concat [ [sIRNameAndType g nt]+                   , if fVertexHasAggr g+                     then [sAssignExpr (sVertex `sClassMember` sNeedAgg)+                                       (getNeedAgg n ps)]+                     else []+                   , [sAssignExpr name (sIRExpr g cxt e), sAggregate g nt]+                   ])+  -}+  putDS d (sIRNameAndType g nt) : ag d es+  where name = n+        ag d [] = ggPutCBracket d+                    (putDSs (d + 1)+                            (concat [ if fVertexHasAggr g+                                      then [sUpdateWithOrExpr+                                             (sVertex `sClassMember` sNeedAgg)+                                             (show $ pow2 ((read $ getNeedAgg n ps) - 1))]+                                      --then [sAssignExpr+                                      --       (sVertex `sClassMember` sNeedAgg)+                                      --       (getNeedAgg n ps)]+                                      else []+                                    , [sAssignExpr name (sIRExpr g cxt e),+                                       sAggregate g nt]+                                    ]))+        ag d (e:es) = ggIfThenStmt d (sIRExpr g cxt e) (ag d es)+        as = [sAssignExpr name (sIRExpr g cxt e), sAggregate g nt]++ggIRStatementMsg :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines++ggIRStatementMsg g d cxt@(_,_,_,_,_,_,ts) v op e =+  ggPutCBracket d (dec ++ [(d1, sMsgRecvIter g)] ++ aux e)+  where d1 = d + 1+        d2 = d + 2+        dec | fStatementMsgDecl g op = ggStatementMsgDecl g d1 v op+            | otherwise = ggStatementMsgStandardDecl g d1 v op+        lop | fStatementMsgLoop g op = ggStatementMsgLoop g d2 cxt v op e+            | otherwise = ggStatementMsgStandardLoop g d2 cxt v op e+        body = ggPutCBracket d1 lop+        aux (IRMVal (name, _)) =+          let n = lookupTagNo name ts in+          if n > 0 then+            ggPutCBracket d1+              (ggIfThenStmt d2+                 (sIRExpr g cxt+                   (IRFunAp (IRBinOp "==")+                     [IRMVal (sTagInMsg, irInt), IRCExp irInt (IRCInt n)]))+                 (ggPutCBracket d2 (shiftDSs 1 lop)))+          else body+        aux _ = body++-- standard functions for generating aggregation loop++-- ggStatementMsgStandardDecl generates a program line that assigns the+-- unit value of a specified operator `op' to `v'.+ggStatementMsgStandardDecl :: (PregelGenerator g) =>+  g -> Depth -> IRVar -> IRAggOp -> ProgramLines+ggStatementMsgStandardDecl g d v op@(IRAggChoice _) =+  [(d, "int n = 0;"), gAssignStmt d (sIRVar g v) (aggOpUnit op)]+ggStatementMsgStandardDecl g d v op =+  [gAssignStmt d (sIRVar g v) (aggOpUnit op)]++-- ggStatementMsgStandardLoop generaets a program line that performs+--   v = v `op` e, or v = choice(v, e).+ggStatementMsgStandardLoop :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines+ggStatementMsgStandardLoop g d cxt v op@(IRAggChoice _) e =+    [gAssignStmt d+                 sv+                 (sConditionalExpr (sGenRand g ++ " <= 1.0 / ++n") se sv)]+    where sv = sIRVar g v+          se = sIRExpr g cxt e+ggStatementMsgStandardLoop g d cxt v op e =+  [gAssignStmt d+               (sIRVar g v)+               (sIRExpr g cxt (IRFunAp (aggOp2Fun g op) [IRVExp v, e]))]++{-+ggIRStatementMsg g d cxt v op e =+  [gAssignStmt d (sIRVar g v) (aggOpUnit op),+   (d, sMsgRecvIter g),+   gAssignStmt (d + 1)+               (sIRVar g v)+               (sIRExpr g cxt (IRFunAp (aggOp2Fun g op) [IRVExp v, e]))]+-}++mkBlock :: ProgramLines -> ProgramLines+mkBlock [] = []+mkBlock (dxs@((d,x):_)) = (d, "{"): map (\(d,x)->(d+1,x)) dxs ++ [(d, "}")]++ggIRStatementSend :: (PregelGenerator g) =>+  g -> Depth -> IRcxt -> Bool -> IRNameAndType -> IRExpr -> [IRExpr] ->+  ProgramLines+ggIRStatementSend g d cxt@(_,_,_, IRMsgStruct ms _,_,rs,ts) dir (name,t) e es =+  mkBlock $ +  (d, sMsgSendVardecl g mem) : (d, sMsgSendIter g) :+  if (rs == False) || (fVertexHasEdges g == True)+  then sd (d + 1) es else ggIfThenStmt (d + 1) cnd (sd (d + 2) es)+  where mem = if dir then sEdgesInVertex else sREdgesInVertex+        cnd = if dir then sIsForwardEdge g else sIsReverseEdge g+        sd d [] = ggPutCBracket d+                    (putDSs+                      (d + 1)+                      (concat [ [sIRNameAndType g+                                   (sMsg, IRUserType (sMsgStructName g) [])]+                              , if targetLanguage g == Java+                                then [sAssignExpr+                                        sMsg (sNew (sMsgStructName g) [])]+                                else []+                              , let n = lookupTagNo name ts in+                                if (n > 0)+                                then [sAssignExpr+                                        (sMsg `sClassMember` sTagInMsg)+                                        (sMakeWritable g (show n) irInt)]+                                else []+                              , [sAssignExpr+                                  (sMsg `sClassMember` name)+                                  (sMakeWritable g (sIRExpr g cxt e) t),+                                 sSendMsg g dir]+                              ]))+        sd d (e:es) = ggIfThenStmt d (sIRExpr g cxt e) (sd d es)++lookupTagNo :: String -> [(String, Int)] -> Int+lookupTagNo name [] = 0+lookupTagNo name ((s,n):xs) | name == s = n+                            | otherwise = lookupTagNo name xs++aggOpUnit :: IRAggOp -> String+aggOpUnit IRAggMin = "99999999 /* UNIT_MIN */"+aggOpUnit IRAggMax = "-99999999 /* UNIT_MAX */"+aggOpUnit IRAggSum = "0 /* UNIT_SUM */"+aggOpUnit IRAggProd = "1 /* UNIT_PROD */"+aggOpUnit IRAggAnd = "true /* UNIT_AND */"+aggOpUnit IRAggOr = "false /* UNIT_OR */"+aggOpUnit (IRAggChoice c) = sIRConst c+aggOpUnit (IRTupledAgg _) = "UNIT_TUPLED"++aggOp2Fun :: (PregelGenerator g) => g -> IRAggOp -> IRFun+aggOp2Fun g IRAggMin = IRFun (sFunName g "min")+aggOp2Fun g IRAggMax = IRFun (sFunName g "max")+aggOp2Fun g IRAggSum = IRBinOp "+"+aggOp2Fun g IRAggProd = IRBinOp "*"+aggOp2Fun g IRAggAnd = IRBinOp "&&"+aggOp2Fun g IRAggOr = IRBinOp "||"+aggOp2Fun g (IRAggChoice _) = IRFun (sFunName g "choice")+aggOp2Fun g (IRTupledAgg _) = IRFun "tupled"++{- generation of expression -}++sIRExpr ::  (PregelGenerator g) => g -> IRcxt -> IRExpr -> String+sIRExpr g cxt (IRIf e1 e2 e3) =+  sPutParen (sIRExpr g cxt e1 ++ "? " ++ sIRExpr g cxt e2 ++ ": " +++             sIRExpr g cxt e3)++sIRExpr g cxt (IRFunAp (IRFun "neg") [arg]) =+  "(-(" ++ sIRExpr g cxt arg ++ "))"++sIRExpr g cxt (IRFunAp (IRFun fn) actuals) =+  if take len fname == sOperator+  then sIRExpr g cxt (IRFunAp (IRBinOp (drop len fname)) actuals)+  else fname ++ "(" ++ sActuals g cxt actuals ++ ")"+  where fname = sFunName g fn+        len = length sOperator++sIRExpr g cxt@(dts,_,_,_,_,_,_)+  (IRFunAp (IRBinOp "==")+            [IRVExp (IRVarVertex nt1 IRPrev []),+             IRVExp (IRVarVertex nt2 IRCurr [])]) | fEmbedStruct g =+  concatMapInsert (sPutParen . f) " && " False (inlineStruct False dts nt1)+  where f :: IRNameAndType -> String+        f nt = sIRExpr g cxt (IRFunAp (IRBinOp "==")+                                       [IRVExp (IRVarVertex nt1 IRPrev [nt]),+                                        IRVExp (IRVarVertex nt2 IRCurr [nt])])++sIRExpr g cxt (IRFunAp (IRBinOp op) [lt,rt]) =+  sPutParen (sIRExpr g cxt lt ++ " " ++ op ++ " " ++ sIRExpr g cxt rt)++sIRExpr g cxt (IRVExp v) = sIRVarRight g v+sIRExpr g cxt (IRMVal (name,_)) =+  sMayMakePrimitive g (sMsgRecvMsg g `sClassMember` name)+sIRExpr g cxt (IRCExp t c) = sIRConst c+sIRExpr g cxt (IRAggr ag) = sIRAggr g ag++sIRConst :: IRConst -> String+sIRConst (IRCInt n) = show n+sIRConst (IRCBool True) = "true"+sIRConst (IRCBool False) = "false"+sIRConst (IRCDouble x) = show x++sIRVar :: (PregelGenerator g) => g -> IRVar -> String+sIRVar g (IRVarLocal (name, _)) = name+sIRVar g (IRVarVertex ("id", _) _ _) = sVertexGetId g+sIRVar g (IRVarVertex (name, _) pc nts) =+  if fEmbedStruct g then sClassMemberPC sVertex ss pc+  else foldl f (sClassMemberPC sVertex name pc) nts+  where post = concatMapInsert fst "_" False nts+        ss = if post == "" then name else (name ++ "_" ++ post)+        f s (n,_) = s `sClassMember` n+sIRVar g (IRVarEdge ("vid", _) _) = sEdgeVertexId g+sIRVar g (IRVarEdge (name, _) fs) = sEdgeMember g name fs+sIRVar g (IRVarAggr (name, _)) = name++sIRVarRight :: (PregelGenerator g) => g -> IRVar -> String+sIRVarRight g (IRVarLocal (name, _)) = name+sIRVarRight g v = sMayMakePrimitive g (sIRVar g v)++sIRType :: (PregelGenerator g) => g -> TypeConv -> IRType -> String+sIRType g NoTypeConv (IRSimpleType dtype) = sDTypeSimple g dtype+sIRType g WritableTypeConv (IRSimpleType dtype) = sDType g dtype+sIRType g c (IRGenericsType name ts) =+  name ++ "<" ++ concatMapInsert (sIRType g c) "," False ts ++ ">"+sIRType g _ (IRUserType name ts) = name   --- TODO: This should be modified+sIRType g _ IRVoidType = "void"++varType :: IRVar -> IRType+varType (IRVarLocal (_,t)) = t+varType (IRVarVertex (_,t) _ []) = t+varType (IRVarVertex (_,_) _ ms) = snd (last ms)+varType (IRVarEdge (_,t) _) = t   -- TODO: This should be modified+varType (IRVarAggr (_,t)) = t++sClassMemberPC :: String -> String -> IRPrevCurr -> String+sClassMemberPC s m IRPrev = sClassMemberPrev s m+sClassMemberPC s m IRCurr = sClassMemberCurr s m+sClassMemberPC s m IRNone = s `sClassMember` m++sClassMemberPrev :: String -> String -> String+sClassMemberPrev s m = s `sClassMember` (sPrevName m)++sClassMemberCurr :: String -> String -> String+sClassMemberCurr s m = s `sClassMember` (sCurrName m)++sIRAggr :: (PregelGenerator g) => g -> IRNameAndType -> String+sIRAggr g nt = sMayMakePrimitive g (sAggValue g nt)++getNeedAgg :: String -> [(IRNameAndType, IRAggOp)] -> String+getNeedAgg str ps = getNeedAgg' 1 ps+                    where+                    getNeedAgg' n [] = show n+                    getNeedAgg' n (((name,_),_):ps) =+                      if str == name then show n else getNeedAgg' (n + 1) ps++sIRModifier :: IRModifier -> String+sIRModifier IRModVirtual = "virtual "+sIRModifier IRInline = "inline"+sIRModifier IRNoModifier = ""++sPrevName :: String -> String+sPrevName = (++ "_prev")++sCurrName :: String -> String+sCurrName = (++ "_curr")++-- Determine whether `choice' is used or not+choiceUsed :: IRPhaseComputeProcess -> Bool+choiceUsed (IRPhaseComputeProcess _ _ _ (IRBlock _ ss) _) =+  or (map choiceUsedStatement ss)++choiceUsedStatement :: IRStatement -> Bool+choiceUsedStatement (IRStatementMsg _ (IRAggChoice _) _) = True+choiceUsedStatement _ = False++-- for use by Main.hs+genCode ast nast ops sfs =+  let ir = genIR (kelimcomm, kusevth, kmsgcomb) sfs nast+      kelimcomm = elimCommOpt ops && (not (useSmt ops))+      kusevth = useV2HOpt ops && (not (useSmt ops))+      kmsgcomb = useMsgCombOpt ops+      str = if mode == IROnly then groom ir+            else if mode == ASTOnly then groom ast+            else if mode == NASTOnly then groom nast+            else unlines $ map makeLn $ gen 0 ops ir+                 where gen = case mode of+                               Giraph -> ggIRProg GiraphGenerator+                               PregelPlus -> ggIRProg PregelPlusGenerator+  in str+  where mode = genMode ops+        makeLn (d,str) | d == 0    = str+                       | otherwise = "  " ++ makeLn (d - 1, str)++-- genCode' :: DASTData -> DNormalized DASTData -> Option -> [SMTOptimizable] ->+--             [(String, String)]+genCode' ast nast ops sfs = [(fname, genCode ast nast ops sfs)] -- single file?+  where fname = case outputFile ops of+                  Just nm -> nm+                  Nothing -> case lang of+                               -- Java -> pname ++ ".java"+                               Java -> let (h:t) = pname in+                                         toUpper h : (t ++ ".java")+                               CPlusPlus -> pname ++ ".cpp"+        lang = case (genMode ops) of+                 Giraph -> targetLanguage GiraphGenerator+                 PregelPlus -> targetLanguage PregelPlusGenerator+        (DNormalized pname _ _ _ _ _ _ _) = nast++{-+genCode' ast nast ops = [(filename, genCode ast nast ops)]  -- single file?+    where filename = case outputFile ops of+                       Just nm -> nm+                       Nothing -> case lang of+                                    Java -> pname ++ ".java"+                                    CPlusPlus -> pname ++ ".cpp"+                           where lang = case (genMode ops) of+                                          Giraph -> targetLanguage GiraphGenerator+                                          PregelPlus -> targetLanguage PregelPlusGenerator+          pname = let (DNormalized progname _ _ _ _ _ _ _) = nast in progname+-}
+ compiler/Inlining.hs view
@@ -0,0 +1,344 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++ Inlining functions on values and moving let-bindings (of variables) to the top of the function. (4th step)++ Assumption:+  +  - let-bindings are in the order consistent of their dependencies++-}++module Inlining where++import Spec+++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++import ASTData+import TypeChecker++type DBinding = (DVarName, DSmplDef DASTData)+type DBindings = [DBinding]+type DEnvI = (DBindings, [Int], DUnique, [[DSmplDef DASTData]])+++-- entry point+runInlining :: DProgramSpec DASTData -> DUnique -> (DProgramSpec DASTData, DUnique)+runInlining p uid = let (p', (_,_,uid',_)) = runState (inlining p) ([],[],uid,[[]])+                    in (p', uid')++class Inliable a where+    inlining :: a -> State DEnvI a  -- inliging functions, and storing let-bindings contained in functions to the env.+    inlining a = do return a  -- by default, returns the input++getBinds :: State DEnvI DBindings+getBinds = do xx <- get+              let (bds,_,_,_) = xx+              return bds++addBinds :: DBindings -> State DEnvI ()+addBinds bds =+    do xx <- get+       let (bds', ks, i, vbds) = xx+       put (bds++bds', length bds:ks, i, vbds)++popBinds :: State DEnvI ()+popBinds =+    do xx <- get+       let (bds, k:ks, i, vbds) = xx+       put (drop k bds, ks, i, vbds)++getNewName :: String -> State DEnvI DVarName+getNewName s = +    do xx <- get +       let (bds, ks, i, vbds) = xx+           (n, i') = genNewName i (getBaseName s)+       put (bds, ks, i', vbds)+       return n++addVarBinds :: [DSmplDef DASTData] -> State DEnvI ()+addVarBinds vbds = +    do xx <- get+       let (bds, ks, i, vbds':vbdss) = xx+       put (bds, ks, i, (reverse vbds ++ vbds'):vbdss)++getVarBinds :: State DEnvI [DSmplDef DASTData]+getVarBinds = +    do xx <- get+       let (bds, ks, i, vbds:vbdss) = xx+       put (bds, ks, i, vbdss)+       return (reverse vbds)++saveVarBinds :: State DEnvI ()+saveVarBinds = +    do (bds, ks, i, vbdss) <- get+       put (bds, ks, i, []:vbdss)++instance Inliable (DProgramSpec DASTData) where+    inlining (DProgramSpec rs p a) = +        do p' <- inlining p+           return (DProgramSpec rs p' a)++instance Inliable (DRecordSpec DASTData) +instance Inliable (DType DASTData) +instance Inliable (DConst DASTData)++isFunDefG (DGDefSmpl def a) = isFunDef def+isFunDefG _ = False++isSmplDef (DGDefSmpl def a) = True+isSmplDef _ = False++isFunDefGV _ = False++isFunDef (DDefFun f vs ds e a) = True+isFunDef _ = False++getSmplDef (DGDefSmpl def a) = def+++addFunDefBindG :: (DGroundDef DASTData) -> State DEnvI ()+addFunDefBindG def = +    do case def of +         (DGDefSmpl def' a) -> addFunDefBind def'+         _ -> return ()+++addFunDefBind :: (DSmplDef DASTData) -> State DEnvI ()+addFunDefBind def = +    do case def of +         (DDefFun f vs ds e a) -> addBinds [(getName f, def)]+         _ -> return ()++popFunDefBindG :: (DGroundDef DASTData) -> State DEnvI ()+popFunDefBindG def = +    do case def of +         (DGDefSmpl def a) -> popFunDefBind def+         _ -> return ()++popFunDefBindGV :: (DDefGraphVar DASTData) -> State DEnvI ()+popFunDefBindGV def = +    do return ()++popFunDefBind :: (DSmplDef DASTData) -> State DEnvI ()+popFunDefBind def = +    do case def of +         (DDefFun f vs ds e a) -> popBinds+         _ -> return ()+++inliningLetG defs e =+ do defs' <- mapM (\def -> do def' <- inlining def; addFunDefBindG def'; return def') defs+    e' <- inlining e+    mapM (\x -> do popFunDefBindG x) defs+    let defs'' = filter (not . isFunDefG) defs'+        defs''' = filter (not . isSmplDef) defs''+        vdefs = map getSmplDef $ filter (isSmplDef) defs''+    addVarBinds vdefs+    return (defs''', e')       ++-- no room for inlining+inliningLetGV defs e = return (defs, e)++inliningLet defs e =+ do defs' <- mapM (\def -> do def' <- inlining def; addFunDefBind def'; return def') defs+    let defs'' = filter (not . isFunDef) defs'+    addVarBinds defs''+    e' <- inlining e+    mapM (\x -> do popFunDefBind x) defs+    return (e')       ++instance Inliable (DProg DASTData) where+    inlining (DProg f defs e a) = +        do (defs', e') <- inliningLetG defs e+           vdefs <- getVarBinds               -- the inner var defs+           let vdefs' = map (\def -> DGDefSmpl def (getData def)) vdefs+           return (DProg f (vdefs' ++ defs') e' a)++instance Inliable (DGroundDef DASTData) where+    inlining (DGDefVI d a) = do d' <- inlining d+                                return (DGDefVI d' a)+    inlining (DGDefVC d a) = do d' <- inlining d+                                return (DGDefVC d' a)+    inlining (DGDefGV d a) = do d' <- inlining d+                                return (DGDefGV d' a)+    inlining (DGDefGF d a) = do d' <- inlining d+                                return (DGDefGF d' a)+    inlining (DGDefSmpl d a) = do d' <- inlining d+                                  return (DGDefSmpl d' a)++instance Inliable (DDefVertComp DASTData) where+    inlining (DDefVertComp f defs e a) = +        do saveVarBinds+           e' <- inliningLet defs e+           vdefs <- getVarBinds  -- the inner var definitions+           return (DDefVertComp f vdefs e' a)++instance Inliable (DDefVertInit DASTData) where+    inlining (DDefVertInit f defs e a) = +        do saveVarBinds+           e' <- inliningLet defs e +           vdefs <- getVarBinds  -- the inner var definitions+           return (DDefVertInit f vdefs e' a)++instance Inliable (DDefGraphVar DASTData) where+    inlining (DDefGraphVar v e a) = +        do (_, e') <- inliningLetG [] e +           return (DDefGraphVar v e' a)++instance Inliable (DDefGraphFun DASTData) where+    inlining (DDefGraphFun f v defs e a) = +        do (defs', e') <- inliningLetGV defs e +           return (DDefGraphFun f v defs' e' a)++instance Inliable (DSmplDef DASTData) where+    inlining (DDefFun f vs defs e a) = +        do saveVarBinds    -- save the outer var definitions+           e' <- inliningLet defs e+           vdefs' <- getVarBinds   -- get the inner var definitions+           return (DDefFun f vs vdefs' e' a)+    inlining (DDefVar v defs e a) = +        do e' <- inliningLet defs e +           return (DDefVar v [] e' a)  -- no inner definitions+    inlining (DDefTuple vs defs e a) = +        do e' <- inliningLet defs e +           return (DDefTuple vs [] e' a)  -- no inner definitions++instance Inliable (DTermination DASTData) where+    inlining (DTermF a) = return (DTermF a)+    inlining (DTermI e a) = +        do e' <- inlining e+           return (DTermI e' a)+    inlining (DTermU e a) = +        do e' <- inlining e+           return (DTermU e' a)++instance Inliable (DGraphExpr DASTData)++refreshNameV :: DVar DASTData -> State DEnvI (DVar DASTData)+refreshNameV (DVar v a) =+    do n <- getNewName v+       return (DVar n a)++refreshName :: DSmplDef DASTData -> State DEnvI (DSmplDef DASTData)+refreshName (DDefVar v [] e a) = +    do v' <- refreshNameV v+       return (DDefVar v' [] e a)+refreshName (DDefTuple vs [] e a) = +    do vs' <- mapM refreshNameV vs+       return (DDefTuple vs' [] e a)++refreshNameV2 :: (DASTData, DVar DASTData) -> State DEnvI (DVar DASTData)+refreshNameV2 (a, DVar v _) =+    do n <- getNewName v+       return (DVar n a)++replaceNamesD :: [(DVarName, DVarName)] -> [(DVarName, DExpr DASTData)] -> DSmplDef DASTData -> DSmplDef DASTData+replaceNamesD subsv subse (DDefVar v [] e a) = (DDefVar v [] (replaceNames subsv subse e) a)+replaceNamesD subsv subse (DDefTuple vs [] e a) = (DDefTuple vs [] (replaceNames subsv subse e) a)++replaceNames :: [(DVarName, DVarName)] -> [(DVarName, DExpr DASTData)] -> DExpr DASTData -> DExpr DASTData+replaceNames subsv subse e = rec e+  where+    rec (DIf p t e a) = +        let p' = rec p+            t' = rec t+            e' = rec e+        in (DIf p' t' e' a)+    rec (DTuple es a) =+        let es' = map rec es +        in (DTuple es' a)+    rec (DFunAp f es a) =+        let es' = map rec es+        in (DFunAp f es' a)+    rec (DConsAp c es a) =+        let es' = map rec es+        in (DConsAp c es' a)+    rec (x@(DFieldAcc t fs a)) = x+    rec (x@(DFieldAccE e fs a)) = x+    rec (DAggr a' e g es a) =+        let e'  = rec e+            es' = map rec es+        in (DAggr a' e' g es' a)+    rec (x@(DVExp (DVar v av) a)) = +        case lookup v subsv of+          Just v' -> (DVExp (DVar v' av) a)+          Nothing -> case lookup v subse of+                       Just e -> e+                       Nothing -> x+    rec (x@(DCExp c a)) = x+++updateType :: forall (t :: * -> *). +            (DAdditionalData2 (t DASTData) DASTData DASTData (t DASTData), +             DAdditionalData (t DASTData) DASTData+            ) +            => Substitution -> t DASTData -> t DASTData+updateType s x = mapData (\a -> a { typeOf = apply s (typeOf a)}) x++instantiation :: DFun DASTData -> [DExpr DASTData] -> DASTData -> State DEnvI (DExpr DASTData)+instantiation f es a = +    do bds <- getBinds+       case lookup (getName f) bds of+         Just (DDefFun f vs defs e a') ->         -- defs are of DefVar/DDefTuple+             do let ets = map (typeOf.getData) es      -- types of the arguments+                    eas = map (getData) es             -- types and deps of the arguments +                defs' <- mapM refreshName defs         -- give them new names+                vs' <- mapM refreshNameV2 (zip eas vs) -- new variable names with the argument types+                let t = typeOf a                       -- type of the expression+                    tf = typeOf (getData f)            -- type of the function+                    subs = unify [(tf, typeFunction (ets++[t]))] -- the type-substitution+                    defs'' = map (updateType subs) defs'+                    subsv = zip (concatMap getNames defs) (concatMap getNames defs'') -- [(oldvar,newvar)]+                    defs2 = zipWith (\v e -> DDefVar v [] e (getData v)) vs' es  -- arguments are bound to the new variables+                    subse = zip (map getName vs) (map (\v -> DVExp v (getData v)) vs')  -- [(arg, exp)]+                    defs''' = map (replaceNamesD subsv subse) defs''+                    e' = replaceNames subsv subse e+                    e'' =  updateType subs e'+                addVarBinds (defs''' ++ defs2)        -- these are moved to immediately under the VertComp/VertInit+                return e''+         Nothing -> return (DFunAp f es a)  -- built-in functions+  +instance Inliable (DExpr DASTData) where+    inlining (DIf p t e a) = +        do p' <- inlining p+           t' <- inlining t+           e' <- inlining e+           return (DIf p' t' e' a)+    inlining (DTuple es a) =+        do es' <- mapM inlining es +           return (DTuple es' a)+    inlining (DFunAp f es a) = -- inlining!+        do es' <- mapM inlining es+           instantiation f es' a+    inlining (DConsAp c es a) =+        do c' <- inlining c+           es' <- mapM inlining es+           return (DConsAp c' es' a)+    inlining (DFieldAcc t fs a) =+        do return (DFieldAcc t fs a)+    inlining (DFieldAccE e fs a) =+        do return (DFieldAccE e fs a)+    inlining (DAggr a' e g es a) =+        do e' <- inlining e+           es' <- mapM inlining es+           return (DAggr a' e' g es' a)+    inlining (DVExp v a) =+        do return (DVExp v a)+    inlining (DCExp c a) = +        do return (DCExp c a)++instance Inliable (DGen DASTData) +instance Inliable (DEdge DASTData)+instance Inliable (DTableExpr DASTData)+instance Inliable (DField DASTData) +instance Inliable (DFun DASTData) +instance Inliable (DVar DASTData) +instance Inliable (DConstructor DASTData)
+ compiler/Lexer.hs view
@@ -0,0 +1,12248 @@+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}+{-# LANGUAGE CPP #-}+{-# LINE 2 "Lexer.x" #-}++module Lexer where+import Data.Char (chr)++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Array.Base (unsafeAt)+#else+import Array+#endif+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++import Control.Applicative as App (Applicative (..))+import qualified Control.Monad (ap)+++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c+                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++data AlexState = AlexState {+        alex_pos :: !AlexPosn,  -- position at current input location+        alex_inp :: String,     -- the current input+        alex_chr :: !Char,      -- the character before the input+        alex_bytes :: [Byte],+        alex_scd :: !Int        -- the current startcode++++    }++-- Compile with -funbox-strict-fields for best results!++runAlex :: String -> Alex a -> Either String a+runAlex input__ (Alex f)+   = case f (AlexState {alex_pos = alexStartPos,+                        alex_inp = input__,+                        alex_chr = '\n',+                        alex_bytes = [],++++                        alex_scd = 0}) of Left msg -> Left msg+                                          Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Functor Alex where+  fmap f a = Alex $ \s -> case unAlex a s of+                            Left msg -> Left msg+                            Right (s', a') -> Right (s', f a')++instance Applicative Alex where+  pure a   = Alex $ \s -> Right (s, a)+  fa <*> a = Alex $ \s -> case unAlex fa s of+                            Left msg -> Left msg+                            Right (s', f) -> case unAlex a s' of+                                               Left msg -> Left msg+                                               Right (s'', b) -> Right (s'', f b)++instance Monad Alex where+  m >>= k  = Alex $ \s -> case unAlex m s of+                                Left msg -> Left msg+                                Right (s',a) -> unAlex (k a) s'+  return = App.pure++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->+        Right (s, (pos,c,bs,inp__))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,bs,inp__)+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of+                  state__@(AlexState{}) -> Right (state__, ())++alexError :: String -> Alex a+alexError message = Alex $ const $ Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())++++++++++alexMonadScan = do+  inp__ <- alexGetInput+  sc <- alexGetStartCode+  case alexScan inp__ sc of+    AlexEOF -> alexEOF+    AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+    AlexSkip  inp__' _len -> do+        alexSetInput inp__'+        alexMonadScan+    AlexToken inp__' len action -> do+        alexSetInput inp__'+        action (ignorePendingBytes inp__) len++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int -> Alex result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip _input _len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code _input _len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input__ len = do+  alexSetStartCode code+  action input__ len++token :: (AlexInput -> Int -> token) -> AlexAction token+token t input__ len = return (t input__ len)++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.+++++++++++++++alex_tab_size :: Int+alex_tab_size = 8+alex_base :: Array Int Int+alex_base = listArray (0 :: Int, 104)+  [ -8+  , -58+  , -73+  , 0+  , 40+  , 0+  , 168+  , 296+  , 552+  , 488+  , 0+  , 734+  , -39+  , 697+  , -31+  , -86+  , -38+  , 746+  , 0+  , 731+  , 951+  , 1035+  , 1119+  , 1203+  , 1287+  , 1371+  , 1455+  , 1539+  , 1623+  , 1707+  , 1791+  , 1875+  , -42+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , -103+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 712+  , -34+  , 0+  , -40+  , 0+  , -33+  , 0+  , 0+  , 0+  , -22+  , 0+  , 0+  , 0+  , 1950+  , 2025+  , 2102+  , 2112+  , 2134+  , 0+  , 2166+  , 2250+  , 2334+  , 2418+  , 2502+  , 2586+  , 2670+  , 2754+  , 2838+  , 2922+  , 3006+  , 3090+  , 3174+  , 3258+  , 3342+  , 3426+  , 3510+  , 3594+  , 3678+  , 3762+  , 3846+  , 3930+  , 4014+  , 4098+  , 4182+  , 4266+  , 4350+  , 4434+  , 4518+  , 4602+  , 4677+  , 4752+  , 4827+  , 4902+  , 4977+  , 5052+  , 5127+  , 5202+  ]++alex_table :: Array Int Int+alex_table = listArray (0 :: Int, 5457)+  [ 0+  , 17+  , 17+  , 44+  , 13+  , 17+  , 13+  , 41+  , 39+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 43+  , 33+  , 42+  , 37+  , 18+  , 17+  , 1+  , 11+  , 47+  , 45+  , 0+  , 14+  , 0+  , 55+  , 56+  , 52+  , 50+  , 34+  , 51+  , 15+  , 53+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 16+  , 35+  , 48+  , 32+  , 49+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 101+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 104+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 59+  , 36+  , 60+  , 0+  , 81+  , 54+  , 81+  , 81+  , 79+  , 77+  , 85+  , 81+  , 76+  , 81+  , 95+  , 81+  , 81+  , 71+  , 81+  , 81+  , 81+  , 84+  , 81+  , 70+  , 81+  , 86+  , 81+  , 75+  , 81+  , 81+  , 81+  , 81+  , 57+  , 40+  , 58+  , 9+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 2+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 7+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 8+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 17+  , 17+  , 38+  , 0+  , 17+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 66+  , 0+  , 81+  , 0+  , 0+  , 46+  , 0+  , 0+  , 0+  , 0+  , 17+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 8+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 10+  , 9+  , 7+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 3+  , 2+  , 6+  , 5+  , 5+  , 5+  , 4+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 64+  , 0+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 63+  , 64+  , 64+  , 64+  , 64+  , 64+  , 64+  , 64+  , 64+  , 64+  , 64+  , 0+  , 12+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 12+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 65+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 12+  , 0+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 12+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 19+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 20+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 25+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 30+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 96+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 94+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 69+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 93+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 91+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 90+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 89+  , 81+  , 81+  , 81+  , 82+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 88+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 87+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 83+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 80+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 78+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 74+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 73+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 72+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 92+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 68+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 67+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 31+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 28+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 27+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 26+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 24+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 23+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 22+  , 81+  , 81+  , 81+  , 81+  , 29+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 0+  , 0+  , 0+  , 0+  , 81+  , 0+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 21+  , 81+  , 81+  , 81+  , 81+  , 81+  , 81+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 61+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 62+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 97+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 98+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 103+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 100+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 102+  , 0+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 99+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 102+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  , 0+  ]++alex_check :: Array Int Int+alex_check = listArray (0 :: Int, 5457)+  [ -1+  , 9+  , 10+  , 61+  , 43+  , 13+  , 45+  , 38+  , 94+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , 61+  , 58+  , 124+  , 62+  , 45+  , 32+  , 33+  , 34+  , 61+  , 61+  , -1+  , 38+  , -1+  , 40+  , 41+  , 42+  , 43+  , 44+  , 45+  , 46+  , 47+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , 58+  , 59+  , 60+  , 61+  , 62+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , 91+  , 92+  , 93+  , -1+  , 95+  , 96+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 123+  , 124+  , 125+  , 191+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 143+  , 144+  , 145+  , 146+  , 147+  , 148+  , 149+  , 150+  , 151+  , 152+  , 153+  , 154+  , 155+  , 156+  , 157+  , 158+  , 159+  , 160+  , 161+  , 162+  , 163+  , 164+  , 165+  , 166+  , 167+  , 168+  , 169+  , 170+  , 171+  , 172+  , 173+  , 174+  , 175+  , 176+  , 177+  , 178+  , 179+  , 180+  , 181+  , 182+  , 183+  , 184+  , 185+  , 186+  , 187+  , 188+  , 189+  , 190+  , 191+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 128+  , 129+  , 130+  , 131+  , 132+  , 133+  , 134+  , 135+  , 136+  , 137+  , 138+  , 139+  , 140+  , 141+  , 142+  , 143+  , 144+  , 145+  , 146+  , 147+  , 148+  , 149+  , 150+  , 151+  , 152+  , 153+  , 154+  , 155+  , 156+  , 157+  , 158+  , 159+  , 160+  , 161+  , 162+  , 163+  , 164+  , 165+  , 166+  , 167+  , 168+  , 169+  , 170+  , 171+  , 172+  , 173+  , 174+  , 175+  , 176+  , 177+  , 178+  , 179+  , 180+  , 181+  , 182+  , 183+  , 184+  , 185+  , 186+  , 187+  , 188+  , 189+  , 190+  , 191+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 128+  , 129+  , 130+  , 131+  , 132+  , 133+  , 134+  , 135+  , 136+  , 137+  , 138+  , 139+  , 140+  , 141+  , 142+  , 143+  , 144+  , 145+  , 146+  , 147+  , 148+  , 149+  , 150+  , 151+  , 152+  , 153+  , 154+  , 155+  , 156+  , 157+  , 158+  , 159+  , 160+  , 161+  , 162+  , 163+  , 164+  , 165+  , 166+  , 167+  , 168+  , 169+  , 170+  , 171+  , 172+  , 173+  , 174+  , 175+  , 176+  , 177+  , 178+  , 179+  , 180+  , 181+  , 182+  , 183+  , 184+  , 185+  , 186+  , 187+  , 188+  , 189+  , 190+  , 191+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 0+  , 1+  , 2+  , 3+  , 4+  , 5+  , 6+  , 7+  , 8+  , 9+  , 10+  , 11+  , 12+  , 13+  , 14+  , 15+  , 16+  , 17+  , 18+  , 19+  , 20+  , 21+  , 22+  , 23+  , 24+  , 25+  , 26+  , 27+  , 28+  , 29+  , 30+  , 31+  , 32+  , 33+  , 34+  , 35+  , 36+  , 37+  , 38+  , 39+  , 40+  , 41+  , 42+  , 43+  , 44+  , 45+  , 46+  , 47+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , 58+  , 59+  , 60+  , 61+  , 62+  , 63+  , 64+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , 91+  , 92+  , 93+  , 94+  , 95+  , 96+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 123+  , 124+  , 125+  , 126+  , 127+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 10+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , 9+  , 10+  , 45+  , -1+  , 13+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 34+  , -1+  , 39+  , -1+  , -1+  , 61+  , -1+  , -1+  , -1+  , -1+  , 32+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 128+  , 129+  , 130+  , 131+  , 132+  , 133+  , 134+  , 135+  , 136+  , 137+  , 138+  , 139+  , 140+  , 141+  , 142+  , 143+  , 144+  , 145+  , 146+  , 147+  , 148+  , 149+  , 150+  , 151+  , 152+  , 153+  , 154+  , 155+  , 156+  , 157+  , 158+  , 159+  , 160+  , 161+  , 162+  , 163+  , 164+  , 165+  , 166+  , 167+  , 168+  , 169+  , 170+  , 171+  , 172+  , 173+  , 174+  , 175+  , 176+  , 177+  , 178+  , 179+  , 180+  , 181+  , 182+  , 183+  , 184+  , 185+  , 186+  , 187+  , 188+  , 189+  , 190+  , 191+  , 192+  , 193+  , 194+  , 195+  , 196+  , 197+  , 198+  , 199+  , 200+  , 201+  , 202+  , 203+  , 204+  , 205+  , 206+  , 207+  , 208+  , 209+  , 210+  , 211+  , 212+  , 213+  , 214+  , 215+  , 216+  , 217+  , 218+  , 219+  , 220+  , 221+  , 222+  , 223+  , 224+  , 225+  , 226+  , 227+  , 228+  , 229+  , 230+  , 231+  , 232+  , 233+  , 234+  , 235+  , 236+  , 237+  , 238+  , 239+  , 240+  , 241+  , 242+  , 243+  , 244+  , 245+  , 246+  , 247+  , 248+  , 249+  , 250+  , 251+  , 252+  , 253+  , 254+  , 255+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 46+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , 69+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 69+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 101+  , -1+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 101+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 39+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , 48+  , 49+  , 50+  , 51+  , 52+  , 53+  , 54+  , 55+  , 56+  , 57+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , 65+  , 66+  , 67+  , 68+  , 69+  , 70+  , 71+  , 72+  , 73+  , 74+  , 75+  , 76+  , 77+  , 78+  , 79+  , 80+  , 81+  , 82+  , 83+  , 84+  , 85+  , 86+  , 87+  , 88+  , 89+  , 90+  , -1+  , -1+  , -1+  , -1+  , 95+  , -1+  , 97+  , 98+  , 99+  , 100+  , 101+  , 102+  , 103+  , 104+  , 105+  , 106+  , 107+  , 108+  , 109+  , 110+  , 111+  , 112+  , 113+  , 114+  , 115+  , 116+  , 117+  , 118+  , 119+  , 120+  , 121+  , 122+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  ]++alex_deflt :: Array Int Int+alex_deflt = listArray (0 :: Int, 104)+  [ -1+  , -1+  , 10+  , 10+  , 3+  , 3+  , -1+  , -1+  , 11+  , 11+  , 11+  , 11+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  , -1+  ]++alex_accept = listArray (0 :: Int, 104)+  [ AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAcc 87+  , AlexAcc 86+  , AlexAcc 85+  , AlexAcc 84+  , AlexAcc 83+  , AlexAcc 82+  , AlexAcc 81+  , AlexAcc 80+  , AlexAcc 79+  , AlexAcc 78+  , AlexAcc 77+  , AlexAcc 76+  , AlexAcc 75+  , AlexAcc 74+  , AlexAcc 73+  , AlexAcc 72+  , AlexAcc 71+  , AlexAcc 70+  , AlexAcc 69+  , AlexAcc 68+  , AlexAcc 67+  , AlexAcc 66+  , AlexAcc 65+  , AlexAcc 64+  , AlexAcc 63+  , AlexAcc 62+  , AlexAcc 61+  , AlexAcc 60+  , AlexAcc 59+  , AlexAcc 58+  , AlexAcc 57+  , AlexAcc 56+  , AlexAcc 55+  , AlexAcc 54+  , AlexAcc 53+  , AlexAcc 52+  , AlexAcc 51+  , AlexAcc 50+  , AlexAcc 49+  , AlexAcc 48+  , AlexAcc 47+  , AlexAcc 46+  , AlexAcc 45+  , AlexAcc 44+  , AlexAcc 43+  , AlexAcc 42+  , AlexAcc 41+  , AlexAcc 40+  , AlexAcc 39+  , AlexAcc 38+  , AlexAcc 37+  , AlexAcc 36+  , AlexAcc 35+  , AlexAcc 34+  , AlexAcc 33+  , AlexAcc 32+  , AlexAcc 31+  , AlexAcc 30+  , AlexAcc 29+  , AlexAcc 28+  , AlexAcc 27+  , AlexAcc 26+  , AlexAcc 25+  , AlexAcc 24+  , AlexAcc 23+  , AlexAcc 22+  , AlexAcc 21+  , AlexAcc 20+  , AlexAcc 19+  , AlexAcc 18+  , AlexAcc 17+  , AlexAcc 16+  , AlexAcc 15+  , AlexAcc 14+  , AlexAcc 13+  , AlexAcc 12+  , AlexAcc 11+  , AlexAcc 10+  , AlexAcc 9+  , AlexAcc 8+  , AlexAcc 7+  , AlexAcc 6+  , AlexAcc 5+  , AlexAcc 4+  , AlexAcc 3+  , AlexAcc 2+  , AlexAcc 1+  , AlexAcc 0+  ]++alex_actions = array (0 :: Int, 88)+  [ (87,alex_action_0)+  , (86,alex_action_1)+  , (85,alex_action_2)+  , (84,alex_action_3)+  , (83,alex_action_4)+  , (82,alex_action_5)+  , (81,alex_action_6)+  , (80,alex_action_7)+  , (79,alex_action_8)+  , (78,alex_action_9)+  , (77,alex_action_10)+  , (76,alex_action_11)+  , (75,alex_action_12)+  , (74,alex_action_13)+  , (73,alex_action_14)+  , (72,alex_action_15)+  , (71,alex_action_16)+  , (70,alex_action_17)+  , (69,alex_action_18)+  , (68,alex_action_19)+  , (67,alex_action_20)+  , (66,alex_action_21)+  , (65,alex_action_22)+  , (64,alex_action_23)+  , (63,alex_action_24)+  , (62,alex_action_25)+  , (61,alex_action_26)+  , (60,alex_action_27)+  , (59,alex_action_28)+  , (58,alex_action_29)+  , (57,alex_action_30)+  , (56,alex_action_31)+  , (55,alex_action_32)+  , (54,alex_action_33)+  , (53,alex_action_34)+  , (52,alex_action_35)+  , (51,alex_action_36)+  , (50,alex_action_37)+  , (49,alex_action_38)+  , (48,alex_action_39)+  , (47,alex_action_40)+  , (46,alex_action_41)+  , (45,alex_action_42)+  , (44,alex_action_43)+  , (43,alex_action_44)+  , (42,alex_action_45)+  , (41,alex_action_46)+  , (40,alex_action_47)+  , (39,alex_action_47)+  , (38,alex_action_48)+  , (37,alex_action_49)+  , (36,alex_action_49)+  , (35,alex_action_49)+  , (34,alex_action_49)+  , (33,alex_action_49)+  , (32,alex_action_49)+  , (31,alex_action_49)+  , (30,alex_action_49)+  , (29,alex_action_49)+  , (28,alex_action_49)+  , (27,alex_action_49)+  , (26,alex_action_49)+  , (25,alex_action_49)+  , (24,alex_action_49)+  , (23,alex_action_49)+  , (22,alex_action_49)+  , (21,alex_action_49)+  , (20,alex_action_49)+  , (19,alex_action_49)+  , (18,alex_action_49)+  , (17,alex_action_49)+  , (16,alex_action_49)+  , (15,alex_action_49)+  , (14,alex_action_49)+  , (13,alex_action_49)+  , (12,alex_action_49)+  , (11,alex_action_49)+  , (10,alex_action_49)+  , (9,alex_action_49)+  , (8,alex_action_49)+  , (7,alex_action_50)+  , (6,alex_action_50)+  , (5,alex_action_50)+  , (4,alex_action_50)+  , (3,alex_action_50)+  , (2,alex_action_50)+  , (1,alex_action_50)+  , (0,alex_action_50)+  ]++{-# LINE 76 "Lexer.x" #-}+++mkL :: LexemeClass -> AlexInput -> Int -> Alex Lexeme+mkL c (p,_,_,str) len = return (L p c (take len str))++data Lexeme = L AlexPosn LexemeClass String+     deriving (Eq, Show)+  +data LexemeClass +   =  L_DATA+   |  L_DERIVING+   |  L_LET+   |  L_IN+   |  L_IF+   |  L_THEN+   |  L_ELSE+   |  L_PREV+   |  L_CURR+   |  L_VAL+   |  L_IS+   |  L_RS+   |  L_GOF+   |  L_EQUAL+   |  L_DBLCOLON  +   |  L_COMMA+   |  L_SEMICOLON+   |  L_BACKSLASH+   |  L_RARROW+   |  L_LARROW+   |  L_DOTHAT+   |  L_PIPE+   |  L_DBLAND+   |  L_DBLOR+   |  L_EQ+   |  L_NE+   |  L_LE+   |  L_GE+   |  L_LT+   |  L_GT+   |  L_PLUS+   |  L_MINUS+   |  L_AST+   |  L_SLASH+   |  L_BACKQUOTE+   |  L_LPAREN  +   |  L_RPAREN  +   |  L_LBRACE  +   |  L_RBRACE  +   |  L_LBRACKET  +   |  L_RBRACKET  +   |  L_IDENT+   |  L_CONSTRUCTOR+   |  L_BOOL+   |  L_INT+   |  L_FLOAT+   |  L_STRING+   |  LEOF+    deriving (Eq, Show)++-- the idea of nested comments is borrowed from an Alex example for Haskell 98:+--  https://github.com/simonmar/alex/blob/master/examples/haskell.x+--+nested_comment :: AlexInput -> Int -> Alex Lexeme+nested_comment _ _ = do+  input <- alexGetInput+  go 1 input+  where go 0 input = do alexSetInput input; alexMonadScan+        go n input = do+          case alexGetByte input of+            Nothing  -> err input+            Just (c,input) -> do+              case chr (fromIntegral c) of+                '-' -> do                     -- checking the end of the commnet ?+                  case alexGetByte input of+                    Nothing  -> err input+                    Just (125,input) -> go (n-1) input+                    Just (c,input)   -> go n input+                '\123' -> do                   -- checking the beginnig of a new comment ?+                  case alexGetByte input of+                    Nothing  -> err input+                    Just (c,input) | c == fromIntegral (ord '-') -> go (n+1) input+                    Just (c,input)   -> go n input+                c -> go n input+        err input = do alexSetInput input; lexError "error in nested comment"  ++lexError s = do+  (p,c,_,input) <- alexGetInput+  alexError (showPosn p ++ ": " ++ s ++ +                   (if (not (null input))+                     then " before " ++ show (head input)+                     else " at end of file"))++scanner str = runAlex str $ do+  let loop i ts = do tok@(L _ cl _) <- alexMonadScan; +                     if cl == LEOF+                        then return (i, reverse ts)+                        else do loop (i+1) (tok:ts)+  loop 0 []++alexEOF = return (L undefined LEOF "")++showPosn (AlexPn _ line col) = show line ++ ':': show col++main = getContents >>=  print . scanner++alex_action_0 =  skip +alex_action_1 =  nested_comment +alex_action_2 =  mkL L_DATA +alex_action_3 =  mkL L_DERIVING +alex_action_4 =  mkL L_LET +alex_action_5 =  mkL L_IN +alex_action_6 =  mkL L_IF +alex_action_7 =  mkL L_THEN +alex_action_8 =  mkL L_ELSE +alex_action_9 =  mkL L_PREV +alex_action_10 =  mkL L_CURR +alex_action_11 =  mkL L_VAL +alex_action_12 =  mkL L_IS +alex_action_13 =  mkL L_RS +alex_action_14 =  mkL L_GOF +alex_action_15 =  mkL L_EQUAL +alex_action_16 =  mkL L_DBLCOLON +alex_action_17 =  mkL L_COMMA +alex_action_18 =  mkL L_SEMICOLON +alex_action_19 =  mkL L_BACKSLASH +alex_action_20 =  mkL L_RARROW +alex_action_21 =  mkL L_LARROW +alex_action_22 =  mkL L_DOTHAT +alex_action_23 =  mkL L_PIPE +alex_action_24 =  mkL L_DBLAND +alex_action_25 =  mkL L_DBLOR +alex_action_26 =  mkL L_EQ +alex_action_27 =  mkL L_NE +alex_action_28 =  mkL L_NE +alex_action_29 =  mkL L_LE +alex_action_30 =  mkL L_GE +alex_action_31 =  mkL L_LT +alex_action_32 =  mkL L_GT +alex_action_33 =  mkL L_PLUS +alex_action_34 =  mkL L_MINUS +alex_action_35 =  mkL L_AST +alex_action_36 =  mkL L_SLASH +alex_action_37 =  mkL L_BACKQUOTE +alex_action_38 =  mkL L_LPAREN +alex_action_39 =  mkL L_RPAREN +alex_action_40 =  mkL L_LBRACE +alex_action_41 =  mkL L_RBRACE +alex_action_42 =  mkL L_LBRACKET +alex_action_43 =  mkL L_RBRACKET +alex_action_44 =  mkL L_BOOL +alex_action_45 =  mkL L_BOOL +alex_action_46 =  mkL L_INT +alex_action_47 =  mkL L_FLOAT +alex_action_48 =  mkL L_STRING +alex_action_49 =  mkL L_IDENT +alex_action_50 =  mkL L_CONSTRUCTOR +{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++alexIndexInt16OffAddr arr off = arr ! off+++++++++++++++++++++alexIndexInt32OffAddr arr off = arr ! off++++++++++++quickIndex arr i = arr ! i+++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (sc)+  = alexScanUser undefined input__ (sc)++alexScanUser user__ input__ (sc)+  = case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++++                                   AlexEOF+      Just _ ->++++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (s)))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++++      case fromIntegral c of { (ord_c) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base + ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if (offset >= (0)) && (check == ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            (-1) -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len + (1)) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (len)+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (len)++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastAcc a input__ (len)+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastSkip input__ (len)+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (sc) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ compiler/Lexer.x view
@@ -0,0 +1,180 @@++{+module Lexer where+import Data.Char (chr)+}++%wrapper "monad"++$digit = 0-9+$lower = [a-z]+$upper = [A-Z]+$space = [\ \t\n\r]+$backslash = \\+$dquote = \"+$notdquote = [^ \" ]++tokens :-+  <0> $space+                   { skip }+  "{-"                          { nested_comment }++  <0> "data"					{ mkL L_DATA }+  <0> "deriving"				{ mkL L_DERIVING }+  <0> "let"						{ mkL L_LET }+  <0> "in"						{ mkL L_IN }+  <0> "if"						{ mkL L_IF }+  <0> "then"					{ mkL L_THEN }+  <0> "else"					{ mkL L_ELSE }+  <0> "prev"					{ mkL L_PREV }+  <0> "curr"					{ mkL L_CURR }+  <0> "val"						{ mkL L_VAL }+  <0> "is"						{ mkL L_IS }+  <0> "rs"						{ mkL L_RS }+  <0> "gof"						{ mkL L_GOF }++  <0> "="						{ mkL L_EQUAL }+  <0> "::"                      { mkL L_DBLCOLON }  +  <0> ","                       { mkL L_COMMA }+  <0> ";"                       { mkL L_SEMICOLON }+  <0> $backslash                { mkL L_BACKSLASH }+  <0> "->"                      { mkL L_RARROW }+  <0> "<-"                      { mkL L_LARROW }+  <0> ".^"                      { mkL L_DOTHAT }+  <0> "|"                       { mkL L_PIPE }++  <0> "&&"                      { mkL L_DBLAND }+  <0> "||"                      { mkL L_DBLOR }+  <0> "=="                      { mkL L_EQ }+  <0> "!="                      { mkL L_NE }+  <0> "/="                      { mkL L_NE }+  <0> "<="                      { mkL L_LE }+  <0> ">="                      { mkL L_GE }+  <0> "<"                       { mkL L_LT }+  <0> ">"                       { mkL L_GT }+  <0> "+"                       { mkL L_PLUS }+  <0> "-"                       { mkL L_MINUS }+  <0> "*"                       { mkL L_AST }+  <0> "/"                       { mkL L_SLASH }++  <0> "`"                       { mkL L_BACKQUOTE }+  <0> "("                       { mkL L_LPAREN }  +  <0> ")"                       { mkL L_RPAREN }  +  <0> "{"                       { mkL L_LBRACE }  +  <0> "}"                       { mkL L_RBRACE }  +  <0> "["                       { mkL L_LBRACKET }  +  <0> "]"                       { mkL L_RBRACKET }  ++  <0> "True"                    { mkL L_BOOL }+  <0> "False"                   { mkL L_BOOL }+  <0> $digit+                   { mkL L_INT }+  <0> $digit+ ("." $digit*)? ([eE] [\-\+]? $digit+)?    { mkL L_FLOAT }+  <0> $dquote $notdquote* $dquote  { mkL L_STRING }++  <0> ($lower|[_]) ($digit|$lower|$upper|[_'])*  { mkL L_IDENT }+  <0> $upper ($digit|$lower|$upper|[_])*  { mkL L_CONSTRUCTOR }++{++mkL :: LexemeClass -> AlexInput -> Int -> Alex Lexeme+mkL c (p,_,_,str) len = return (L p c (take len str))++data Lexeme = L AlexPosn LexemeClass String+     deriving (Eq, Show)+  +data LexemeClass +   =  L_DATA+   |  L_DERIVING+   |  L_LET+   |  L_IN+   |  L_IF+   |  L_THEN+   |  L_ELSE+   |  L_PREV+   |  L_CURR+   |  L_VAL+   |  L_IS+   |  L_RS+   |  L_GOF+   |  L_EQUAL+   |  L_DBLCOLON  +   |  L_COMMA+   |  L_SEMICOLON+   |  L_BACKSLASH+   |  L_RARROW+   |  L_LARROW+   |  L_DOTHAT+   |  L_PIPE+   |  L_DBLAND+   |  L_DBLOR+   |  L_EQ+   |  L_NE+   |  L_LE+   |  L_GE+   |  L_LT+   |  L_GT+   |  L_PLUS+   |  L_MINUS+   |  L_AST+   |  L_SLASH+   |  L_BACKQUOTE+   |  L_LPAREN  +   |  L_RPAREN  +   |  L_LBRACE  +   |  L_RBRACE  +   |  L_LBRACKET  +   |  L_RBRACKET  +   |  L_IDENT+   |  L_CONSTRUCTOR+   |  L_BOOL+   |  L_INT+   |  L_FLOAT+   |  L_STRING+   |  LEOF+    deriving (Eq, Show)++-- the idea of nested comments is borrowed from an Alex example for Haskell 98:+--  https://github.com/simonmar/alex/blob/master/examples/haskell.x+--+nested_comment :: AlexInput -> Int -> Alex Lexeme+nested_comment _ _ = do+  input <- alexGetInput+  go 1 input+  where go 0 input = do alexSetInput input; alexMonadScan+        go n input = do+          case alexGetByte input of+            Nothing  -> err input+            Just (c,input) -> do+              case chr (fromIntegral c) of+                '-' -> do                     -- checking the end of the commnet ?+                  case alexGetByte input of+                    Nothing  -> err input+                    Just (125,input) -> go (n-1) input+                    Just (c,input)   -> go n input+                '\123' -> do                   -- checking the beginnig of a new comment ?+                  case alexGetByte input of+                    Nothing  -> err input+                    Just (c,input) | c == fromIntegral (ord '-') -> go (n+1) input+                    Just (c,input)   -> go n input+                c -> go n input+        err input = do alexSetInput input; lexError "error in nested comment"  ++lexError s = do+  (p,c,_,input) <- alexGetInput+  alexError (showPosn p ++ ": " ++ s ++ +                   (if (not (null input))+                     then " before " ++ show (head input)+                     else " at end of file"))++scanner str = runAlex str $ do+  let loop i ts = do tok@(L _ cl _) <- alexMonadScan; +                     if cl == LEOF+                        then return (i, reverse ts)+                        else do loop (i+1) (tok:ts)+  loop 0 []++alexEOF = return (L undefined LEOF "")++showPosn (AlexPn _ line col) = show line ++ ':': show col++main = getContents >>=  print . scanner+}
+ compiler/Main.hs view
@@ -0,0 +1,211 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++module Main where++import TypeChecker+import Analysis+import Parser hiding (processFile,main)+import Normalization+import ASTData+import ASTTrans+import GenSMT+import Spec++import NtoIR+import IRtoPregel (genCode')++import System.Environment+import System.IO+import System.Process+import System.Timeout+import System.IO.Unsafe++getOpts :: [String] -> IO (Option, [String])+getOpts ags = run defaultOpt [] (if length ags == 0 then ["-h"] else ags)+  where run ops fs [] = return (ops, fs)+        run ops fs (xs:xss) =+         case xs of+           "-h" -> do printHelp()+                      return (ops, [])+           "-oz"  -> do run (ops { zipOpt = True }) fs xss+           "-omz" -> do run (ops { mzFusionOpt = True }) fs xss+           "-opc" -> do run (ops { pcFusionOpt = True }) fs xss++           -- Iwasaki: imported optimizer code of Morihata and Kato+           "-oec" -> do run (ops { elimCommOpt = True }) fs xss+           "-oei" -> do run (ops { elimIdOpt = True }) fs xss+           "-ovh" -> do run (ops { useV2HOpt = True }) fs xss+           "-omc" -> do run (ops { useMsgCombOpt = True }) fs xss+           "-smt" -> do run (ops { useSmt = True }) fs xss+           "-smtpath" -> do let (h:t) = xss+                            run (ops { smtPath = h }) fs t+           "-smtoption" -> do let (h:t) = xss+                              run (ops { smtOption = h }) fs t+           "-smttimeout" -> do let (h:t) = xss+                               run (ops { smtTimeout = read h }) fs t+           "-printsmt" -> do run (ops { printSmt = True }) fs xss+           -- Iwasaki : enabled to output ast, nast, and ir+           "-i"   -> do run (ops { genMode = IROnly }) fs xss+           "-a"   -> do run (ops { genMode = ASTOnly }) fs xss+           "-na"  -> do run (ops { genMode = NASTOnly }) fs xss++           "-g"   -> do run (ops { genMode = Giraph }) fs xss+           "-p"   -> do run (ops { genMode = PregelPlus }) fs xss+           "-o"   -> do let (h:t) = xss+                        run (ops { outputFile = Just h }) fs t+           "-n"   -> do let (h:t) = xss+                        run (ops { normLevel = read h }) fs t+           _      -> if head xs == '-' then+                       do hPutStrLn stderr+                            ("Unknown option " ++ xs ++ " specified, ignored.")+                          run ops fs xss+                     else do run ops (fs ++ [xs]) xss ++printHelp () =+  do mapM_ putStrLn ms+  where+    ms = [ "fregel [options] file ..."+         , "Options:"+         , " -h              show help"+         , " -oz             enable zip-elimination optimization (not completed yet)"+         --   gmap (gzip ... gzip) can be compiled at once into a single phase,+         --     avoiding redundant intermediate data structures (i.e., pairs)+         , " -omz            enable map*zip* fusion"+         --   phases without communication will be executed (fused) in +         , " -opc            enable prev-curr-fusion optimization "+         --   for gmap and gzip, only one of prev and curr is necessary.+         --   in this case, XXX_curr should be replaced with XXX_prev.+         , " -oei            eliminate sending identity values, if possible"+         , " -oec            eliminate communications of the same values, if possible"+         , " -ovh            use voteToHalt, if possible"+         , " -omc            use message combiner (Pregel+ only)"+         , " -smt            use Z3 solover when -oec/-ovh are specified"+         , " -smtpath path   specify the path of Z3 solver (default is /usr/local/bin/z3)"+         , " -smtoption opt  specify options given to Z3 solver (default is \"-smt2 -in\")"+         , " -smttimeout t   specify the timeout of Z3 smt solver (default is 5*10^6)"+         , " -printsmt       print programs for Z3 smt solver"+         , " -n N            set normalziation level to |N| (1--10), and"+         , "                 produce the normalized Fregel program (with types when N < 0)"+         , " -i              generate IR"+         , " -a              generate AST"+         , " -na             generate Normalzed AST"+         , " -g              generate Giraph code (default)"+         , " -p              generate Pregel+ code"+         , " -o file         output to a specified file"+         ]++main :: IO ()+main = do ags <- getArgs+          (ops, files) <- getOpts ags+          mapM_ (processFile ops) files++processFile ops file =+  do asts <- parseFile'' file+     let asts' = map topoSortOnly asts --you need to do topological sort!!!!+     let asts2' = if elimIdOpt ops then map transIdElim asts' else asts'+     -- mapM_ putStrLn $ ppProgramSpec (head asts2')+     -- put the type information into asts2' by using typing0.+     let asts2 = map (fst . typing0) asts2'+     let sfnss = map collectVCStepfns asts2 -- type of sfns is [[PregelStepfn]]+     -- ppp "sfnss = " `seq` ppp sfnss `seq` putStrLn "Hello\n"+     stepfns3 <- if elimCommOpt ops && useSmt ops then+                   mapM (applySMTOpt+                           "elimCommOpt" ops (const True) genCommElimSpec id)+                        (zip sfnss asts2)+                 else if useSmt ops then+                   return $ mapM (map (\sfn -> (sfn, False))) sfnss+                 else return (take (length asts2) (repeat []))+                 -- else return []+     -- putStrLn ("stepfns3 = " ++ show stepfns3)+     let asts3 = asts2+     -- mapM_ putStrLn $ ppProgramSpec (head asts3)+     stepfns4 <- if useV2HOpt ops && useSmt ops then+                   mapM (applySMTOpt+                           "voteToHaltOpt" ops isTermFix genInactivateSpec id)+                        (zip sfnss asts3)+                 else if useSmt ops then+                   return $ map (map (\sfn -> (sfn, False))) sfnss+                 else return (take (length asts3) (repeat []))+                 -- else return []+     -- putStrLn ("stepfns4 = " ++ show stepfns4)+     let asts4 = asts3+     let sfss = zipWith (zipWith mg) stepfns3 stepfns4+                where mg ((name,_,_,_,_),ec) (_,vh) = (name, ec, if ec then vh else False)+     -- putStrLn ("sfss = " ++ show sfss)+     let pregelFiles = concat (zipWith run asts4 sfss)+           where run ast sfs =+                   let nn = normLevel ops+                       n = if nn < 0 then -nn else nn+                   in if n < numNormStages - 1 then+                        [(if nn < 0 then pptprintStr' else ppprintStr')+                           n (fst (normalizationX (n+2) ast ops))]+                      else if n == numNormStages - 1 then+                             [printNStr' (normalizationAll' ast ops)]+                      else genCode' ast (normalizationAll' ast ops) ops sfs+     mapM_ (uncurry writeFile) pregelFiles+  where isTermFix (_, _, _, DTermF _, _) = True+        isTermFix _ = False++{-+applySMTOpt s ops gen trans (sfns, pr) =+  let DProgramSpec _ (DProg _ gdefs _ _) _ = pr+  in do smts <- mapM (invokeSMT s ops gen gdefs) sfns+        let stepfns = zip sfns smts+        return stepfns+-}++-- only stepfns that satisfy `pred' are applied to SMT+applySMTOpt s ops pred gen trans (sfns, pr) =+  do smts <- mapM f sfns+     let stepfns = zip sfns smts+     return stepfns+  where DProgramSpec _ (DProg _ gdefs _ _) _ = pr+        f sfn = if pred sfn then invokeSMT s ops gen gdefs sfn+                else return False++invokeSMT :: String -> Option -> ([DGroundDef a] -> PregelStepfn a -> String)+             -> [DGroundDef a] -> PregelStepfn a -> IO Bool+invokeSMT s ops gen gdefs psf@(name,_,_,_,_) =+  do let ga = gen gdefs psf+     if printSmt ops then putStrLn ga else return ()+     putStr ("Checking " ++ s ++ " for " ++ name ++ " ... ")+     --putStrLn ("input to the solver: \n" ++ ga)+     r <- timeout to $ readProcess solver options ga+     -- putStrLn(show r)+     -- let r = Just "unsat\n"+     let res = case r of Just "unsat\n" -> True+                         Just "sat\n"   -> False+                         Nothing        -> False+     putStrLn ("done. result is " ++ (if res then "unsat" else "sat"))+     return res+     {-+     case r of Just "unsat\n" -> return True+               Nothing        -> return False+     -}+  where to = smtTimeout ops    -- (5 * 10^6)+        -- for Ubutnu, do "sudo apt-get install z3", and set the path:+        -- smtSolver = "/usr/bin/z3"+        solver = smtPath ops -- "c:/cygwin64/home/fooofo/z3/bin/z3.exe"+        options = words (smtOption ops)  --  ["-smt2", "-in"]++{-+:l Main.hs+ast <- parseFile' "ds_maptest.fgl"+ppprint ast+let nrm = normalizationAll ast++--- crashes during the generation of "dsmapMain.java"++let ast1 = fst (dependencyC 1 ast)+ppprint ast1+let ast2 = typing ast1+ppprint ast2++let nrm = normalizationAll ast++:l Main.hs+ast <- parseFile' "ziptest.fgl"+ppprint ast+let nrm = normalizationAll ast++-}
+ compiler/Makefile view
@@ -0,0 +1,36 @@+HSFILES = ASTData.hs \+          ASTTrans.hs \+          AggregatorExtraction.hs \+          Analysis.hs \+          Convert0.hs \+          DependencySimple.hs \+          GenSMT.hs \+          IR.hs \+          IRtoPregel.hs \+          Inlining.hs \+          Main.hs \+          Normalization.hs \+          NtoIR.hs \+          Parser.hs \+          Spec.lhs \+          Spec0.hs \+          TypeChecker.hs \+          TypeInstantiation.hs \+          VCOutputNormalization.hs++all: fregel++fregel: Main+	cp Main fregel++Main: ${HSFILES}+	ghc --make Main++clean:+	rm -f *.o *.hi *~ *.dyn_hi *.dyn_o Main++Parser.hs: Parser.y+	happy $<++Lexer.hs: Lexer.x+	alex $<
+ compiler/Normalization.hs view
@@ -0,0 +1,1226 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}+module Normalization where++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++import Spec+import ASTData+import Analysis (dependencyC, topologicalSort)+import TypeChecker (typing, unify, apply, buildVertCompEnv, buildProgEnv, typing2', typeCheck)+import Inlining (runInlining)+import AggregatorExtraction (aggExtraction, aggExtractionE)+import TypeInstantiation (runTypeInstantiation)+import DependencySimple (computeDependency)+import VCOutputNormalization (normalizeVertCompRecordOutputExp, normalizeVertCompRecordOutputExp')++{-+++Big-step normalization. See ICFP paper.++We can make a small-step normalization (by fusion/tupling/...), but leads to inefficient code (or difficult-to-be-optimized code).++This module drives all compilation steps except for code generation: normalizationAll .++The interface to code generators is the data structure named DNormalized.++-}+{-++**********************+Normalized Fregel Code+**********************+A single 'fregel' computation that executes a vertex-computation function (ft_Pi) according to the current 'phase' (i).++ n_fregel NData initPhase [(ft_P1), ..., (ft_Pk)] next stay g++The parameters (types and vertex-computation functions):++  data Phase = P1 | P2 | ... | Pk  # unique names of the phases+  data NData = NData { phase::Maybe Phase,             -- the current phase+                       step::Int,                      -- the number of steps in the current phase+                       data_P1::Pair Bool Data_Pi,     -- the pair of end-flag and data for phase P1+                       ...,                            -- and so on+                       data_Pk::Pair Bool Data_Pi,+                       step_X1::Int,                   -- the number of iterations in the first giter+                       ...,                            -- and so on+                       step_Xl::Int }+  ft_Pi v prev curr :: Pair Bool Data_Pi               -- vertex-computation function for phase Pi+                                                           built by composing the initialization func.,+                                                           step funct. and termination judgement func.+                                                           of the phase.+  initPhase :: Phase                                   -- the initial phase+  next :: Phase -> Phase        -- returns the phase to be executed after the given phase terminates +  stay :: Phase -> Phase        -- returns the phase to be executed when the given phase continues +                                -- stay p = p for most phases,+                                --  but for giter phases stay p is the first phase of its internal ones++Implementation:+It executes a vertex-computation function (ft_Pi) according to the current 'phase' (i).+If the termination condition for the current phase is satisfied, then it proceeds to the next phase.++n_fregel NData initPhase [(ft_P1), ..., (ft_Pk)] next stay g+ = let ft v prev curr =+         let d1 = if prev v.^phase == Just P1 then ft_P1 v prev curr else prev v.^data_P1+             ...+             dk = if prev v.^phase == Just Pk then ft_Pk v prev curr else prev v.^data_Pk+             p_end  = if prev v.^phase == Just P1 then curr v.^data_P1.^_fst+                      else if prev v.^phase == Just P2 then curr v.^data_P2.^_fst+                           else ...+                                else if prev v.^phase == Just Pk then curr v.^data_Pk.^_fst+                                     else False+             step' = if6 not (prev v.^phase == Nothing) && prev v.^phase == curr v.^phase then prev v.^step + 1 else 0+             phase' = if p_end then next (prev v.^phase) else stay (prev v.^phase)+             step_X1' = if prev v.^phase == Just X1 then if not p_end then prev v.^step_X1 + 1 else 0 else prev v.^step_X1+             ...+             step_Xl' = if prev v.^phase == Just Xl then if not p_end then prev v.^step_Xl + 1 else 0 else prev v.^step_Xl+         in NData phase' step' d1 ... dk step_X1' ... step_Xl'+       f0 v = NData (Just initPhase) 0 _ ... _+   in fregel f0 ft Fix g++-}+++{---  data structure for Normalized Code (i.e., phase-transition machine)  ---}++type DPhaseID = Int+type DPhase a = (DPhaseID, String, DDefVertComp a, DDefVertComp a, DDefVertComp a)+   -- Each phase is represented by ID, label, initialization function, step function, and terminatino judgement function+type DPhaseGraph a = [(DPhaseID, [([DField a], DPhaseID)])]  -- this is currently used to represent the stay and next functions: [ (p, [([], stay p), ([], next p)]) | p in all_phases ]. In general, this was indended to represent dependencies among phases and the list [DField a] was used to remember the ways of dependencies.++data DNormalized a = DNormalized+                         String          -- the original program (function) name+                         [DPhaseID]      -- giter phases (these will have their own iteration counters)+                         [DRecordSpec a] -- user-defined records+                         (DRecordSpec a, [DPhaseID]) -- NData (vertex data + phase info.) and corresponding phase IDs+                         --TODO: (DRecordSpec a, [DPhaseID], DPhaseID) -- NData (vertex data + phase info.) and corresponding phase IDs and the phase of the final result (>=0 or -1 for N.A.)+                         [DPhase a]      -- all phases+                         (DPhaseGraph a) -- dependencies among phases (currently, stay and next funcs.)+                         [DPhaseID]      -- the initial phases (currently, only one)+                         [DSmplDef a]    -- global definitions (such as constants)+                         deriving (Eq, Show)++-- the big-step normalization to build data representing the n_fregel program.           +makeNormalizedData :: (DProgramSpec DASTData, DUnique) -> DNormalized DASTData+makeNormalizedData (p, uid) = +    let s = runExtractGV (p, uid)+        (DProgramSpec rs (DProg f defs _ _) a) = p+        fn = getName f+        daNew = DASTData (newDataType fn) []+        c = (DConstructor (newDataTypeName fn) daNew)+        daInt = (DASTData typeDTInt [])+        phaseSystemData = [(DField (fieldPhase fn) daInt, DTInt daInt), (DField (fieldStep fn) daInt, DTInt daInt)]+        iterCounters = map (\n -> (DField (mkStep n) daInt, DTInt daInt)) (iters s)+        sortWithCurr' = sortWithCurr (map extractFields rs)+        mkPhase (i::Int, (n, t, _, _, (f1, f2, f3))) = +            let phaseDataFieldName = mkField n+            in (i, n, sortWithCurr' [phaseDataFieldName, "_snd"] f1, sortWithCurr' [phaseDataFieldName, "_snd"] f2, sortWithCurr' [phaseDataFieldName, "_fst"] f3)+        graphVarsWithIds = zip [0..] (reverse $ head $ vars s) -- this assigns phase IDs+        phases = map mkPhase graphVarsWithIds+        fsWithIds = map (\(pid, (n, t, _, _, _)) -> let da = (DASTData t []) in ((DField (mkField n) da, buildTypeAST (typePair [typeDTBool, t])), pid)) graphVarsWithIds+        newDataFiledsWithIds = map (\x -> (x, -1)) phaseSystemData++fsWithIds++map (\x -> (x, -1)) iterCounters+        fs = map fst newDataFiledsWithIds -- fields of NData+        ps = map snd newDataFiledsWithIds -- phase ID of each field in NData+        newData = DRecordSpec c fs daNew+        idmap = map (\(i::Int, n::DVarName, _, _, _) -> (n, i)) phases+        lookupId nm = let (Just i) = lookup nm idmap in i+        initPhase = lookupId (maybe (error "something wrong") (\a -> a) $ initVar s)+        defs' = map (\(DGDefSmpl def _) -> def) $ filter (isSmplDef) defs+        deps = map (\(v, _, n, s, _) -> (lookupId v, [([], lookupId s)] ++ if n == "" then [] else [([], lookupId n)])) (reverse $ head $ vars s) +        is = map (\g -> lookupId g) $ iters s+    in DNormalized fn is rs (newData, ps) phases deps [initPhase] defs'++-- misc functions for the big-step normalizer+       +extractFields :: DRecordSpec a -> (String, [String])+extractFields (DRecordSpec (DConstructor c _) fts _) = (c, map (\(DField f _, _) -> f) fts)++buildTypeAST (t@(DTypeTerm "Int" [])) = DTInt (DASTData t [])+buildTypeAST (t@(DTypeTerm "Bool" [])) = DTBool (DASTData t [])+buildTypeAST (t@(DTypeTerm "String" [])) = DTString (DASTData t [])+buildTypeAST (t@(DTypeTerm "Double" [])) = DTDouble (DASTData t [])+buildTypeAST (t@(DTypeTerm "(,)" ts)) = DTTuple (map buildTypeAST ts) (DASTData t [])+buildTypeAST (t@(DTypeTerm c ts)) = DTRecord (DConstructor c (DASTData t [])) (map buildTypeAST ts) (DASTData t [])++buildTypeAST (t) = error ("Unknown situation in buildTypeAST: " ++ show t)++isSmplDef (DGDefSmpl def a) = True+isSmplDef _ = False++newDataTypeName fn = "NData_"++ fn+fieldPhase fn = "phase_"++fn+fieldStep fn = "step_"++fn+newDataType fn = typeSolid (newDataTypeName fn)+mkField gx = "data_"++gx+mkStep gx = "step_"++gx++                                                                             +findInputGraphType (DProgramSpec _ p _) = let (DTypeTerm _ (igt:_)) = typeOf (getData p)+                                          in igt++getRecordsSpecs = do s <- get+                     return (recordsSpecs s)+                                             +-- extracting graph variables to collect information to build the phase-transition machine+runExtractGV ((p@(DProgramSpec rs (DProg f defs e af) a)), uid)+    = let igt = (findInputGraphType p)+          (_, s) = runState (extractGV p) (DEnvGV [] [] [] Nothing defs igt [] (getName f) uid rs)+      in s { groundDefs = [] }++-- the state: the data collected during the extraction+data DEnvGV = DEnvGV { vars :: [Chain],                   -- a stack of chains under extracting+                       iters :: [DVarName],               -- giter labels+                       loops :: [(DVarName, Chain)],      -- a graph function = a chain+                       initVar :: Maybe DVarName,         -- the entry point (initial phase)+                       groundDefs::[DGroundDef DASTData], -- static: definitions of graph functions (used to lookup their input graph names)+                       inputGraphType::DTypeInfo,         -- static: the input graph type (of the whole computation)+                       typeInfoOf :: [(DVarName, DTypeInfo)], -- types of labels found so far +                       theProgName :: DVarName,           -- static: the program name+                       uniqId :: Int,                     -- uniq id...+                       recordsSpecs :: [DRecordSpec DASTData] -- record specs.+                     } deriving (Eq)++instance (Show DEnvGV) where+    show (DEnvGV vs is _ iv _ igt tis fn uid rs) = unlines (["Program: " ++ fn] ++ vss++[iterss, ivs, igts, tiss])+        where iterss = "iters = " ++ show is+              ivs = "initVar = " ++ show iv+              tiss = "Types = " ++ prettyShow tis ++ " --EndOfTypes"+              igts = "inputGraphType = " ++ show igt+              vss = concatMap showVars (concat vs)+              showVars (v, t, n, s, (fi, ft, fp)) = ["Phase: " ++ v, "Type: " ++ prettyShow t, "Next: " ++ n, "Stay: " ++ s] ++ ppDefVertComp fi ++ ppDefVertComp ft ++ ppDefVertComp fp+++-- the triplet for a phase: initilization, step and judgement functions+type PhaseFunctions = (DDefVertComp DASTData, DDefVertComp DASTData, DDefVertComp DASTData)++-- list of (phase label (= graph var. name), type, next, stay, the triplet)+-- a chain = a graph function+type Chain = [(DVarName, DTypeInfo, DVarName, DVarName, PhaseFunctions)]+nameOf (v, t, n, s, fs) = v++-- accessors to the state+setProgName fn = do env <- get+                    put (env {theProgName = fn})++getProgName = do env <- get+                 return (theProgName env)++getUid :: State DEnvGV DUnique+getUid = do env <- get+            return (uniqId env)++setUid uid = do env <- get+                put (env { uniqId = uid })++getInputGraphType :: State DEnvGV DTypeInfo+getInputGraphType = do env <- get+                       return (inputGraphType env)++-- update the next phase of the head of the given chain to the given var+updateHead v' [] = []+updateHead v' ((v, t, n, s, fs):xs) = (v, t, v', s, fs):xs++getDefs :: State DEnvGV [DGroundDef DASTData]+getDefs = do env <- get+             return (groundDefs env)++addTypeInfo v t = +    do env <- get+       put (env {typeInfoOf = (v, t):(typeInfoOf env)})++-- adds a new var to the current chain+addVar v = addVar' v (getName v)++addVar' :: DVar DASTData -> String -> PhaseFunctions -> State DEnvGV ()+addVar' v stay fs = +    do env <- get+       let vs = head $ vars env+           vss = tail $ vars env+           types = typeInfoOf env+           label = getName v+           theType = getVertexType (typeOf (getData v))+           env' = env { vars = (([(label, theType, "", stay, fs)] ++ updateHead (getName v) vs) : vss), typeInfoOf = (label, theType) :types }+       if length (vars env') == 1 && initVar env' == Nothing then put (env' { initVar = Just (getName v) } ) else put env'++-- starts a new chain of graph vars+newVarChain :: State DEnvGV ()+newVarChain = do env <- get+                 put ( env { vars = []:vars env } )++-- pops the current chain+popVarChain :: State DEnvGV Chain+popVarChain = do env <- get+                 put (env { vars = tail (vars env) })+                 return (head $ vars env)++-- save a chain to be used later to make a loop by iter+saveChain :: DFun DASTData -> Chain -> State DEnvGV ()+saveChain f chain = do env <- get+                       put (env { loops = (getName f, chain) : loops env })++-- remove the chain indexed by f+removeChain :: DFun DASTData -> State DEnvGV ()+removeChain f = do env <- get+                   put (env { loops = filter (\(n, _) -> not (n == getName f)) (loops env)})++-- find the chain indexed by f+findChain :: DFun DASTData -> State DEnvGV Chain+findChain f = do env <- get+                 case lookup (getName f) (loops env) of+                   Nothing -> error "something wrong with dependency info.?"+                   Just chain -> do removeChain f --single use+                                    return chain+-- combination of find/remove+popChain :: DFun DASTData -> State DEnvGV Chain+popChain f = do chain <- findChain f+                removeChain f+                return chain++-- replacing the argument graph name of a graph function (a chain) with the actual input graph name+replaceInputGraphName gi gx (v, t, n, s, (f0, ft, fj)) +    = let f0' = repVC f0+          ft' = repVC ft+          fj' = repVC fj+          --TODO: update dep+          repVC (DDefVertComp f defs e a) = +              let defs' = map repD defs+                  e' = rec e+              in DDefVertComp f defs' e' a+          repD (DDefVar v [] e a) = +              let e' = rec e in DDefVar v [] e' a+          repD (DDefTuple vs [] e a) = +              let e' = rec e in DDefTuple vs [] e' a+      in (v, t, n, s, (f0', ft', fj')) +  where+    rec (DIf p t e a) = +        let p' = rec p+            t' = rec t+            e' = rec e+        in (DIf p' t' e' a)+    rec (DTuple es a) =+        let es' = map rec es +        in (DTuple es' a)+    rec (DFunAp f es a) =+        let es' = map rec es+        in (DFunAp f es' a)+    rec (DConsAp c es a) =+        let es' = map rec es+        in (DConsAp c es' a)+    rec ((DFieldAcc t fs a)) = +        let fs' = map repF fs+        in DFieldAcc t fs' a+    rec (x@(DFieldAccE e fs a)) = x+    rec (DAggr a' e g es a) =+        let e'  = rec e+            es' = map rec es+        in (DAggr a' e' g es' a)+    rec (x@(DVExp (DVar v av) a)) = x+    rec (x@(DCExp c a)) = x+    repF (DField f a) = DField (if f == f_gi then f_gx else f) a+    f_gi = mkField gi+    f_gx = mkField gx+    +-- for iter-label v, closing the chain of f and adding the label as the last in the current chain+addClosedChain v f e types = +    do chain <- popChain f+       defs <- getDefs+       let chain' = updateHead (getName v) chain+           (Just (DGDefGF (DDefGraphFun _ gi _ _ _) _)) = lookupBy getName (getName f) defs+           chain'' = map (replaceInputGraphName (getName gi) (getName v)) chain+       env <- get+       let vs = head $ vars env+           vss = tail $ vars env+           startOfChain = nameOf $ last chain''+           env' = env { vars = (chain'' ++ updateHead (getName v) vs) : vss } -- add the chain+       put env'+       fn <- getProgName+       fs <- (buildFunctions fn e v types defs)+       addVar' v startOfChain fs++-- adds an iter label+addIter v = do env <- get+               let env' = env { iters = getName v : iters env }+               put env'++getTypeInfo :: State DEnvGV [(DVarName, DTypeInfo)]+getTypeInfo = do env <- get+                 return (typeInfoOf env)++-- visitor to extract graph variables (build chains) +class GraphVarExtractable a where+    extractGV :: a -> State DEnvGV ()++instance GraphVarExtractable (DProgramSpec DASTData) where+    extractGV (DProgramSpec rs p a) = extractGV p++instance GraphVarExtractable (DProg DASTData) where+    extractGV (DProg f defs e a) = +        do newVarChain+           mapM_ extractGV defs++instance GraphVarExtractable (DGroundDef DASTData) where+    extractGV (DGDefVC d a) = return ()+    extractGV (DGDefVI d a) = return ()+    extractGV (DGDefSmpl d a) = return ()+    extractGV (DGDefGV d a) = extractGV d+    extractGV (DGDefGF d a) = extractGV d++instance GraphVarExtractable (DDefGraphVar DASTData) where+    extractGV (DDefGraphVar v e a) = +        do types' <- getTypeInfo+           let types = types' ++ [(getName v, getVertexType (typeOf a))]+           --trace (getName v ++ "is being processed with types = "++show types) $+           case e of +             (DGIter f0 ft x g _) -> do addClosedChain v ft e types+                                        addIter v+             otherwise            -> do defs <- getDefs+                                        fn <- getProgName+                                        fs <- (buildFunctions fn e v types defs)+                                        addVar v fs++------------------- substitutions to build the triplet ------------------                      +-- for ft/f0+sigma fn go gi types typeVofG typeEofG = recToFieldAcc replace +  where+    replace (DFieldAcc (x@(DPrev v av)) fs a) = +        let (av', fs') = addField go fs a av types fn+            v' = setData ((getData v) { typeOf = typeGraph [typeVofG, typeEofG]}) v+        in DFieldAcc (DPrev v' av') fs' a+    replace (DFieldAcc (x@(DCurr v av)) fs a) = +        let (av', fs') = addField go fs a av types fn+            v' = setData ((getData v) { typeOf = typeGraph [typeVofG, typeEofG]}) v+        in DFieldAcc (DCurr v' av') fs' a+    replace (y@(DFieldAcc (x@(DVal v av)) fs a)) =+        if gi == "g" then y else let (av', fs') = addField gi fs a av types fn+                                 in DFieldAcc (DPrev v av') fs' a++-- for ft/f0 with gzip-elimination optimization: field accessors will be replaced.+sigmaZ gez fn go types typeVofG typeEofG = recToFieldAcc replace +  where+    replace (DFieldAcc (x@(DPrev v av)) fs a) = +        let (av', fs') = addField go fs a av types fn+            v' = setData ((getData v) { typeOf = typeGraph [typeVofG, typeEofG]}) v+        in DFieldAcc (DPrev v' av') fs' a+    replace (DFieldAcc (x@(DCurr v av)) fs a) = +        let (av', fs') = addField go fs a av types fn+            v' = setData ((getData v) { typeOf = typeGraph [typeVofG, typeEofG]}) v+        in DFieldAcc (DCurr v' av') fs' a+    replace (y@(DFieldAcc (x@(DVal v av)) fs a)) =+        case isIncompleteAccess fs gez of+          Nothing -> addFieldZ gez fs a av types fn v+          Just rest -> buildPairExpression v rest -- needs to build a pair locally here.                                 +    buildPairExpression v (DGVar gv a)+        = let tv = getVertexType (typeOf a)+              dummy = DASTData tv []+              (av', fs') = addField (getName gv) [] dummy dummy types fn+          in DFieldAcc (DPrev v av') fs' (DASTData tv []) -- TODO: add dependency data...+    buildPairExpression v (DGZip ge1 ge2 a)+        = let pe1 = buildPairExpression v ge1+              pe2 = buildPairExpression v ge2+              t1 = getVertexType (getType ge1)+              t2 = getVertexType (getType ge2)+              pt = typePair [t1, t2]+              a' = DASTData pt [] -- TODO: add dependency data...+              ac = DASTData (typeFunction [t1, t2, pt]) [] +          in expConstructor' "Pair" [pe1, pe2] ac a'+                                     +isIncompleteAccess [] (gez@(DGZip _ _ _)) = Just gez  --needs to build a pair locally!+isIncompleteAccess [] _ = Nothing+isIncompleteAccess (f:fs) (ge@(DGZip ge1 ge2 a))+    = case f of DField "_fst" _ -> isIncompleteAccess fs ge1 +                DField "_snd" _ -> isIncompleteAccess fs ge2+                otherwise -> error ("why " ++ show f ++ " to access " ++ show ge)+isIncompleteAccess (f:fs) _ = Nothing++-- for Until (\g- > e)+sigma' fn gx types typeVofG typeEofG = recToFieldAcc replace +  where+    replace (y@(DFieldAcc (x@(DVal v av)) fs a)) = +        let (av', fs') = addField gx fs a av types fn+        in DFieldAcc (DCurr v av') fs' a++addField gx fs a av types fn = (av', fs')+        where t2 = typePair [typeDTBool, t1]+              t1 = case lookup gx types of (Just x) -> x; Nothing -> error ("why? " ++ gx ++ " is not found in " ++ show types)+              a2 = a { typeOf = t2 }+              a1 = a { typeOf = t1 }+              fs' = [ DField (mkField gx) a2 , DField "_snd" a1 ] ++ fs+              av' = av { typeOf = newDataType fn }++addFieldZ gez fs0 a av types fn v = DFieldAcc (DPrev v av') fs' a+        where (fs, gx) = downToGVar fs0 gez+              t2 = typePair [typeDTBool, t1]+              t1 = case lookup gx types of (Just x) -> x; Nothing -> error ("why? " ++ gx ++ " is not found in " ++ show types)+              a2 = a { typeOf = t2 }+              a1 = a { typeOf = t1 }+              fs' = [ DField (mkField gx) a2 , DField "_snd" a1 ] ++ fs+              av' = av { typeOf = newDataType fn }++downToGVar fs (DGVar gx a) = (fs, getName gx)+downToGVar (f:fs) (DGZip ge1 ge2 a)+    = case f of DField "_fst" _ -> downToGVar fs ge1 +                DField "_snd" _ -> downToGVar fs ge2++                    +recToFieldAcc replace = rec+  where+    rec (DIf p t e a) = +        let p' = rec p+            t' = rec t+            e' = rec e+        in (DIf p' t' e' a)+    rec (DTuple es a) =+        let es' = map rec es +        in (DTuple es' a)+    rec (DFunAp f es a) =+        let es' = map rec es+        in (DFunAp f es' a)+    rec (DConsAp c es a) =+        let es' = map rec es+        in (DConsAp c es' a)+    rec (x@(DFieldAcc t fs a)) = replace x+    rec (x@(DFieldAccE e fs a)) = x+    rec (DAggr a' e g es a) =+        let e'  = rec e+            es' = map rec es+        in (DAggr a' e' g es' a)+    rec (x@(DVExp v a)) = x+    rec (x@(DCExp c a)) = x++applySigma s (DDefVertComp f defs e a) typeVofG typeEofG = +    let defs' = map (applySigmaD s) defs+        e' = s e+        a' = a    -- TODO: type has to be changed because of the change of curr/prev's types+        f' = setData a' f+    in (DDefVertComp f' defs' e' a')++applySigmaD s (x@(DDefVar v [] e a)) = DDefVar v [] (s e) a  -- the type is kept during the rewriting+applySigmaD s (x@(DDefTuple vs [] e a)) = DDefTuple vs [] (s e) a -- the type is kept during the rewriting++delDefs (DDefVertComp f _ e a) = DDefVertComp f [] e a++-- TODO: correct VertComp' type according to the output type of prev/curr?++-------- the triplet builders ----------------------++-- building (the initial function, the step function, the judgement function) for a given graph exrepssion+buildFunctions :: DVarName -> DGraphExpr DASTData -> DVar DASTData -> [(DVarName, DTypeInfo)] -> [DGroundDef DASTData] -> State DEnvGV PhaseFunctions+-- assumption: the argument is GDVar+buildFunctions fn (ge@(DPregel f0 ft x (DGVar g _) af)) v types defs =+    case x of +      (DTermF _)   -> buildFunctionsPregel buildDefsBodyFp fn f0 ft g v types defs+      (DTermI e _) -> buildFunctionsPregel (buildDefsBodyIp e) fn f0 ft g v types defs+      (DTermU e _) -> buildFunctionsPregel (buildDefsBodyUp e) fn f0 ft g v types defs+                      +-- assumption: the argument is GDVar+buildFunctions fn (ge@(DGIter f0 ft x (DGVar g _) af)) v types defs =+    case x of +      (DTermF _)   -> buildFunctionsIter buildDefsBodyFi fn f0 ft g v types defs+      (DTermI e _) -> buildFunctionsIter (buildDefsBodyIi e) fn f0 ft g v types defs +      (DTermU e _) -> buildFunctionsIter (buildDefsBodyUi e) fn f0 ft g v types defs +                      +-- assumption: the argument is GDVar+buildFunctions fn (ge@(DGMap f0 (DGVar g _) af)) v types defs =+    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           theType = lookupType label types+           s = sigma fn label (getName g) types typeVofG typeEofG+           f0' = let (Just (DGDefVI (DDefVertInit f defs' e af) a)) = lookupBy getName (getName f0) defs in DDefVertComp f defs' e af+           body = expBool True -- phase-termination = always true+       xx <- typingForBuildFunctions typeVofG typeEofG theType fn [body] [] []+       let [body'] = xx+           [fj'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, [], body')]   +       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       return (applySigma s f0'' typeVofG typeEofG, applySigma s (delDefs f0'') typeVofG typeEofG {- this is dummy data, removing inner defs to avoid name conflicts -}, fj')++-- assumption: the argument is nested gzips!+buildFunctions fn (ge@(DGMap f0 gez af)) v types defs =+    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           theType = lookupType label types+               -- here, we need better sigma that replaces (_fst|_snd)* with suitable counterparts in gez+           s = sigmaZ gez fn label types typeVofG typeEofG+           f0' = let (Just (DGDefVI (DDefVertInit f defs' e af) a)) = lookupBy getName (getName f0) defs in DDefVertComp f defs' e af+           body = expBool True -- phase-termination = always true+       xx <- typingForBuildFunctions typeVofG typeEofG theType fn [body] [] []+       let [body'] = xx+           [fj'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, [], body')]   +       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       return (applySigma s f0'' typeVofG typeEofG, applySigma s (delDefs f0'') typeVofG typeEofG {- this is dummy data, removing inner defs to avoid name conflicts -}, fj')++-- TODO: implement nested zips... Hmm, the code generator does someting special to gzip case..... pending.+              +-- assumption: the arguments are GDVar+buildFunctions fn (ge@(DGZip (DGVar g1 _) (DGVar g2 _) af)) v types defs =+    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           label1 = getName g1               +           label2 = getName g2+           theType = lookupType label types+           typeGV1 = lookupType label1 types+           typeGV2 = lookupType label2 types+           -- the function body (pairing the values from g1 and g2)+           f0body = expConstructor "Pair" [(expFieldAcc "prev" "v" [mkField label1,"_snd"]), (expFieldAcc "prev" "v" [mkField label2,"_snd"])]+           body = expBool True -- phase-termination = always true+       xx <- {- trace (prettyShow typeG1 ++ "," ++ prettyShow typeG2) $ -} typingForBuildFunctions typeVofG typeEofG theType fn [f0body, body] [(label, theType), (label1, typeGV1), (label2, typeGV2)] []+       let [f0body', body'] = xx+           [fj', f0'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, [], body'), ("_f0", theType, [], f0body')]   +       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       -- Hmm.. using f0'' here causes an error in NtoPregel.hs+       return (f0', delDefs f0' {- this is dummy data, removing inner defs to avoid name conflicts -}, fj')+              +buildFunctions fn (ge@(DGVar g af)) v types defs =+    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           label1 = getName g+           theType = lookupType label types+           typeG1 = lookupType label1 types+           -- the function body (copying the value from g)+           f0body = (expFieldAcc "prev" "v" [mkField label1,"_snd"])+           body = expBool True -- phase-termination = always true+       xx <- typingForBuildFunctions typeVofG typeEofG theType fn [f0body, body] [(label, theType)] [fieldStep fn]+       let [f0body', body'] = xx+           [fj', f0'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, [], body'), ("_f0", theType, [], f0body')]   +       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       return (f0'', delDefs f0'' {- this is dummy data, removing inner defs to avoid name conflicts -}, fj')++-- typing expressions in the given list bs+typingForBuildFunctions typeVofG typeEofG theType fn bs lts sls = +    do let judgeVCEnv = buildJudgeVCEnv typeVofG typeEofG fn lts sls+           typing b = do b' <- typing2'' (judgeVCEnv) b theType+                         return b'+       mapM typing bs+  +typing2'' judgeVCEnv ftbody theType+    = do uid <- getUid+         let ((ftbody', _), uid') = typing2' (judgeVCEnv) ftbody theType uid+         setUid uid'+         return ftbody'+                +-- environment for typing judgment functions and so on.+-- lts is a list of labels used and their types, sls is a list of counters+buildJudgeVCEnv typeVofG typeEofG fn lts sls = +    let testResType = newDataType fn+        extraTB = map (\(l, t) -> (mkField l, typeFunction [testResType, typePair [typeDTBool, t]])) lts ++ map (\sl -> (sl, typeFunction [testResType, typeDTInt])) sls+    in buildVertCompEnv typeVofG typeEofG (DTypeVar "tX") testResType (extraTB ++ buildProgEnv typeVofG typeEofG initEnv)++-- to build functions for giter (termination conditions are dealt with by buildDefsBody)+buildFunctionsIter buildDefsBody fn f0 ft g v types defs =+    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           -- the output graph of ft+           gx = case lookupBy getName (getName ft) defs of+                  (Just (DGDefGF (DDefGraphFun _ _ _ (DGVar go _) _) _)) -> go+                  otherwise -> error ("why doesn't ft has this from?")+           labelX = getName gx+           s = sigma fn label (getName g) types typeVofG typeEofG+           f0' = let (Just (DGDefVI (DDefVertInit f defs' e af) a)) = lookupBy getName (getName f0) defs in DDefVertComp f defs' e af+           theType = lookupType label types+           theTypeX = lookupType labelX types+           -- building the body of ft (in the sense of pregel)+           ftbody = (expFieldAcc "prev" "v" [mkField labelX,"_snd"]) -- copy the output graph+           judgeVCEnv = buildJudgeVCEnv typeVofG typeEofG fn [(labelX, theTypeX), (label, theType)] [mkStep label]+           s' = sigma' fn label types typeVofG typeEofG+       ftbody' <- typing2'' (judgeVCEnv) ftbody theType+       (defs', body') <- buildDefsBody label judgeVCEnv s'+       let [fj', ft'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, defs', body'), ("_ft", theType, [], ftbody')]+           -- this has to be ConsApp (to work with the current NtoPregel.hs )+       ft'' <- normalizeVertCompRecordOutputExp'' ft'+       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       return (applySigma s f0' typeVofG typeEofG, ft'', fj')++normalizeVertCompRecordOutputExp'' ft+    = do uid <- getUid+         rs <- getRecordsSpecs+         let (ft', uid') = normalizeVertCompRecordOutputExp' rs ft uid+         setUid uid'+         return ft'+                                                  +-- to build functions for fregel (termination conditions are dealt with by buildDefsBody)+buildFunctionsPregel buildDefsBody fn f0 ft g v types defs = +    do gt <- getInputGraphType+       let typeVofG = getVertexType gt+           typeEofG = getEdgeType gt+           label = getName v+           s = sigma fn label (getName g) types typeVofG typeEofG+           ft' = let (Just (DGDefVC vc a)) = lookupBy getName (getName ft) defs in vc+           f0' = let (Just (DGDefVI (DDefVertInit f defs' e af) a)) = lookupBy getName (getName f0) defs in DDefVertComp f defs' e af+           -- building the enviroment for the VertexCompute being made+           testResType = newDataType fn+           theType = lookupType label types+           judgeVCEnv = buildJudgeVCEnv typeVofG typeEofG fn [(label, theType)] [fieldStep fn]+           s' = sigma' fn label types typeVofG typeEofG+       (defs', body') <- buildDefsBody fn label judgeVCEnv s'+        -- TODO: dependency data?+       let [fj'] = buildDefVCtyped typeVofG typeEofG theType label [("_judge", typeDTBool, defs', body')]   +       ft'' <- normalizeVertCompRecordOutputExp'' ft'+       f0'' <- normalizeVertCompRecordOutputExp'' f0'+       return  (applySigma s f0'' typeVofG typeEofG, applySigma s ft'' typeVofG typeEofG, fj')++-- for giter: looking the individual counter+buildDefsBodyFi label judgeVCEnv = buildDefsBodyF (mkStep label) label judgeVCEnv+buildDefsBodyIi e label judgeVCEnv = buildDefsBodyI e (mkStep label) label judgeVCEnv+buildDefsBodyUi e label judgeVCEnv = buildDefsBodyU e (mkStep label) label judgeVCEnv++-- for fregel: looking the common step counter+buildDefsBodyFp fn label judgeVCEnv = buildDefsBodyF (fieldStep fn) label judgeVCEnv+buildDefsBodyIp e fn label judgeVCEnv = buildDefsBodyI e (fieldStep fn) label judgeVCEnv+buildDefsBodyUp e fn label judgeVCEnv = buildDefsBodyU e (fieldStep fn) label judgeVCEnv++-- to build judgment function for Fix+-- buildDefsBodyF stepLabel label judgeVCEnv idp vth s = +buildDefsBodyF stepLabel label judgeVCEnv s = +    do let aggV = "agg_"++label+           aggBody = expAggr "and" (expFieldAcc "prev" "u" [mkField label,"_snd"] ^== expFieldAcc "curr" "u" [mkField label,"_snd"]) "tg" []+           body = (((expFieldAcc "prev" "v" [stepLabel]) ^> (expInt 0))) ^&& (expVar aggV)+           -- body = expCheckTerm aggV+       -- typing of the aggregator used in the body of VC+       aggBody' <- typing2'' (judgeVCEnv) aggBody typeDTBool+       -- typing of the body of VC+       body' <- typing2'' ([(aggV, typeDTBool)]++judgeVCEnv) body typeDTBool+       --building the VC+       let defAgg = DDefVar (DVar aggV (DASTData typeDTBool [])) [] aggBody' (DASTData typeDTBool [])+       return ([defAgg], body')+             +-- to build judgment function for Iter+buildDefsBodyI e stepLabel label judgeVCEnv s =+    do let iterV = "iter_"++label+           body = (((expFieldAcc "prev" "v" [stepLabel]) ^== (expVar iterV))) --TODO: step -> step_label+       -- typing of the body of VC+       body' <- typing2'' ([(iterV, typeDTInt)]++judgeVCEnv) body typeDTBool+       --building the VC+       let defV = DDefVar (DVar iterV (DASTData typeDTInt [])) [] e (DASTData typeDTInt [])+       return ([defV], body')++-- to build judgment function for Until+buildDefsBodyU e stepLabel label judgeVCEnv s =+    do uid <- getUid+       let e' = s e+           (e'', defs, uid') = aggExtractionE e' uid+       setUid uid'+       return (defs, e'')++buildDefVCtyped typeVofG typeEofG theType label ntdbs = +    let vertType = typeVertex [typeVofG, typeEofG]+        tblType = typeFunction[typeVertex [(DTypeVar "tY"), typeEofG], theType]+        vcType = typeFunction [vertType, tblType, tblType, typeDTBool]+        vcType' = typeFunction [vertType, tblType, tblType, theType]+        f (n, t, ds, b) = let vcType = typeFunction [vertType, tblType, tblType, t]+                          in defVCtyped (label++n) vcType ds b+    in map f ntdbs++lookupType label types = case lookup label types of (Just x) -> x; Nothing -> error ("why? " ++ label ++ " is not found in " ++ show types)+defVCtyped f t ds b = DDefVertComp (DFun f (DASTData t [])) ds b (DASTData t [])+++instance GraphVarExtractable (DDefGraphFun DASTData) where+    extractGV (DDefGraphFun f v defs e a) = +        do newVarChain          -- starts a new chain+           addTypeInfo (getName v) (getVertexType $ typeOf (getData v)) -- add the type info. of the argument+           mapM_ extractGV defs -- build children's chain+           chain <- popVarChain -- finish the chain+           saveChain f chain    -- save the chain+         +------------ topological sort of bindings in DDefVertComp with taking 'curr' into account --------+--  by analyzing which field of curr depends on what name+--  shallow analysis: no analysis on subexpressions (fields of records) +--  So, the follwoing two programs do the same computation, but+--   let ab = Pair 1 (curr v .^ pval .^ _fst) in Dat ab         is NG (ab depends on ab); +--   let a = 1; b = (curr v .^ pval .^ _fst) in Dat (Pair a b)  is OK ( b depends on a ).++sortWithCurr :: [(String, [String])] -> [String] -> DDefVertComp DASTData -> DDefVertComp DASTData+sortWithCurr fs phaseDataPrefix (x@(DDefVertComp f defs e a)) = res+  where (defs', ok) = topologicalSort (zip3 [0..] deps defs)+        names = map getNames defs+        deps  = map (genDeps (names, rdeps, phaseDataPrefix)) defs+        rdeps = genRecordDeps' fs names e+        res = if ok then DDefVertComp f (map snd defs') e a+              else error ("circular dependency through curr!\n" ++ unlines (ppDefVertComp x))++genRecordDeps :: [DRecordSpec a] -> [[String]] -> DExpr DASTData -> [([String], [Int])]+genRecordDeps rs ns e = genRecordDeps' (("Pair", ["_fst", "_snd"]):map extractFields rs) ns e++--union x y = nub (x++y)+unions = foldr union []+flatDeps depss = [([], unions (concatMap (map snd) depss))] +addDeps deps = map (\(fs, ds) -> (fs, union ds deps))++mergeRDs dt de = union dt de -- correct?++genRecordDeps' :: [(String, [String])] -> [[String]] -> DExpr DASTData -> [([String], [Int])]+genRecordDeps' fs ns e = let ret = rec e in {- trace (show ret) $ -} ret+  where+    rec (DIf p t e _) = +        let [([], deps)] = rec p+            dt = rec t+            de = rec e+            dte = mergeRDs dt de+        in addDeps deps dte -- adding the condition's deps+    rec (DTuple es _) = flatDeps $ map rec es -- conservative: flatterns the dependencies+    rec (DFunAp f es _) = addDeps (findIndex2 ns (getName f)) $ flatDeps $ map rec es -- conservative: flatterns the dependencies+    rec (DConsAp (DConstructor c _) es _) = +        let Just flds = lookup c fs+            des = map rec es+        in concat $ zipWith (\field de -> map (\(fields, deps) -> (field:fields, deps)) de) flds des -- adding the fields of the record +    rec (DFieldAcc (DCurr _ a) fs _) = error "Do not use curr in the last expression of VertexCmopute"+    rec (DFieldAcc _ _ _) = []+    rec (DFieldAccE _ _ _) = []+    rec (DAggr _ e _ es _) = flatDeps $ map rec (e:es) -- conservative: flatterns the dependencies+    rec (DVExp v _) = [([], findIndex2 ns (getName v))]+    rec (DCExp _ _) = []+++class GenDepsable a where+  genDeps :: ([[String]], [([String], [Int])], [String]) -> a -> [Int]++getRdeps (_, rdeps, _) = rdeps+getENames (names, _, _) = names+getPDP (_, _, pdp) = pdp++instance (GenDepsable (DSmplDef a)) where+    genDeps env (DDefFun _ _ [] e _) = genDeps env e+    genDeps env (DDefVar _   [] e _) = genDeps env e+    genDeps env (DDefTuple _ [] e _) = genDeps env e++genDepss env = foldr (\a r -> nub (genDeps env a ++ r)) []++instance (GenDepsable (DExpr a)) where+    genDeps env (DIf p t e _) = nub (genDeps env p ++ (nub (genDeps env t ++ genDeps env e)))+    genDeps env (DTuple es _) = genDepss env es+    genDeps env (DFunAp f es _) = nub (genDeps env f ++ genDepss env es)+    genDeps env (DConsAp _ es _) = (genDepss env es)+    genDeps env (DFieldAcc (DCurr _ a) fs _) = +        let f1:f2:sfs = map getName fs+            -- if [f1, f2] is of the fields that were added during the normalization process to indicate the phase, we have to add dependency. otherwise, no need to add dependency because the order of computation is guaranteed outside the VertexCompute being processed.+            rdeps = getRdeps env+            res = findIndex (\(sfs', _) -> isPrefixOf sfs' sfs) rdeps+        in if [f1, f2] == (getPDP env) +           then case res of +                  Just i -> snd (rdeps!!i)+                  Nothing -> error ("Something wrong! not found " ++ show sfs ++ " in " ++ show rdeps)+           else []+  -- add dependency of the field in the result+    genDeps env (DFieldAcc _ _ _) = []+    genDeps env (DFieldAccE _ _ _) = []+    genDeps env (DAggr _ e _ es _) = (genDepss env (e:es))+    genDeps env (DVExp v _) = genDeps env v+    genDeps env (DCExp _ _) = []++instance (GenDepsable (DVar a)) where+    genDeps env (DVar v _) = findIndex2 (getENames env) v++findIndex2 names v = maybe [] (\i -> [i]) (findIndex (\ns -> maybe False (const True) (findIndex (==v) ns)) names)++instance (GenDepsable (DFun a)) where+    genDeps env (DFun f _) = findIndex2 (getENames env) f+    genDeps env (DBinOp f _) = findIndex2 (getENames env) f++------------------------- driver ------------------------++-- this executes the big-step normalization as well as typechecking and the other transformations+normalizationAll ::Show a =>  DProgramSpec a -> DNormalized DASTData+normalizationAll p = makeNormalizedData (normalization p defaultOpt)++normalizationAll' ::Show a =>  DProgramSpec a -> Option -> DNormalized DASTData+normalizationAll' p ops = makeNormalizedData (normalization p ops)++-- compilation (typechecking and normalization) chain run on the AST+normalization :: Show a => DProgramSpec a -> Option -> (DProgramSpec DASTData, DUnique)+normalization ast ops = normalizationX numNormStages ast ops++-- TODO: K-normlization for graph expressions (at an early stage). currently, the parser does reject.++numNormStages = 11+normalizationX :: Show a => Int -> DProgramSpec a -> Option -> (DProgramSpec DASTData, DUnique)+normalizationX n ast0 ops = +    let uid0 = 1024+        (ast1, uid1) = dependencyC uid0 ast0             -- 1. alpha renaming to unique names, topological sort by dependencies+        ast2 = typing ast1                               -- 2. typechecking+        ast3 = mapData (\(t,(d,_)) -> DASTData t d) ast2 -- 3. restructuring aux. data in the AST+        (ast4, uid4) = runInlining ast3 uid1             -- 4. inlining functions (dependency info. is broken here to make the process simple)+        (ast5, uid5) = aggExtraction ast4 uid4           -- 5. extraction of aggregation expressions+        ast6 = fixInputGraphType ast5                    -- 6. fix the type of input graph+        (ast7, uid7) = runTypeInstantiation ast6 uid5    -- 7. instantiating polymorphic funcs.+        (ast8, uid8) = makeOutputGraphVar ast7 uid7      -- 8. make the output expression to be a graph variable+        (ast9, uid9) = normalizeVertCompRecordOutputExp ast8 uid8 -- 9. make the output expression of a vertex computation function to be a simple constructor application+        astA = computeDependency ast9                    -- 10. updating the dependency info.+        astB = if zipOpt ops then moveGZipsToGMaps astA  -- 11. moving gzips into gmaps (and gzips)+               else astA  +    in ([ast3, ast4, ast5, ast6, ast7, ast8, ast9, astA, astB]!!(n-3), uid9)++-- moving gzips to gmaps so to remove redundant intermediate data about pairing+-- if g = gzip g1 g2 is used only inside a gmap, expand it.+-- assumption: the last expression is a graph variable+-- assumption: k-normalization about graph expressions+moveGZipsToGMaps :: DProgramSpec DASTData -> DProgramSpec DASTData+moveGZipsToGMaps (DProgramSpec rs (DProg f defs e app) ap) = +          let (dgfs, dgvs, ds) = splitGDefs defs+              ginType = getInputType $ getType f+              g = DVar "g" (DASTData (ginType) [])              -- the input is 'g'+              dgvs' = map (\dgv -> DGDefGV dgv (getData dgv)) $ moveZM g (map (\(DGDefGV dgv a) -> dgv) dgvs)  -- moving in the outermost level+              dgfs' = map moveZMinGF dgfs           -- moving in other graph functions+              defs' = ds ++ dgfs' ++ dgvs'+          in DProgramSpec rs (DProg f defs' e app) ap++-- wrapper for moveZM+moveZMinGF (DGDefGF (DDefGraphFun f gin dgvs e a) ap)+           = let dgvs' = moveZM gin dgvs+             in DGDefGF (DDefGraphFun f gin dgvs' e a) ap++-- moving single-use gzips inside gmaps+-- gin is the input graph+-- gvs is a list of graph variable definitions whose rhss are k-normal (no nested expressions).+moveZM :: DVar DASTData -> [DDefGraphVar DASTData] -> [DDefGraphVar DASTData]+moveZM gin gvs = run gvs+    where+      run [] = []+      run (gv:gvs)+          = case gv of +              (DDefGraphVar gn (gez@(DGZip ge1 ge2 a)) a')+                  -> let gnn = getName gn+                         gused = filter (isUsed gnn) gvs+                     in if length gused == 1 && isMapOrZip (head gused)+                        then run (map (expandZip gnn gez) gvs)+                        else gv:run gvs+              otherwise -> gv:run gvs+-- replace variable gnn with gez in ge+expandZip :: String -> DGraphExpr DASTData -> DDefGraphVar DASTData -> DDefGraphVar DASTData+expandZip gnn gez (DDefGraphVar gv ge a) = (DDefGraphVar gv (run ge) a)+    where+      run (DPregel fi fs tc ge a) = (DPregel fi fs tc (run ge) a)+      run (DGMap f ge a) = (DGMap f (run ge) a)+      run (DGZip ge1 ge2 a) = (DGZip (run ge1) (run ge2) a)+      run (DGIter fi fs tc ge a) = (DGIter fi fs tc (run ge) a)+      run (ge@(DGVar (DVar n a) ap)) = if gnn == n then gez else ge+  +                           +isMapOrZip (DDefGraphVar gv (DGMap f ge a) a') = True    +isMapOrZip (DDefGraphVar gv (DGZip ge1 ge2 a) a') = True+isMapOrZip _ = False+                                   +isUsed gn (DDefGraphVar gv ge a) = isUsed' ge+    where +      isUsed' (DPregel fi fs tc ge a) = isUsed' ge+      isUsed' (DGMap f ge a) = isUsed' ge+      isUsed' (DGZip ge1 ge2 a) = isUsed' ge1 || isUsed' ge2+      isUsed' (DGIter fi fs tc ge a) = isUsed' ge+      isUsed' (DGVar (DVar n a) ap) = gn == n+                            +-- dividing a list of definitions into three kinds: graph functions, graph variables, and others+splitGDefs defs = splitGDefs' [] [] [] defs+splitGDefs' dgfs dgvs ds [] = (reverse dgfs, reverse dgvs, reverse ds)+splitGDefs' dgfs dgvs ds ((d@(DGDefGF _ _)):defs) = splitGDefs' (d:dgfs) dgvs ds defs+splitGDefs' dgfs dgvs ds ((d@(DGDefGV _ _)):defs) = splitGDefs' dgfs (d:dgvs) ds defs+splitGDefs' dgfs dgvs ds (d:defs) = splitGDefs' dgfs dgvs (d:ds) defs++       +-- make the last expression to be a variable binding a graph (8th step)+makeOutputGraphVar :: DProgramSpec DASTData -> DUnique -> (DProgramSpec DASTData, DUnique)+makeOutputGraphVar p uid = +    case p of +      (DProgramSpec rs (DProg f defs (DGVar _ _) app) ap) -> (p, uid)+      (DProgramSpec rs (DProg f defs e app) ap) -> +          let ae = (getData e)+              (nv, uid') = genNewName uid "g_v"+              gv = (DVar nv ae)+              def = DGDefGV (DDefGraphVar gv e ae) ae+              defs' = defs++[def]+              e' = DGVar gv ae+          in (DProgramSpec rs (DProg f defs' e' app) ap, uid')++-- fix the input graph type (stupid) (6th step)+fixInputGraphType' :: DTypeInfo -> DTypeInfo -> DProgramSpec DASTData -> DProgramSpec DASTData+fixInputGraphType' tv te p = let gt = typeGraph [tv, te]+                                 pt = getType p+                                 pgt = getInputType pt+                                 s = unify [(gt, pgt)]+                                 p' = mapData (\a -> a {typeOf = apply s (typeOf a)}) p+                             in p'++fixInputGraphType :: DProgramSpec DASTData -> DProgramSpec DASTData+fixInputGraphType p = let pgt = getInputType (getType p)+                      in case pgt of +                              DTypeTerm "Graph" [DTypeVar _, DTypeVar _] -> fixInputGraphType' typeNull typeNull p+                              DTypeTerm "Graph" [DTypeVar _, et]         -> fixInputGraphType' typeNull et p+                              DTypeTerm "Graph" [vt        , DTypeVar _] -> fixInputGraphType' vt typeNull p+                              DTypeTerm "Graph" [vt        , et        ] ->  p+++------------------------- pretty printer with types ------------------++ppprint = putStrLn . unlines . ppProgramSpec -- without types (;++ppprintStr = unlines . ppProgramSpec+ppprintStr' n p = (getPName p ++ "__N" ++ show n ++ ".fgl", ppprintStr p)++pptprintStr :: PrettyPrinterWithType a => a -> String+pptprintStr = unlines . ppt+pptprintStr' n p = (getPName p ++ "__N" ++ show n ++ ".tfgl", pptprintStr p)++                   +getPName (DProgramSpec rs (DProg f defs _ _) a) = getName f        ++pptprint :: PrettyPrinterWithType a => a -> IO ()+pptprint = putStrLn . unlines . ppt++type Misc = DASTData++class PrettyPrinterWithType a where+    ppt :: a -> [String]++instance PrettyPrinterWithType (DProgramSpec Misc) where+    ppt (DProgramSpec rs p _) = concatMap ppt rs ++ ppt p++instance PrettyPrinterWithType (DRecordSpec Misc) where+    ppt r = ppRecordSpec r++instance PrettyPrinterWithType (DProg Misc) where+    ppt (x@(DProg f ds e _)) = [typeSig f ++ dep x, ppFun f ++ " g = "] ++ rest+        where rest = if length ds == 0 then indent (ppt e)+                     else indent $ let_in (concat $ insList ";" "" $ map ppt ds) (ppt e)++typeSig f = ppFun f ++ "::" ++ prettyShow (getType f)+typeSigV v = ppVar v ++ "::" ++ prettyShow (getType v)+typeSigC c = ppConst c ++ "::" ++ prettyShow (getType c)+typeSigCr c = ppConstructor c ++ "::" ++ prettyShow (getType c)++getDepNames x = depOf $ getData x++dep x = "  -- depends on " ++ ppList "," (getDepNames x)++instance PrettyPrinterWithType (DGroundDef Misc) where+    ppt (DGDefVC d _) = ppt d+    ppt (DGDefVI d _) = ppt d+    ppt (DGDefGV d _) = ppt d +    ppt (DGDefGF d _) = ppt d+    ppt (DGDefSmpl d _) = ppt d++instance PrettyPrinterWithType (DDefVertComp Misc) where+    ppt (x@(DDefVertComp f ds e _)) =+        if length ds == 0 then [typeSig f ++ dep x] ++ indentWith (ppFun f ++ " v prev curr = ") (ppt e)+        else [typeSig f ++ dep x] ++ [ppFun f ++" v prev curr = "] ++ indent (let_in (concat $ insList ";" "" $map ppt ds) (ppt e))++instance PrettyPrinterWithType (DDefVertInit Misc) where+    ppt (x@(DDefVertInit f ds e _)) =+        if length ds == 0 then [typeSig f ++ dep x] ++ indentWith (ppFun f ++ " v = ") (ppt e)+        else  [typeSig f ++ dep x] ++ [ppFun f ++" v = "] ++ indent (let_in (concat $ insList ";" "" $map ppt ds) (ppt e))++instance PrettyPrinterWithType (DDefGraphVar Misc) where+    ppt (x@(DDefGraphVar v e _)) =+        [typeSigV v ++ dep x] ++ indentWith (ppVar v ++ " = ") (ppt e)+  ++instance PrettyPrinterWithType (DDefGraphFun Misc) where+    ppt (x@(DDefGraphFun f v ds e _)) =+        if length ds == 0+        then header ++ indent (ppt e)+        else header ++ indent (let_in (concat $ insList ";" "" $ map ppt ds) (ppt e))+            where header = [ typeSig f ++ dep x, ppFun f ++ " " ++ (ppVar v) ++ " = " ]++instance PrettyPrinterWithType (DGraphExpr Misc) where+    ppt (x@(DPregel f0 ft t g _)) =+        ["("++(ppList " " $ ["pregel", ppFun f0, ppFun ft] ++ ppt t ++ ppt g) ++ "::" ++ prettyShow (getType x)++")"]+    ppt (x@(DGMap f g _)) =+        ["("++ppList " "  (["gmap", ppFun f] ++ ppt g) ++ "::" ++ prettyShow (getType x)++")"]+    ppt (x@(DGZip g1 g2 _)) =+        ["("++ppList " "  (["gzip"] ++ ppt g1 ++ ppt g2) ++ "::" ++ prettyShow (getType x)++")"]+    ppt (x@(DGIter f0 ft t g _)) =+        ["("++(ppList " " $ ["iter", ppFun f0, ppFun ft] ++ ppt t ++ ppt g) ++ "::" ++ prettyShow (getType x)++")"]+    ppt (x@(DGVar g _)) = +        ["("++ppVar g ++ "::" ++ prettyShow (getType x)++")"]++instance PrettyPrinterWithType (DTermination Misc) where+    ppt (DTermF _)= ["Fixpoint"]+    ppt (DTermI e _) = ["(Iter (" ++ ppList " " (ppt e) ++ "))"]+    ppt (DTermU e _) = ["(Until (\\g->" ++ ppList " " (ppt e) ++ "))"]++instance PrettyPrinterWithType (DVar Misc) where+    ppt x = [ppVar x ++ "::" ++ prettyShow (getType x) ++ dep x]++instance PrettyPrinterWithType (DSmplDef Misc) where+    ppt (x@(DDefFun f vs ds e _)) =+        if length ds == 0+        then header ++ indent (ppt e)+        else header ++ indent (let_in (concatMap ppt ds) (ppt e))+            where header = [typeSig f ++ dep x, ppFun f ++ " " ++ ppList " " (map ppVar vs) ++ " = " ]+    ppt (x@(DDefVar v ds e _)) = +        if length ds == 0+        then header ++ indent (ppt e)+        else header ++ indent (let_in (concatMap ppt ds) (ppt e))+            where header = [typeSigV v ++ dep x, ppVar v ++ " = "]+    ppt (x@(DDefTuple vs ds e _)) = +        if length ds == 0+        then header ++ indent (ppt e)+        else header ++ indent (let_in (concatMap ppt ds) (ppt e))+            where header = [tt ++ "::" ++ prettyShow (getType x) ++ dep x, tt ++" = "]+                  tt = "(" ++ ppList ", " (map ppVar vs) ++ ")"++enclose' xs = indentWith "(" xs'+    where xs' = init xs ++ [last xs++")"]++addSig x xs = enclose' xs''+ where xs' = enclose' xs+       xs'' = init xs' ++ [last xs'++"::"++ prettyShow (getType x)]++instance PrettyPrinterWithType (DExpr Misc) where+    ppt (x@(DIf c t e _)) = addSig x (indentWith "if " (ppt c) +++                                      indentWith "then " (ppt t) +++                                      indentWith "else " (ppt e))+    ppt (x@(DVExp v _)) = ["("++typeSigV v++")"]+    ppt (x@(DCExp c _)) = ["("++typeSigC c++")"]+    ppt (x@(DFunAp f es _)) = addSig x [ppList " " (ppFun f: map flatE' es)]+    ppt (x@(DConsAp c es _)) = addSig x [ppList " " (ppConstructor c: map flatE' es)]+    ppt (x@(DTuple es _)) = addSig x $ indentWith "(" (concat $ insList "," ")" $ map ppt es)+    ppt (x@(DFieldAcc e fs _)) = addSig x $ [ ppTableExpr e ++ (concat $ map ((".^"++).ppField) fs) ]+    ppt (x@(DFieldAccE e fs _)) = addSig x $ [ ppEdge e ++ (concat $ map ((".^"++).ppField) fs) ]+    ppt (x@(DAggr a e g es _)) =+        addSig x $ [ppAgg a ++ " [ " ++ flatE2' e ++  " | " ++ ppGen g ++ ps ++ " ] "]+            where ps = if length es == 0 then ""+                       else "," ++ ppList "," (map flatE' es)+    --ppt e = ppExpr e++flatE' :: (PrettyPrinterWithType (DExpr a)) => DExpr a -> String+flatE' = {- enclose . -} ppList " " . ppt++flatE2' :: (PrettyPrinterWithType (DExpr a)) => DExpr a -> String+flatE2' = ppList " " . ppt+++printN' (DNormalized fn is rs nd ps deps [ip] defs) =+   putStrLn(unlines $ [+            "fname: " ++ fn,+            "is: " ++ show is,+            "rs: "] ++ concatMap (indentWith "  " . ppRecordSpec) rs +++            indentWith "  "  (ppRecordSpec (fst nd)) +++              [+            "ip: " ++ show ip,+            "ps: "] +++            concatMap (\(is, str, fi, fs, fj) -> [" id: " ++ show is] ++ [ " nm: " ++ str] ++ indentWith " fi:" (ppDefVertComp fi) ++ indentWith " fs:" (ppDefVertComp fs) ++ indentWith " fj:" (ppDefVertComp fj)) ps+            ++ ["defs: "] ++ concatMap ppSmplDef defs+            )++------------ pretty printer for normalized oen (n_fregel) ----------------+printNStr = unlines . ppN++getFName (DNormalized fn is rs nd ps deps [ip] defs) = fn++printNStr' p = (getFName p ++ "__N" ++ show (numNormStages - 1) ++  ".fgl", printNStr p) ++-- using Int indtead of Maybe Phase for simplicity+printN = putStrLn . printNStr++addSemicolon :: [[String]] -> [[String]]+addSemicolon (x:[]) = x:[]+addSemicolon (x:xs) = addSemicolonLast x:addSemicolon xs+                      where addSemicolonLast (x:[]) = (x++";"):[]+                            addSemicolonLast (x:xs) = x:addSemicolonLast xs+                                                      +ppN (DNormalized fn is rs' nd ps deps [ip] defs) =+  let rs = fst nd:rs'+      (Just theRecord) = lookupBy (\(DRecordSpec c _ _) -> getName c) (newDataTypeName fn) rs+  in concatMap ppRecordSpec rs ++ [fn ++ " g = "] ++ indent (indentWith "let " (concat $ addSemicolon (map ppSmplDef defs ++ map (genFtX fn is) ps ++ [genFt fn ps is deps theRecord] ++ [genF0 fn ip rs theRecord])) ++ ["in fregel f0 ft Fix g"])++genF0 fn ip rs (DRecordSpec _ (_:_:fts) _) = ["f0 v = " ++ newDataTypeName fn ++" " ++ show ip ++ " 0" ++ concatMap (" "++) (map (genInitData.snd) fts)]+  where+    genInitData (DTInt _) = "0"+    genInitData (DTBool _) = "False"+    genInitData (DTString _) = "\"\""+    genInitData (DTDouble _) = "0.0"+    genInitData (DTTuple ts _) = "(" ++ ppList ", " (map genInitData ts) ++ ")"+    genInitData (DTRecord (DConstructor "Pair" _) [t1,t2] _) = "(Pair " ++ genInitData t1 ++ " " ++ genInitData t2 ++ ")"+    genInitData (DTRecord c ts _) =+      let (Just (DRecordSpec _ fts _)) = lookupBy (\(DRecordSpec c _ _) -> getName c) (getName c) rs+      in "(" ++ (getName c) ++ concatMap (" "++) (map (genInitData.snd) fts) ++ ")"++genFt fn ps is deps theRecord = ["ft v prev curr = "] ++ indentWith "  let " (concat $ addSemicolon (map (genFt0 fn) ps ++ [genEnd fn ps] ++ [genStep fn ps] ++ [genPhase fn ps deps] ++ map (genStepX fn ps) is))  ++ ["  in " ++ genFtBody fn ps is theRecord]+genFt0 :: DVarName -> (DPhaseID, String, DDefVertComp DASTData, DDefVertComp DASTData, DDefVertComp DASTData) -> [String]+genFt0 fn (pid, label, f0, ft, fj) = +  ppSmplDef $ defVar ("d_"++label) [] (expIf (expFieldAcc "prev" "v" [(fieldPhase fn)] ^== (expInt pid)) (expFun ("ft_"++label) [expVar "v", expVar "prev", expVar "curr"]) (expFieldAcc "prev" "v" [mkField label]))++genStepX fn ps pid = ppSmplDef $ defVar ("s_" ++ label) [] (expIf (expFieldAcc "prev" "v" [(fieldPhase fn)] ^== (expInt pid)) (expIf (expFun "not" [expVar "p_end"]) (expBin "+" (expInt 1) (expFieldAcc "prev" "v" [mkStep label])) (expInt 0)) (expFieldAcc "prev" "v" [mkStep label]))+  where label = lookupLabel pid ps+++genPhase fn ps deps = concat $ addSemicolon $ map ppSmplDef [defNext, defStay, defPhase]+  where+    defStay = defFun "stay" ["pid"] [] (recs 0 deps)+    defNext = defFun "next" ["pid"] [] (recs 1 deps)+    recs k [] = expInt (maxpid ps)+    recs k ((pid, fps):ds) = expIf (expVar "pid" ^== expInt pid) (expInt ((if length fps > k then snd (fps!!k) else maxpid ps))) (recs k ds)+    defPhase = defVar "phase'" [] (expIf (expVar "p_end") (expFun ("next") [(expFieldAcc "prev" "v" [(fieldPhase fn)])]) (expFun ("stay") [(expFieldAcc "prev" "v" [(fieldPhase fn)])]))++genFtBody fn ps is (DRecordSpec _ (_:_:fts) _) = newDataTypeName fn ++ " phase' step'" ++ concatMap (" "++) (map (\(_, label, _,_,_) -> "d_" ++ label) ps) ++ concatMap (" "++) (map (\i -> "s_" ++ lookupLabel i ps) is)++lookupLabel i ps = let (Just l) = lookup i (map (\(i,l,_,_,_) -> (i, l)) ps) in l++genEnd fn ps = ppSmplDef $ defVar "p_end" [] (genEndrec ps)+  where+    genEndrec [] = expBool False+    genEndrec ((pid, label, f0, ft, fj):ps) = expIf (expFieldAcc "prev" "v" [(fieldPhase fn)] ^== (expInt pid)) (expFieldAcc "curr" "v" [mkField label, "_fst"]) (genEndrec ps)++genStep fn ps = ppSmplDef $ defVar "step'" [] (expIf ((expFun "not" [expFieldAcc "prev" "v" [(fieldPhase fn)] ^== (expInt (maxpid ps))]) ^&& (expFieldAcc "prev" "v" [(fieldPhase fn)] ^== expFieldAcc "curr" "v" [(fieldPhase fn)] )) (expBin "+" (expInt 1) (expFieldAcc "prev" "v" [(fieldStep fn)])) (expInt 0))+maxpid ps = 1 + maximum (map (\(pid,_,_,_,_) -> pid) ps)+       +getDefsOfVC (DDefVertComp _ defs _ _) = defs++-- omitting type info.+genFtX :: DVarName -> [DPhaseID] -> (DPhaseID, String, DDefVertComp DASTData, DDefVertComp DASTData, DDefVertComp DASTData) -> [String]+genFtX fn is (pid, label, f0, ft, fj) = +  let (DDefVertComp _ defs0 e0 _) = mapData (\_ -> "") f0+      (DDefVertComp _ defst et _) = mapData (\_ -> "") ft+      (DDefVertComp _ defsj ej _) = mapData (\_ -> "") fj+      -- if this is iter, then look at its step counter+      st = if (elem pid is) then mkStep label else (fieldStep fn) +      defD = defVar "d" [] (expIf (expFieldAcc "prev" "v" [st] ^== (expInt 0)) e0 et)+      defEnd = defVar "end" [] ej+  in ppDefVertComp $ defVertComp ("ft_"++label) (defs0++defst++[defD]++defsj++[defEnd]) (expConstructor "Pair" [(expVar "end"),(expVar "d")])++++     +---------------- for flatterning nested records (not used yet) ------------------------+genFieldListsOfType :: [DRecordSpec a] -> DTypeInfo -> [([String], DTypeInfo)]+genFieldListsOfType rs t = genFieldListsOfType' (buildExpander rs) t+++genFieldListsOfType' :: (DTypeInfo -> [(String, DTypeInfo)]) -> DTypeInfo -> [([String], DTypeInfo)]+genFieldListsOfType' expander t = case (expander t) of +                                  [] -> [([], t)]+                                  fts -> concatMap f fts +  where f (field, t) = map (\(fields, t') -> (field:fields, t')) (genFieldListsOfType' expander t)+++buildExpander :: [DRecordSpec a] -> DTypeInfo -> [(String, DTypeInfo)]+buildExpander rs (DTypeTerm tn ts) = +    if tn == "Pair" then [("_fst", head ts), ("_snd", head (tail ts))]+    else if isPrimitive tn then [] +         else case findRecord rs tn of+                Just fts -> fts+                Nothing -> error ("something wrong. not found " ++ tn)++findRecord [] _ = Nothing+findRecord (DRecordSpec (DConstructor c _) fts _:rs) tn =+    if c == tn then Just (map (\(DField f _, t) -> (f, toTypeInfo t)) fts) +    else findRecord rs tn++toTypeInfo (DTInt _) = typeDTInt+toTypeInfo (DTBool _) = typeDTBool+toTypeInfo (DTString _) = typeDTString+toTypeInfo (DTDouble _) = typeDTDouble++                          +
+ compiler/NtoIR.hs view
@@ -0,0 +1,932 @@+module NtoIR where
+import Spec
+import Normalization
+import ASTData
+import IR
+import GenSMT
+
+import Data.List
+import Data.Ord
+import Debug.Trace
+import System.IO.Unsafe
+--import Text.Groom
+
+myFind p xs = case Data.List.find p xs of Just a  -> a; Nothing -> undefined
+
+ppp v = unsafePerformIO $ do { putStrLn (show v); return v;}
+
+------------------------------------------------------------------------
+dataName  phlabel = "data_" ++ phlabel
+stepName  prog    = "step_" ++ prog
+ndataName prog    = "NData_" ++ prog
+phaseName prog    = "phase_" ++ prog
+subphName prog    = "subphase_" ++ prog
+isdataName name   = "data_" `Data.List.isPrefixOf` name
+isstepName name   = "step_" `Data.List.isPrefixOf` name
+retrievePhaseName name | isdataName name = drop 5 name  -- remove "data_"
+                       | isstepName name = drop 5 name  -- remove "step_"
+                       | otherwise       = trace ("\n cannot retrieve phase name from " ++ name) $ undefined
+
+------------------------------------------------------------------------
+-- Kato and Iwasaki: Eliminating communications / Using VoteToHalt
+-- related constants
+------------------------------------------------------------------------
+notChgName :: String
+notChgName = "notchanged"
+
+notChgNameAndType :: IRNameAndType
+notChgNameAndType = (notChgName, IRSimpleType (DTBool ()))
+
+irNotChg :: IRVar
+irNotChg = IRVarVertex notChgNameAndType IRNone []
+
+doAgainName :: String
+doAgainName = "doagain"
+
+irDoAgain :: IRVar
+irDoAgain = IRVarLocal (doAgainName, IRSimpleType (DTBool ()))
+
+------------------------------------------------------------------------
+-- NDPhase : a phases categorized into gmap/gzip, giter, or fregel, with logical steps split into physical steps
+------------------------------------------------------------------------
+data NDPhase = NDMapZipPhase -- (for gmap/gzip)
+                 Int  -- Phase ID
+                 String -- Label
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- finit
+             | NDIterPhase -- (for giter)
+                 Int  -- Phase Id
+                 String -- Label
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- finit
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- fjudge
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- fstep
+             | NDFregelPhase -- (for fregel)
+                 Int  -- Phase ID
+                 String -- Label
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- finit
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- fjudge
+                 (DExpr DASTData, [[DSmplDef DASTData]]) -- fstep
+             deriving (Show, Eq)
+
+getPhaseID (NDMapZipPhase phid _ _    ) = phid
+getPhaseID (NDIterPhase   phid _ _ _ _) = phid
+getPhaseID (NDFregelPhase phid _ _ _ _) = phid
+getPhaseName (NDMapZipPhase _ phlabel _    ) = phlabel
+getPhaseName (NDIterPhase   _ phlabel _ _ _) = phlabel
+getPhaseName (NDFregelPhase _ phlabel _ _ _) = phlabel
+getID_Init  (NDMapZipPhase _ _ (fI, pI)                  ) = 0
+getID_Init  (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = 0
+getID_Init  (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = 0
+getID_Judge (NDMapZipPhase _ _ (fI, pI)                  ) = -1 -- dummy
+getID_Judge (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI
+getID_Judge (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI
+getID_Step  (NDMapZipPhase _ _ (fI, pI)                  ) = -1 -- dummy
+getID_Step  (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI + length pJ
+getID_Step  (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI + length pJ
+getInit  (NDMapZipPhase _ _ (fI, pI)                  ) = (fI, pI)
+getInit  (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fI, pI)
+getInit  (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fI, pI)
+getJudge (NDMapZipPhase _ _ (fI, pI)                  ) = (undefined, undefined) -- dummy
+getJudge (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fJ, pJ)
+getJudge (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fJ, pJ)
+getStep  (NDMapZipPhase _ _ (fI, pI)                  ) = (undefined, undefined) -- dummy
+getStep  (NDIterPhase   _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fS, pS)
+getStep  (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fS, pS)
+
+isMapZipPhase (NDMapZipPhase _ _ _) = True
+isMapZipPhase _ = False
+
+------------------------------------------------------------------------
+-- NDPhGraph : precomputed phase-transisions
+------------------------------------------------------------------------
+data PhLinks = PhLinks { phid :: Int,
+                         next_in :: (Int, Int),    -- next phase/subphase (IN)
+                         next_out :: (Int, Int) }  -- next phase/subphase (OUT)
+               deriving (Show, Eq)
+
+type NDPhGraph = [PhLinks]
+
+nextState_in  phgraph ph_id = next_in  $ myFind ((== ph_id) . phid) phgraph
+nextState_out phgraph ph_id = next_out $ myFind ((== ph_id) . phid) phgraph
+
+------------------------------------------------------------------------
+-- entry point
+------------------------------------------------------------------------
+-- ecopt == -oec is given and -smt is NOT given
+-- vhopt == -ovh is given and -smt is NOT given
+genIR oinfo@(ecopt, vhopt, msgcomb)
+      sfs
+      (DNormalized progname iterinfo user_records ndata phases' phgraph initPhase constVars)
+  = let phs = map (processPhase2 oinfo iterinfo sfs) phases'
+                             -- split each phase into steps and add some information
+        fst3 (x,y,z) = x
+        snd3 (x,y,z) = y
+        thd3 (x,y,z) = z
+        phases = map fst3 phs
+        needNotChanged = or (map snd3 phs)
+        -- usefix = or (map thd3 phs)
+        phgraph2 = processPhGraph phgraph iterinfo phases
+        -- datatypes
+        (ndata_record, ps) = ndata
+        typedecl = map convTypeDecl user_records
+        -- constants
+        (constants, methods) = convConstants constVars
+        -- definition of vertex
+        valField = let dvals = findDVal phases
+                   in if length dvals > 0 then head dvals else ("val", IRSimpleType (DTInt ()))
+        -- Kato and Iwasaki -- `notchanged' field 
+        changedField = if needNotChanged then [notChgNameAndType] else []
+        interstepVar = findInterstepVars constants phases
+        vertexStruct = convVertexStruct progname phases ndata
+                                        (changedField ++ [valField] ++ interstepVar)
+        -- definition of message
+        messageExprs = extractMessageExprs phases
+        -- Emoto 2021/1/27: modified to remove duplicates
+        --msgStruct = convMsgStruct messageExprs
+        msgStruct = convMsgStruct (Data.List.nubBy aux $ messageExprs)
+          where aux (DDefVar var1 _ _ _) (DDefVar var2 _ _ _) = var1 == var2 
+
+        -- definition of aggregator
+        -- aggExprs = extractAggExprs phases
+        -- aggStruct = convAggStruct aggExprs
+        aggExprs = extractAggExprs phases
+        -- Emoto 2021/1/27: modified to remove duplicates
+        -- aggStruct = convAggStruct aggExprs
+        aggStruct = convAggStruct (Data.List.nubBy aux $ aggExprs)
+          where aux (DDefVar var1 _ (DAggr op1 _ _ _ _) _) (DDefVar var2 _ (DAggr op2 _ _ _ _) _) = var1 == var2 && op1 == op2
+
+        env = MakePhaseBodyEnv progname iterinfo phgraph2 typedecl
+                               vertexStruct constants interstepVar 0 "dummy"
+        (vth, phasebody) = makePhaseBody env phs
+        -- (vth, phasebody) = makePhaseBody env vhopt phs
+        phaseCompute = IRPhaseCompute phasebody
+        -- FIXME: type of edge should be collected
+        edgeStruct = IREdgeStruct ("EdgeData_" ++ progname)
+                                  [("e", IRSimpleType (DTInt ()))]
+        useOfSendR = isSendRUsed phasebody
+        needTagMsgs = multipleSends phasebody
+        initState = (head initPhase, 0)
+    in IRProg progname typedecl vertexStruct edgeStruct msgStruct aggStruct
+              useOfSendR needTagMsgs (False,vth,msgcomb) constants phaseCompute
+              initState methods
+
+------------------------------------------------------------------------
+-- processPhase2  : categorize a phase into gmap/gzip, giter, or fregel, and split its logical steps into physical ones
+------------------------------------------------------------------------
+processPhase2 :: OptimizeInfo -> [Int] -> [SMTOptimizable] ->
+                 DPhase DASTData -> (NDPhase, CanElimComm, Bool)
+processPhase2 (ecopt, vhopt, _) iterinfo sfs (phid, phlabel, fInit, fStep, fJudge)
+  = let fInit'  = processFInit fInit
+        fStep'  = processFStep fStep
+        fJudge' = processFJudge fJudge
+        -- Kato and Iwasaki
+        DDefVertComp _ pinit _ _ = fInit
+        usefixinit = or (map hasAggTermG pinit)
+        DDefVertComp _ pstep _ _ = fStep
+        usefixstep = or (map hasAggTermG pstep)
+        DDefVertComp _ pjudge _ _ = fJudge
+        usefixjudge = or (map hasAggTermG pjudge)
+        usefix = usefixjudge || usefixstep || usefixinit
+        ec = if ecopt then idpJudge fStep  --  -oec && (not -smt)
+             else if canEcWithSMT sfs fStep then True
+             else False
+        vh = if vhopt then ec && usefix
+             else if canVHWithSMT sfs fStep then True
+             else False
+    in -- ppp phid `seq`
+       -- ppp (phid `elem` iterinfo) `seq`
+       -- ppp isGmapGzipPhase `seq`
+       if phid `elem` iterinfo then
+         (NDIterPhase phid phlabel fInit' fJudge' fStep', False, False)
+       else if isGmapGzipPhase then
+         (NDMapZipPhase phid phlabel fInit', False, False)
+       else -- (putStrLn ("processPhase2: sfs = " ++ show sfs) `seq`
+            -- putStrLn ("processPhase2: ec = " ++ show ec ++ ", vh = " ++ show vh)
+            --  `seq`
+             (NDFregelPhase phid phlabel fInit' fJudge' fStep', ec, vh)
+            -- )
+    where isGmapGzipPhase = isConstTrueExpression $ getLSSLastExpr fJudge
+          getLSSLastExpr (DDefVertComp _ _ lastexpr _) = lastexpr
+          isConstTrueExpression (DCExp (DCBool True _) _) = True
+          isConstTrueExpression _                         = False
+          canEcWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = cews name sfs
+          -- canEcWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = ppp sfs `seq` ppp name `seq` cews name sfs
+          canVHWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = cvws name sfs
+          cews name [] = False
+          cews name ((sfname, b, _):sfs') | isSf name sfname = b
+                                          | otherwise = cews name sfs'
+          cvws name [] = False
+          cvws name ((sfname, _, b):sfs') | isSf name sfname = b
+                                          | otherwise = cvws name sfs'
+          isSf name sfname = take (length sfname) name == sfname
+
+processFInit (DDefVertComp fun progs consap _)
+  = let (prog1, prog2) = splitBeforeFirst hasAgg progs
+        prog3 = splitBeforeEach hasAggCurr prog2
+    in (consap, prog1 : prog3)
+
+processFJudge (DDefVertComp fun progs judgeExpr _)
+  = let progs' = splitBeforeEach hasAggCurr progs
+    in (judgeExpr, progs')
+
+processFStep (DDefVertComp fun progs consap _)
+  = let progs' = splitBeforeEach hasAggCurr progs
+    in (consap, progs')
+
+-- splits the given list at the element satisfying p first; the second list contains the element.
+splitBeforeFirst p xs = let before = takeWhile (not . p) xs
+                            after  = dropWhile (not . p) xs
+                        in  (before, after)
+
+-- splits the given list at every element satisfying p; the element is located at the head of each split (except for the fist one)
+splitBeforeEach p [] = []
+splitBeforeEach p xs = let before = takeWhile (not . p) xs
+                           after  = dropWhile (not . p) xs
+                       in case after of
+                          [] -> [before]
+                          [a] -> [before, [a]]
+                          (a : as) -> let (as' : ass) = splitBeforeEach p as
+                                      in before : (a : as') : ass
+
+hasAggCurr (DDefVar var [] expr _) = hasAggCurrExp expr
+hasAggCurrExp (DAggr _ (DFieldAcc (DCurr _ _) _ _) _ _ _) = True
+-- TOO BAAAD! this fails even for "curr v .^ hoge + 1"
+-- FIXME: search any curr in the body
+hasAggCurrExp expr = False
+
+hasAgg (DDefVar var [] expr _) = let res = hasAggExp expr in res
+hasAggExp (DAggr _ _ _ _ _) = True
+hasAggExp expr = False
+
+hasAggTermG (DDefVar var [] expr _) = hasAggTermGExp expr
+hasAggTermG _ = False
+hasAggTermGExp (DAggr _ _ (DGenTermG _) _ _) = True
+hasAggTermGExp _ = False
+
+-- Kato and Iwasaki
+-- judges whether the step function uses an idempotent operator or not
+idpJudge :: DDefVertComp a -> Bool
+idpJudge (DDefVertComp (DFun fn _) vs (DConsAp _ as _) _) =
+  -- ppp 9999 `seq` ppp fn `seq`
+  and (map judgefn as)
+  where judgefn (DVExp (DVar v _) _) = idpJudge2 (getLetVal v vs) vs
+        judgefn _ = False
+
+{-
+idpJudge (DDefVertComp (DFun fn _) vs (DConsAp _ [DVExp (DVar v _) _] _) _) =
+  ppp 9999
+  `seq`
+  ppp fn
+  `seq`
+  idpJudge2 (getLetVal v vs) vs
+-}
+
+idpJudge (DDefVertComp (DFun fn _) vs _ _) =
+  -- ppp 8888 `seq` ppp fn `seq`
+  False
+
+idpJudge2 :: DSmplDef a -> [DSmplDef a] -> Bool
+idpJudge2 a@(DDefVar _ _ (DAggr ag _ _ _ _) _) vs = idpJudgeAgg "" ag
+idpJudge2 (DDefVar _ _ (DFunAp f [DVExp (DVar a1 _) _, DVExp (DVar a2 _) _] _) _) vs =
+  if op == "" then False
+  else if idpJudgeAgg op ag1 then True
+  else idpJudgeAgg op ag2
+  where op = getIdpOp (getName f)
+        DDefVar _ _ (DAggr ag1 _ _ _ _) _ = getLetVal a1 vs
+        DDefVar _ _ (DAggr ag2 _ _ _ _) _ = getLetVal a2 vs
+idpJudge2 (DDefVar _ _ (DFunAp f [DVExp (DVar a1 _) _, _] _) _) vs =
+  if op == "" then False else idpJudgeAgg op ag
+  where op = getIdpOp (getName f)
+        DDefVar _ _ (DAggr ag _ _ _ _) _ = getLetVal a1 vs
+idpJudge2 (DDefVar _ _ (DFunAp f [_, DVExp (DVar a2 _) _] _) _) vs =
+  if op == "" then False else idpJudgeAgg op ag
+  where op = getIdpOp (getName f)
+        DDefVar _ _ (DAggr ag _ _ _ _) _ = getLetVal a2 vs
+idpJudge2 _ _ = False
+
+getLetVal :: String -> [DSmplDef a] -> DSmplDef a
+getLetVal v [] = undefined
+getLetVal v (x:xs) = if v == getName x then x else getLetVal v xs
+
+idpJudgeAgg :: String -> DAgg a -> Bool
+idpJudgeAgg s (DAggMax _) = s == "max" || s == ""
+idpJudgeAgg s (DAggMin _) = s == "min" || s == ""
+idpJudgeAgg s (DAggAnd _) = s == "&&" || s == ""
+idpJudgeAgg s (DAggOr _) = s == "||" || s == ""
+idpJudgeAgg _ _ = False
+
+getIdpOp :: String -> String
+getIdpOp name = if elem name idpOp then name else ""
+
+idpOp :: [String]
+idpOp = ["min", "max", "&&", "||"]
+
+------------------------------------------------------------------------
+-- processPhGraph  : rearragnge the phase-transisions
+------------------------------------------------------------------------
+processPhGraph :: [(Int, [([a], Int)])] -- from, ??, to
+                  -> [Int]              -- phases from Iters
+                  -> [NDPhase]
+                  -> NDPhGraph -- source, IN, OUT; if its next is a step function of iter?
+processPhGraph phgraph iterinfo phases
+  = map (aux . addEndPh) phgraph
+    where addEndPh (phid, [t1])     = (phid, [t1, ([], -1)])
+          addEndPh (phid, [t1, t2]) = (phid, [t1, t2])
+          aux (phid, [([], in_phase), ([], out_phase)])
+            = PhLinks phid (in_phase, in_step) (out_phase, out_step)
+            where in_step = if (phid `elem` iterinfo)
+                            then 0  -- giter case
+                            else getID_Step $ myFind ((== phid) . getPhaseID) phases
+                  out_step = if (out_phase `elem` iterinfo) -- when the next phse is giter
+                             then if lastPhaseOfIterLoop out_phase == phid
+                                  then getID_Step $ myFind ((== out_phase) . getPhaseID) phases
+                                  else 0
+                             else 0
+                  lastPhaseOfIterLoop iterPhase = let in_phaseIter = getInPhase $ myFind ((== iterPhase) . fst) phgraph
+                                                  in last $ takeWhile (/= iterPhase) $ scanIterLoop in_phaseIter
+                  scanIterLoop ph = ph : scanIterLoop (getOutPhase $ myFind ((== ph) . fst) phgraph)
+                  getInPhase  (_, (([], inp) : _))              = inp
+                  getOutPhase (_, (([], inp) : ([], outp) : _)) = outp
+
+------------------------------------------------------------------------
+-- convVertexStruct : to build a struct of vertices from a record spec (recSpec) and so on
+------------------------------------------------------------------------
+-- Emoto 2018/01/16: modified to add the original phase id info. to fields
+convVertexStruct :: String -> [NDPhase] -> (DRecordSpec DASTData,[DPhaseID]) -> [IRNameAndType]-> IRVertexStruct
+convVertexStruct progname phases (recSpec, phaseIds) members_n_add'
+  = let DRecordSpec (DConstructor rname _) fs' _ = recSpec
+        fs = zip fs' phaseIds
+        members_n_add = zip members_n_add' (repeat (-1)) -- no corresponding phases
+        -- fields for IRNone: data_??? for gmap/gzip, all step_???Cadditional arguments fields
+        members_n = [convField f | f <- fs, isNoneField (fst f)] ++ members_n_add
+          where isNoneField (DField fn _, _) = if isdataName fn then isMapZipPhase $ myFind ((== retrievePhaseName fn) . getPhaseName) phases
+                                               else isstepName fn
+        -- fields for IRPrev/IRCurr: data_??? for others
+        members_pc = [convField f | f <- fs, isPrevCurrField (fst f)]
+          where isPrevCurrField (DField fn _, _) = isdataName fn && (not $ isMapZipPhase $ myFind ((== retrievePhaseName fn) . getPhaseName) phases)
+        convField ((DField rn _, DTRecord _ _ ast),pid) = let DTypeTerm "Pair" [_, t] = typeOf ast
+                                                        in ((rn, convType2 t), pid)
+        convField ((DField fn ast, _),pid) = ((fn, convType ast), pid)
+    in IRVertexStruct rname (phaseName progname) (subphName progname) members_pc members_n
+
+------------------------------------------------------------------------
+-- convConstants  convert constVar in N-DSL to const-vars and methods in IR
+------------------------------------------------------------------------
+convConstants :: [DSmplDef DASTData] -> ([IRConstant], [IRMethod])
+convConstants defs
+  = let vars = [convDefVar d | d <- defs, isDDefVar d]
+        funs = [convDefFun d | d <- defs, isDDefFun d]
+    in (vars, funs)
+    where isDDefVar (DDefVar _ _ _ _) = True
+          isDDefVar _                 = False
+          isDDefFun (DDefFun _ _ _ _ _ ) = True
+          isDDefFun _                    = False
+          convDefVar (DDefVar var [] expr _) = IRConstant (convVar var) (convExprGlobal undefined (convVar var) expr)
+          convDefFun (DDefFun fun vars [] expr _) = trace ("\n unsupported DDefFun in convConstants") $ undefined
+
+------------------------------------------------------------------------
+-- findDVal  find accesses to DVal from the whole program
+------------------------------------------------------------------------
+findDVal :: [NDPhase] -> [IRNameAndType]
+findDVal phases
+  = concatMap aux1 phases
+  where aux1 (NDMapZipPhase _ _ fI      ) = aux2 fI
+        aux1 (NDIterPhase   _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT
+        aux1 (NDFregelPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT
+        aux2 (expr, defss) = aux3 expr ++ concatMap (concatMap aux4) defss
+        aux3 (DIf e1 e2 e3 _) = aux3 e1 ++ aux3 e2 ++ aux3 e3
+        aux3 (DTuple es _) = concatMap aux3 es
+        aux3 (DFunAp _ es _) = concatMap aux3 es
+        aux3 (DConsAp _ es _) = concatMap aux3 es
+        aux3 (DFieldAcc (DPrev _ _) _ _) = []
+        aux3 (DFieldAcc (DCurr _ _) _ _) = []
+        aux3 (DFieldAcc (DVal _ a) _ _) = [("val", convType a)]
+        aux3 (DFieldAccE _ _ _) = []
+        aux3 (DAggr _ e _ es _) = aux3 e ++ concatMap aux3 es
+        aux3 (DVExp _ _) = []
+        aux3 (DCExp _ _) = []
+        aux4 (DDefFun _ _ _ _ _) = []
+        aux4 (DDefVar _ ss e _) = concatMap aux4 ss ++ aux3 e
+        aux4 (DDefTuple _ _ _ _) = trace "\n: unsupported DDefTuple" $ undefined -- FIXME: is DDefTuple used?
+
+------------------------------------------------------------------------
+-- findInterstepVar find variables whose score is over the physical superstep
+------------------------------------------------------------------------
+findInterstepVars constVars phases
+  = concatMap aux1 phases
+  where constNames = map getIRConstantVar constVars
+        aux1 (NDMapZipPhase _ _ fI      ) = aux2 fI
+        aux1 (NDIterPhase   _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT
+        aux1 (NDFregelPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT
+        aux2 (expr, defss) = concatMap f defss
+          where f defs = (Data.List.nub $ concatMap findUsedVar defs) \\ (concatMap findDefVar defs ++ constNames)
+
+findUsedVar def
+  = aux1 def
+  where aux1 (DDefVar _ ss e _)  = concatMap aux1 ss ++ aux2 e
+        aux1 (DDefFun _ _ _ _ _) = trace ("\n DDefFun unsupported in findUsedVar") $
+                                   undefined
+        aux1 (DDefTuple _ _ _ _) = trace ("\n DDefTuple unsupported in findUsedVar") $
+                                   undefined
+        aux2 (DIf e1 e2 e3 _)             = aux2 e1 ++ aux2 e2 ++ aux2 e3
+        aux2 (DTuple es _)                = concatMap aux2 es
+        aux2 (DFunAp (DFun "vid" _) es _) = [] -- For "vid v", v is not regarded as a variable
+        aux2 (DFunAp _ es _)              = concatMap aux2 es
+        aux2 (DConsAp _ es _)             = concatMap aux2 es
+        aux2 (DFieldAcc (DPrev _ _) _ _)  = []
+        aux2 (DFieldAcc (DCurr _ _) _ _)  = []
+        aux2 (DFieldAcc (DVal _ _) _ _)   = []
+        aux2 (DFieldAccE _ _ _)           = []
+        aux2 (DAggr _ e _ es _)           = aux2 e ++ concatMap aux2 es
+        aux2 (DVExp var _)                = [convVar var]
+        aux2 (DCExp _ _)                  = []
+
+findDefVar def
+  = aux1 def
+  where aux1 (DDefVar var ss _ _) = convVar var : (concatMap aux1 ss)
+        aux1 (DDefFun _ _ _ _ _)  = trace ("\n DDefFun unsupported in findDefVar") $
+                                    undefined
+        aux1 (DDefTuple _ _ _ _)  = trace ("\n DDefTuple unsupported in find DefVar") $
+                                    undefined
+
+----------------------------------------------------------------------
+-- isSendRUsed look for "IRStatementSendR" (= use of reverse message)
+----------------------------------------------------------------------
+isSendRUsed :: [IRPhaseComputeProcess] -> Bool
+isSendRUsed procs
+  = or $ map aux1 procs
+  where aux1 (IRPhaseComputeProcess _ _ _ _ nexts) = or $ map aux2 nexts
+        aux2 (_, _, block) = aux3 block
+        aux3 (IRBlock _ statements) = or $ map aux4 statements
+        aux4 (IRStatementSendR _ _ _) = True
+        aux4 (IRStatementIfThen _ block) = aux3 block
+        aux4 _                           = False
+
+----------------------------------------------------------------------
+-- multipleSends gathers message names that has to put tags
+----------------------------------------------------------------------
+multipleSends :: [IRPhaseComputeProcess] -> [String]
+multipleSends procs =
+  concatMap aux1 procs
+  where aux1 (IRPhaseComputeProcess _ _ _ _ ps) = concatMap aux2 ps
+        aux2 (_, _, block) = let ts = aux3 block in
+                             if length ts <= 1 then [] else ts
+        aux3 (IRBlock _ ss) = concatMap aux4 ss
+        aux4 (IRStatementSendN (name, _)  _ _) = [name]
+        aux4 (IRStatementSendR (name, _)  _ _) = [name]
+        aux4 (IRStatementIfThen _ b) = aux3 b
+        aux4 _ = []
+
+----------------------------------------------------------------------
+-- Processing Vertex.compute
+----------------------------------------------------------------------
+data MakePhaseBodyEnv = MakePhaseBodyEnv { _progname :: String,
+                                           _iterinfo :: [DPhaseID],
+                                           _phgraph  :: NDPhGraph,
+                                           _typedecl :: [IRTypeDecl],
+                                           _vertexStruct :: IRVertexStruct,
+                                           _constants :: [IRConstant],
+                                           _interstepVar :: [IRNameAndType],
+                                           _phid :: Int,
+                                           _phlabel :: String }
+                        deriving (Show, Eq)
+
+-- Kato and Iwasaki
+assignPh :: MakePhaseBodyEnv -> (String -> String) -> Int -> IRStatement
+assignPh env namefn n =
+  (IRStatementLocal (IRVarVertex (ph, irInt) IRNone [])
+                    (IRCExp irInt (IRCInt n)))
+  where ph = namefn (_progname env)
+        irInt = IRSimpleType (DTInt ())
+
+setPhase env phid phlabel
+ = let MakePhaseBodyEnv progname iterinfo phgraph typedecl vertexStruct constants interstepVar _ _ = env
+   in MakePhaseBodyEnv progname iterinfo phgraph typedecl vertexStruct constants interstepVar phid phlabel
+
+data ConvStatementsLabel = CSL_INIT | CSL_JUDGE | CSL_STEP deriving (Eq, Show)
+
+-- Kato and Iwasaki:
+-- The return value of this function is a pair, whose first is a boolean value
+-- that indicates whether vote-to-halt optimization is applied or not, and
+-- whose second is a list of IRPhaseComputeProcess.
+makePhaseBody :: MakePhaseBodyEnv -> [(NDPhase,CanElimComm,Bool)] ->
+                 (Bool, [IRPhaseComputeProcess])
+makePhaseBody env phs
+  = (vh, irphs)
+    where lp@(_, ec, vh) = last phs
+          irphs = concatMap (makePhaseBodyP env False) (init phs) ++
+                  makePhaseBodyP env vh lp
+{-
+makePhaseBody env vh phs
+  = (vh && usefix, irphs)
+    where lp@(_, ec, usefix) = last phs
+          irphs = concatMap (makePhaseBodyP env False) (init phs) ++
+                  makePhaseBodyP env vh lp
+-}
+
+makePhaseBodyP env vh (phase, ec, _)
+  = let env' = setPhase env (getPhaseID phase) (getPhaseName phase)
+        ---
+        zippedI' = markInitLast $ zipStepWithNext (snd $ getInit  phase) (getID_Init  phase) (getID_Judge phase) (head $ snd $ getJudge phase)
+        zippedJ' = markInitLast $ zipStepWithNext (snd $ getJudge phase) (getID_Judge phase) (getID_Step  phase) (head $ snd $ getStep  phase)
+        zippedS' = markInitLast $ zipStepWithNext (snd $ getStep  phase) (getID_Step  phase) (getID_Judge phase) (head $ snd $ getJudge phase)
+        ---
+        -- vth = vh && usefix
+    in
+       -- ppp ("makePhaseBodyP: vh = " ++ show vh)
+       -- `seq`
+       case phase of
+       NDMapZipPhase phid phlabel (cI, _)
+         -> map (makeStep2 env' cI phase ec False CSL_INIT) zippedI'
+       NDFregelPhase phid phlabel (cI, _) (cJ, _) (cS, _)
+         -> let initPart  = map (makeStep2 env' cI phase ec vh CSL_INIT) zippedI'
+                judgePart = map (makeStep2 env' cJ phase ec vh CSL_JUDGE) zippedJ'
+                stepPart  = map (makeStep2 env' cS phase ec vh CSL_STEP) zippedS'
+            in initPart ++ judgePart ++ stepPart
+       NDIterPhase phid phlabel (cI, _) (cJ, _) (cS, _)
+         -> let initPart  = map (makeStep2 env' cI phase ec False CSL_INIT) zippedI'
+                judgePart = map (makeStep2 env' cJ phase ec False CSL_JUDGE) zippedJ'
+                stepPart  = map (makeStep2 env' cS phase ec False CSL_STEP) zippedS'
+            in initPart ++ judgePart ++ stepPart
+    ---
+    where zipStepWithNext :: [[DSmplDef DASTData]]  -- Original subphases
+                          -> Int                 -- Initial subphase-id
+                          -> Int                 -- Next subphase-id
+                          -> [DSmplDef DASTData] -- Next subphase
+                          -> [((Int, [DSmplDef DASTData]), (Int, [DSmplDef DASTData]))]
+          zipStepWithNext defss startID nextID nextdefs
+            = let zipped    = zip [startID..] defss
+                  nextdefss = tail zipped ++ [(nextID, nextdefs)]
+              in  zip zipped nextdefss
+          markInitLast :: [a] -> [((Bool, Bool), a)]
+          markInitLast [] = []
+          markInitLast [a] = [((True, True), a)]
+          markInitLast as =  [((True, False), head as)] ++ map (\a->((False, False), a)) (init $ tail as) ++ [((False, True), last as)]
+
+makeStep2 env expr phase ec vth sw ((isFirst, isLast), ((stid, curdefs), (ss_next, nextdefs)))
+  = let cs_sw = case sw of
+                 CSL_INIT  -> True
+                 CSL_JUDGE -> False
+                 CSL_STEP  -> True
+        access = case phase of
+                  NDMapZipPhase _ _ _     -> IRNone
+                  NDFregelPhase _ _ _ _ _ -> IRCurr
+                  NDIterPhase   _ _ _ _ _ -> IRCurr
+        (recoverVars, recoverDefs) = if isFirst then ([], []) else getRecoverDefs curdefs (_constants env)
+        localvars = recoverVars
+                    ++ extractLocalVars curdefs
+        initcode = if not isFirst
+                   then []
+                   else case phase of
+                    NDMapZipPhase _ _ _     -> initSetFields
+                    NDFregelPhase _ _ _ _ _ -> case sw of
+                                                CSL_INIT  -> [initializeStepVar (_progname env)] ++ initSetFields
+                                                CSL_STEP  -> [incrementStepVar  (_progname env)] ++ initSetFields
+                                                CSL_JUDGE -> []
+                    NDIterPhase   _ _ _ _ _ -> case sw of
+                                                CSL_INIT  -> [initializeStepVar (getPhaseName phase)] ++ initSetFields
+                                                CSL_STEP  -> initSetFields
+                                                CSL_JUDGE -> []
+                   where (DConsAp (DConstructor cname _) es astdata) = expr
+                         IRTypeDecl _ typeinfo = if cname == "Pair" then convPairTypeDecl $ typeOf astdata
+                                                                    else myFind (\(IRTypeDecl cn _)->cn == cname) (_typedecl env)
+                         initSetFields = concatMap aux (zip typeinfo es)
+                           where aux (field, (DVExp _ _))         = []
+                                 aux (field, e@(DCExp _ _))       = [makeInitSetStatement field e]
+                                 aux (field, e@(DFieldAcc _ _ _)) = [makeInitSetStatement field e]
+                                 makeInitSetStatement field e
+                                  = IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) access [field])
+                                                     (convExpr env undefined e)
+        curr2prev = makeCurr2PrevStatement (_vertexStruct env) (getPhaseName phase)
+        afterjudgeprocess = case phase of
+                              NDFregelPhase _ _ _ _ _ -> [curr2prev]
+                              NDIterPhase   _ _ _ _ _ -> [curr2prev, incrementStepVar (getPhaseName phase)]
+        bodydefs = initcode
+                   ++ recoverDefs
+                   ++ convStatements curdefs env expr access ec vth cs_sw
+        sendmessages = concatMap (extractsSends' env ec vth sw) nextdefs
+        nextstep_out = let nextstate_out = nextState_out (_phgraph env) (_phid env)
+                       in (convExpr env undefined expr,
+                           nextstate_out,
+                           if (fst nextstate_out == _phid env) then IRBlock [] (afterjudgeprocess ++ sendmessages)
+                           -- Kato and Iwasaki
+                           else if vth then IRBlock [] (afterjudgeprocess ++ [assignPh env phaseName (_phid env), assignPh env subphName ss_next])
+                           else IRBlock [] afterjudgeprocess)
+        nextstep_in = let nextstate_in = nextState_in (_phgraph env) (_phid env)
+                          -- Kato and Iwasaki
+                          ch = IRFunAp (IRBinOp "==") [IRVExp irNotChg, alwaysFalse]
+                          sm = if ec && (not vth) then [IRStatementIfThen ch (IRBlock [] sendmessages)]
+                               else sendmessages
+                      in (alwaysTrue,
+                          nextstate_in,
+                          if (fst nextstate_in == _phid env) then IRBlock [] (afterjudgeprocess ++ sm)
+                          else IRBlock [] afterjudgeprocess)
+        nextsteps
+          = if not isLast then simplyNextSubph []
+            -- if not isLast then simplyNextSubphase
+            else case sw of
+               CSL_INIT  -> case phase of
+                             NDMapZipPhase _ _ _     -> [(alwaysTrue, (nextState_out (_phgraph env) (_phid env)), IRBlock [] [])]
+                             -- NDFregelPhase _ _ _ _ _ -> simplyNextSubphase
+                             NDFregelPhase _ _ _ _ _ -> simplyNextSubph initNotChg
+                             -- NDIterPhase   _ _ _ _ _ -> simplyNextSubphase
+                             NDIterPhase   _ _ _ _ _ -> simplyNextSubph []
+               CSL_JUDGE -> [nextstep_out, nextstep_in]
+               -- CSL_STEP  -> simplyNextSubphase
+               CSL_STEP  -> simplyNextSubph setNotChg
+            where simplyNextSubphase = [(alwaysTrue, (_phid env, ss_next), IRBlock [] sendmessages)]
+        -- Kato and Iwasaki: set a value of `notchanged'
+        assignNotChg b = if ec then [IRStatementLocal irNotChg b] else []
+        initNotChg = assignNotChg alwaysFalse
+        setNotChg = assignNotChg (makePrevEqEqCurrExp (_vertexStruct env) (getPhaseName phase))
+        simplyNextSubph chg = [(alwaysTrue, (_phid env, ss_next), IRBlock [] (chg ++ sendmessages))]
+    in IRPhaseComputeProcess (_phid env, stid) vth localvars (IRBlock [] bodydefs) nextsteps
+
+getRecoverDefs defs constants
+  = let usedVars = Data.List.nub $ concatMap findUsedVar defs
+        defVars =  Data.List.nub $ concatMap findDefVar  defs
+        undefVars = usedVars \\ (defVars ++ map getIRConstantVar constants)
+        recoverDefs = map recover undefVars
+                      where recover (vname, vtype) = IRStatementLocal (IRVarLocal (vname, vtype)) (IRVExp (IRVarVertex (vname, vtype) IRNone []))
+    in (undefVars, recoverDefs)
+
+alwaysTrue = IRCExp (IRSimpleType (DTBool ())) (IRCBool True)
+alwaysFalse = IRCExp (IRSimpleType (DTBool ())) (IRCBool False)
+
+-- Emoto 2018/01/16: modified to deal with the original phase id of a field
+makeCurr2PrevStatement vertexStruct phlabel
+  = let IRVertexStruct _ _ _ gfields _ = vertexStruct
+        (gfield, pid) = myFind ((== dataName phlabel) . fst . fst) gfields
+    in IRStatementLocal (IRVarVertex gfield IRPrev [])
+                        (IRVExp (IRVarVertex gfield IRCurr []))
+
+-- Kato and Iwasaki
+makePrevEqEqCurrExp vertexStruct phlabel
+  = let IRVertexStruct _ _ _ gfields _ = vertexStruct
+        (gfield, pid) = myFind ((== dataName phlabel) . fst . fst) gfields
+    in IRFunAp (IRBinOp "==") [IRVExp (IRVarVertex gfield IRPrev []),
+                               IRVExp (IRVarVertex gfield IRCurr [])]
+
+-- extracts DAggr in defs
+-- FIXME: only consider DDefVar with DAgg??
+-- Kato and Iwasaki: This function returns a pair, whose fst indicates
+-- whether DGenTermG is used, in other words, whether termination condition
+-- `Fix' is used or not.
+extractsSends' env ec vth sw (DDefVar var [] (DAggr op expr gen filters _) _)
+  = case gen of
+     DGenI _ -> [IRStatementSendN var' expr'' filters'']
+     DGenO _ -> [IRStatementSendR var' expr'' filters'']
+     DGenG _ -> [IRStatementAggr var' expr'' filters'']
+     DGenTermG _ -> let gg = [IRStatementAggr var' expr' filters']
+                        gs = if vth then [] else gg
+                        doagain = if vth then [IRStatementLocal irDoAgain alwaysTrue]
+                                  else []
+                    in if ec == False then gg
+                       else if sw == CSL_STEP then doagain ++ gs
+                       else if sw == CSL_INIT then doagain ++ gs
+                       else gg
+    where
+      var' = convVar var
+      expr' = convExpr env _v expr
+      expr'' = convExpr env _v (substVertexVar ps expr)
+      filters' = map (convExpr env _v) filters
+      filters'' = map (convExpr env _v . substVertexVar ps) filters
+      ps = [("u", "v"), ("v", "v'")]
+      _v = undefined
+extractsSends' env ec vth sw _ = []
+
+convStatements defs env consap pcflag ec vth sw_update
+  = concatMap (extractRecvMsg sw_update) aggr_defs ++ concatMap (convStatements' sw_update) defs'
+    where
+      (DConsAp (DConstructor cname _) es astdata) = consap
+      (aggr_defs, defs') = Data.List.partition recvstatement defs
+                           where recvstatement (DDefVar _ _ (DAggr _ _ _ _ _) _) = True
+                                 recvstatement _ = False
+      IRTypeDecl _ typeinfo = if cname == "Pair" then convPairTypeDecl $ typeOf astdata
+                                                 else myFind (\(IRTypeDecl cn _)->cn == cname) (_typedecl env)
+      name_type_rhs = zip typeinfo es
+      initStatements
+        = concatMap aux name_type_rhs
+          where aux ((fn, ft), (DVExp _ _))         = []
+                aux ((fn, ft), e@(DCExp _ _))       = [IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fn, ft)]) (convExpr env undefined e)]
+                aux ((fn, ft), e@(DFieldAcc _ _ _)) = [IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fn, ft)]) (convExpr env undefined e)]
+      -- FIXME: DDefVar with no lets only??
+      extractRecvMsg withupdate (DDefVar var [] aggr _)
+        = let var' = convVar var
+              st_update = if withupdate then updateStatements (fst var') else []
+          in case aggr of
+              (DAggr agg expr (DGenI _) exprs _) -> IRStatementMsg (IRVarLocal var') (convAggOp agg) (IRMVal var') : st_update
+              (DAggr agg expr (DGenO _) exprs _) -> IRStatementMsg (IRVarLocal var') (convAggOp agg) (IRMVal var') : st_update
+              (DAggr agg expr (DGenG _) exprs _) -> IRStatementLocal (IRVarAggr var') (IRAggr var') : st_update
+              (DAggr agg expr (DGenTermG _) exprs _) ->
+                -- if vth then st_update
+                if vth then IRStatementLocal (IRVarAggr var') (IRVExp irNotChg) : st_update
+                else IRStatementLocal (IRVarAggr var') (IRAggr var') : st_update
+      convStatements' withupdate (DDefVar var [] expr _)
+        = let var' = convVar var
+              st_update = if withupdate then updateStatements (fst var') else []
+          in IRStatementLocal (IRVarLocal var') (convExpr env var' expr) : st_update
+      updateStatements :: String -> [IRStatement]
+      updateStatements vn
+        = let updated_fields = filter vexp_with_var name_type_rhs
+                where vexp_with_var (nt, DVExp (DVar vname _) _) = vn == vname
+                      vexp_with_var (nt, _) = False
+              -- Emoto 2018/01/16: modified to deal with the original phase ids
+              updated_interfields = map fst $ filter interfield_with_var $ getNoPCvars (_vertexStruct env)
+                where interfield_with_var ((vname, _),_) = vn == vname
+                      getNoPCvars (IRVertexStruct _ _ _ _ ifs) = ifs
+              ret = map toUpdateStatement updated_fields ++ map toUpdateStatementIF updated_interfields
+                where toUpdateStatement ((fname, ftype), DVExp (DVar vname _) _)
+                        = IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fname, ftype)])
+                          (IRVExp (IRVarLocal (vname, ftype)))
+                      toUpdateStatementIF (vname, vtype)
+                        = IRStatementLocal (IRVarVertex (vname, vtype) IRNone []) (IRVExp (IRVarLocal (vname, vtype)))
+          in ret
+
+extractLocalVars defs
+  = concatMap aux defs
+    where aux (DDefVar var [] _ _) = [convVar var] -- FIXME: assumed no nested expression here??
+          aux _                    = []
+
+initializeStepVar name
+  = let stepVar = IRVarVertex (stepName name, IRSimpleType (DTInt ())) IRNone []
+    in  IRStatementLocal stepVar (IRCExp (IRSimpleType (DTInt ())) (IRCInt 0))
+incrementStepVar name
+  = let stepVar = IRVarVertex (stepName name, IRSimpleType (DTInt ())) IRNone []
+    in  IRStatementLocal stepVar (IRFunAp (IRBinOp "+") [IRVExp stepVar, IRCExp (IRSimpleType (DTInt ())) (IRCInt 1)])
+
+----------------------------------------------------------------------
+-- Convert Type (DType / DTypeTerm) to IRType
+----------------------------------------------------------------------
+convType :: DASTData -> IRType
+convType astdata = convType2 $ typeOf astdata
+
+convType2 :: DTypeTerm -> IRType
+-- FIXME: check whether types for Vertex, Graph, Null appear in the generated part.
+convType2 (DTypeTerm "Int" _)     = IRSimpleType (DTInt ())
+convType2 (DTypeTerm "Bool" _)    = IRSimpleType (DTBool ())
+convType2 (DTypeTerm "Double" _)  = IRSimpleType (DTDouble ())
+convType2 (DTypeTerm "String" _)  = IRSimpleType (DTString ())
+convType2 (DTypeTerm "(,)" fs)    = IRUserType "Tuple" (map convType2 fs)
+convType2 (DTypeTerm "Vertex" fs) = trace "Not considered type: Vertex" $ undefined
+convType2 (DTypeTerm "Graph" fs)  = trace "Not considered type: Graph" $ undefined
+convType2 (DTypeTerm "Null" _)    = trace "Not considered type: Null" $ undefined
+convType2 (DTypeTerm other fs)    = IRUserType other (map convType2 fs)
+
+----------------------------------------------------------------------
+-- processing records
+----------------------------------------------------------------------
+convTypeDecl :: DRecordSpec DASTData -> IRTypeDecl
+convTypeDecl (DRecordSpec (DConstructor rname _) fields _)
+  = IRTypeDecl rname (map (convField . fst) fields)
+
+convPairTypeDecl :: DTypeTerm -> IRTypeDecl
+convPairTypeDecl (DTypeTerm "Pair" [a, b]) = IRTypeDecl "Pair" [("_fst", convType2 a), ("_snd", convType2 b)]
+
+----------------------------------------------------------------------
+-- Preprocessing Messages
+----------------------------------------------------------------------
+extractMessageExprs :: [NDPhase] -> [DSmplDef DASTData]
+extractMessageExprs phases
+  = concatMap aux1 phases
+    where aux1 (NDMapZipPhase _ _ fI      ) = aux2 fI
+          aux1 (NDIterPhase   _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS
+          aux1 (NDFregelPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS
+          aux2 (expr, defss) = concatMap (concatMap aux3) defss
+          aux3 e@(DDefVar _ _ (DAggr agg _ (DGenI _) _ _) _) = [e]
+          aux3 e@(DDefVar _ _ (DAggr agg _ (DGenO _) _ _) _) = [e]
+          aux3 _ = []
+          -- FIXME: Enough?  consider only DDefVar + Agg + GenI/GenO
+
+convMsgStruct :: [DSmplDef DASTData] -> IRMsgStruct
+convMsgStruct msgExprs
+  = IRMsgStruct "MsgData" (map aux msgExprs)
+    where aux (DDefVar var _ _ _) = convVar var
+
+----------------------------------------------------------------------
+-- Preprocessing Aggregator
+----------------------------------------------------------------------
+extractAggExprs :: [NDPhase] -> [DSmplDef DASTData]
+extractAggExprs phases
+  = concatMap aux1 phases
+    where aux1 (NDMapZipPhase _ _ fI      ) = aux2 fI
+          aux1 (NDIterPhase   _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS
+          aux1 (NDFregelPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS
+          aux2 (expr, defss) = concatMap (concatMap aux3) defss
+          aux3 e@(DDefVar _ _ (DAggr agg _ (DGenG _) _ _) _) = [e]
+          aux3 e@(DDefVar _ _ (DAggr agg _ (DGenTermG _) _ _) _) = [e]
+          aux3 _ = []
+          -- FIXME: Enough?  consider only DDefVar + Agg + GenG
+
+convAggStruct :: [DSmplDef DASTData] -> IRAggStruct
+convAggStruct aggExprs
+  = IRAggStruct "AggData" (map aux aggExprs)
+    where aux (DDefVar var _ (DAggr op _ _ _ _) _) = (convVar var, convAggOp op)
+
+------------------------------------------------------------------------
+-- convExpr : convert an expression to IRExpr
+--            * eVal (snd parameter) is used as the variable name of aggregator/message
+------------------------------------------------------------------------
+convExpr :: MakePhaseBodyEnv -> IRNameAndType -> DExpr DASTData -> IRExpr
+convExpr env eVar expr
+  = aux expr
+    where aux (DConsAp (DConstructor c _) _ _) = trace ("unsupported use of DConsAP for " ++ show c) $ undefined
+          aux (DIf e1 e2 e3 _) = IRIf (aux e1) (aux e2) (aux e3)
+          aux (DFunAp f es astdata)
+            = case f of
+               DFun "vid" _ ->
+                 case es of
+                  [DVExp (DVar "v" _) _] -> IRVExp (IRVarVertex ("id", convType astdata) IRNone [])
+                  [DVExp (DVar "u" _) _] -> IRVExp (IRVarVertex ("id", convType astdata) IRNone [])
+                  [DVExp (DVar "v'" _) _] -> IRVExp (IRVarEdge ("vid", convType astdata) [])
+                  otherwise -> IRFunAp (convFun f) (map aux es)
+               othewise     -> IRFunAp (convFun f) (map aux es)
+          aux (DFieldAcc acc fields astdata)
+            = case acc of
+               DVal  var astdata' -> IRVExp (IRVarVertex ("val", convType astdata') IRNone (map convField fields))
+               DPrev var _        -> auxDF IRPrev var fields astdata
+               DCurr var _        -> auxDF IRCurr var fields astdata
+              where
+                -- procesing "DFieldAcc (DPrev var _) (f1 : f2 : fs) -- (the same for DCurr)
+                --   var's typeOf must be DTypeTerm "Graph"; skipping a _snd
+                --      ==> f1 is the variable name; the type is got from f2's typeOf
+                --          the rest (fs) is stored as fields
+                auxDF pcflagOrg var (f1 : fs) astdata
+                 = let pcflag = if isIRNoneField f1 then IRNone -- for variables of gmap/gzip
+                                                    else pcflagOrg
+                   in case getTypeId var of
+                       "Graph"   -> IRVExp (IRVarVertex (getFieldName f1, getFieldType $ head fs) pcflag (map convField $ tail fs))
+                       "Vertex"  -> if isstepName (getFieldName f1)
+                                    then IRVExp (IRVarVertex (getFieldName f1, getFieldType f1) IRNone (map convField fs))
+                                    else IRVExp (IRVarVertex (getFieldName f1, convType astdata) pcflag (map convField $ tail fs)) -- skip one
+                       otherwise -> trace ("\n unsupported case in convExpr: " ++ show (var, f1 : fs)) $ undefined
+          aux (DFieldAccE (DEdge astdata) fs _) = IRVExp (IRVarEdge ("e", convType astdata) (map convField fs))
+          aux (DAggr _ _ gen _ _) = case gen of
+                                     DGenG _   -> IRAggr eVar -- read from aggregator
+                                     DGenTermG _   -> IRAggr eVar -- read from aggregator
+                                     otherwise -> IRMVal eVar -- read from message
+          aux (DVExp var _) = IRVExp (IRVarLocal (convVar var))
+          aux (DCExp con astdata) = IRCExp (convType astdata) (convConst con)
+          aux x = trace ("\ncannot compile expression: " ++ show x ++ "\n") $ undefined
+          -- FIXME: aux (DTuple es _) needed?
+          ---
+          -- Emoto 2018/01/16: modified to deal with the original phase ids
+          isIRNoneField f = let IRVertexStruct _ _ _ _ nonefields = _vertexStruct env
+                            in  any ((== getFieldName f) . fst . fst) nonefields
+          getTypeId var = let (DVar _ a) = var; (DTypeTerm t _) = typeOf a in t
+          getFieldName (DField fn _) = fn
+          getFieldType (DField _ ft) = convType ft
+
+-- FIXME: convert expression for global definitions (== no messages)
+convExprGlobal = convExpr
+
+convField :: DField DASTData -> IRNameAndType
+convField (DField fname astdata) = (fname, convType astdata)
+
+convVar :: DVar DASTData -> IRNameAndType
+convVar (DVar vname astdata) = (vname, convType astdata)
+
+convFun :: DFun a -> IRFun
+convFun (DFun fname _) = IRFun fname
+convFun (DBinOp fname _) = IRBinOp fname
+
+convAggOp (DAggMin _)         = IRAggMin
+convAggOp (DAggMax _)         = IRAggMax
+convAggOp (DAggSum _)         = IRAggSum
+convAggOp (DAggProd _)        = IRAggProd
+convAggOp (DAggAnd _)         = IRAggAnd
+convAggOp (DAggOr _)          = IRAggOr
+convAggOp (DAggChoice (DCExp c _) _)    = IRAggChoice (convConst c) -- FIXME: used?
+convAggOp (DTupledAgg aggs _) = IRTupledAgg (map convAggOp aggs) -- FIXME: for internal use?
+
+convConst :: DConst a -> IRConst
+convConst (DCInt n _)    = IRCInt n
+convConst (DCBool n _)   = IRCBool n
+convConst (DCString n _) = IRCString n
+convConst (DCDouble n _) = IRCDouble n
+
+-- substVertexVar :: [(String, String)] -> DExpr DASTData -> DExpr DASTData
+substVertexVar :: [(String, String)] -> DExpr a -> DExpr a
+substVertexVar ps expr =
+  aux expr
+  where aux (DIf e1 e2 e3 a) = DIf (aux e1) (aux e2) (aux e3) a
+        aux (DTuple es a) = DTuple (map aux es) a
+        aux (DFunAp fn [e] a) = DFunAp fn [aux e] a
+        aux (DFunAp fn [e1,e2] a) = DFunAp fn [aux e1, aux e2] a
+        aux (DFunAp fn es a) = DFunAp fn (map aux es) a
+        aux (DConsAp con es a) = DConsAp con (map aux es) a
+        aux (DFieldAcc texpr fs a) = DFieldAcc (aux2 texpr) fs a
+        aux (DAggr ag e gen es a) = DAggr ag (aux e) gen (map aux es) a
+        aux (DCheckTerm e a) = DCheckTerm (aux e) a
+        aux (DVExp (DVar name a1) a2) = DVExp (DVar (conv name ps) a1) a2
+        aux e = e
+        aux2 (DPrev (DVar name a1) a2) = DPrev (DVar (conv name ps) a1) a2
+        aux2 (DCurr (DVar name a1) a2) = DCurr (DVar (conv name ps) a1) a2
+        aux2 (DVal (DVar name a1) a2) = DVal (DVar (conv name ps) a1) a2
+        conv name [] = name
+        conv name ((s1,s2):ps) | name == s1 = s2
+                               | otherwise  = conv name ps
+
+{-
+-- sample input from "ssspAndMax.fgl"
+sampleinput = DNormalized "ssspAndMax" [] [DRecordSpec (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})) [(DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}))] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DRecordSpec (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})) [(DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}))] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DRecordSpec (DConstructor "NData_ssspAndMax" (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [(DField "phase_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})),(DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})),(DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}), DTRecord (DConstructor "Pair" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})) [DTBool (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DTRecord (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})) [] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})),(DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DTRecord (DConstructor "Pair" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})) [DTBool (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DTRecord (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})) [] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []}))] (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})] [(0,"g1_X422",DDefVertComp (DFun "ssspinit_X41e_X436" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "SVal_X419" []], depOf = ["==","vid","SVal_X419"]})) [DDefVar (DVar "var_X438" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})) [] (DIf (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = ["=="]})) [DFunAp (DFun "vid" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "Int" []], depOf = ["vid"]})) [DVExp (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["vid","v"]}),DCExp (DCInt 1 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = ["==","vid","v"]})) (DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DCExp (DCInt 100000 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})] (DConsAp (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "SVal_X419" []], depOf = ["SVal_X419"]})) [DVExp (DVar "var_X438" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X438"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X438"]})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["SVal_X419","var_X438"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "SVal_X419" []], depOf = ["==","vid","SVal_X419"]}),DDefVertComp (DFun "ssspstep_X41f_X437" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "SVal_X419" []]]], depOf = ["minimum","+","dist_X41a","min","SVal_X419"]})) [DDefVar (DVar "agg_X432" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]})) [] (DAggr (DAggMin (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["minimum"]})) (DFunAp (DBinOp "+" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["+"]})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["u"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["u","prev"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["u","prev","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["u","prev","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["u","prev","dist_X41a"]}),DFieldAccE (DEdge (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["e"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["e"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["+","u","prev","dist_X41a","e"]})) (DGenI (DASTData {typeOf = DTypeTerm "(,)" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]}),DDefVar (DVar "newdist_X428" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})) [] (DFunAp (DFun "min" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["min"]})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","prev"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["v","prev","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["v","prev","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","prev","dist_X41a"]}),DVExp (DVar "agg_X432" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X432"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X432"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})] (DConsAp (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "SVal_X419" []], depOf = ["SVal_X419"]})) [DVExp (DVar "newdist_X428" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newdist_X428"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newdist_X428"]})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["SVal_X419","newdist_X428"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "SVal_X419" []]]], depOf = ["minimum","+","dist_X41a","min","SVal_X419"]}),DDefVertComp (DFun "g1_X422_judge" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "Bool" []]]], depOf = []})) [DDefVar (DVar "agg_g1_X422" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) [] (DAggr (DAggAnd (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "SVal_X419" [],DTypeTerm "->" [DTypeTerm "SVal_X419" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t43b",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DFieldAcc (DCurr (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t43b",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DGenG (DASTData {typeOf = DTypeVar "t43b", depOf = []})) [] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DFunAp (DBinOp "&&" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "Bool" []]], depOf = []})) [DFunAp (DBinOp ">" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DVExp (DVar "agg_g1_X422" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "Bool" []]]], depOf = []})),(1,"g2_X423",DDefVertComp (DFun "maxvinit_X420_X434" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []], depOf = ["val","dist_X41a","MVal_X41b"]})) [DDefVar (DVar "var_X439" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})) [] (DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","val"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["v","val","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["v","val","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})] (DConsAp (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "MVal_X41b" []], depOf = ["MVal_X41b"]})) [DVExp (DVar "var_X439" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X439"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X439"]})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["MVal_X41b","var_X439"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []], depOf = ["val","dist_X41a","MVal_X41b"]}),DDefVertComp (DFun "maxvstep_X421_X435" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "MVal_X41b" []]]], depOf = ["maximum","mval_X41c","max","MVal_X41b"]})) [DDefVar (DVar "agg_X433" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]})) [] (DAggr (DAggMax (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["maximum"]})) (DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["u"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["u","prev"]})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = ["u","prev","mval_X41c"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["u","prev","mval_X41c"]}),DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["mval_X41c"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["u","prev","mval_X41c"]})) (DGenI (DASTData {typeOf = DTypeTerm "(,)" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []], depOf = ["v"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]}),DDefVar (DVar "newmval_X42f" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})) [] (DFunAp (DFun "max" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["max"]})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","prev"]})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = ["v","prev","mval_X41c"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["v","prev","mval_X41c"]}),DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["mval_X41c"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","prev","mval_X41c"]}),DVExp (DVar "agg_X433" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X433"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X433"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})] (DConsAp (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "MVal_X41b" []], depOf = ["MVal_X41b"]})) [DVExp (DVar "newmval_X42f" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newmval_X42f"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newmval_X42f"]})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["MVal_X41b","newmval_X42f"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "MVal_X41b" []]]], depOf = ["maximum","mval_X41c","max","MVal_X41b"]}),DDefVertComp (DFun "g2_X423_judge" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "Bool" []]]], depOf = []})) [DDefVar (DVar "agg_g2_X423" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) [] (DAggr (DAggAnd (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "MVal_X41b" [],DTypeTerm "->" [DTypeTerm "MVal_X41b" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t453",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DFieldAcc (DCurr (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t453",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DGenG (DASTData {typeOf = DTypeVar "t453", depOf = []})) [] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DFunAp (DBinOp "&&" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "Bool" []]], depOf = []})) [DFunAp (DBinOp ">" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DVExp (DVar "agg_g2_X423" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "Bool" []]]], depOf = []}))] [(0,[([],0),([],1)]),(1,[([],1)])] [0] []
+-}
+ compiler/Parser.hs view
@@ -0,0 +1,3846 @@+{-# OPTIONS_GHC -w #-}+{-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-}+module Parser where+import Lexer hiding (main)+import Spec+import Spec0+import Convert0+import Control.Monad.State+import qualified Data.Array as Happy_Data_Array+import qualified Data.Bits as Bits+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.11++data HappyAbsSyn +	= HappyTerminal (Lexeme)+	| HappyErrorToken Int+	| HappyAbsSyn5 ([DProgramSpec0 Pos])+	| HappyAbsSyn6 (DProgramSpec0 Pos)+	| HappyAbsSyn7 ([ DRecordSpec Pos])+	| HappyAbsSyn8 (DRecordSpec Pos)+	| HappyAbsSyn9 ([(DField Pos, DType Pos)])+	| HappyAbsSyn10 ((DField Pos, DType Pos))+	| HappyAbsSyn11 (DField Pos)+	| HappyAbsSyn12 (DType Pos)+	| HappyAbsSyn13 ([DType Pos])+	| HappyAbsSyn14 (())+	| HappyAbsSyn16 (([DSmplDef0 Pos], DExpr0 Pos))+	| HappyAbsSyn17 ([DSmplDef0 Pos])+	| HappyAbsSyn18 (DSmplDef0 Pos)+	| HappyAbsSyn23 (DVar Pos)+	| HappyAbsSyn24 ([DVar Pos])+	| HappyAbsSyn26 (DExpr0 Pos)+	| HappyAbsSyn32 (String)+	| HappyAbsSyn36 ([DField Pos])+	| HappyAbsSyn37 (DTableExpr Pos)+	| HappyAbsSyn39 (DTermination0 Pos)+	| HappyAbsSyn42 ([DExpr0 Pos])+	| HappyAbsSyn44 (DGen Pos)+	| HappyAbsSyn45 (DAgg0 Pos)+	| HappyAbsSyn46 (DConstructor Pos)+	| HappyAbsSyn47 (DConst Pos)++{- to allow type-synonyms as our monads (likely+ - with explicitly-specified bind and return)+ - in Haskell98, it seems that with+ - /type M a = .../, then /(HappyReduction M)/+ - is not allowed.  But Happy is a+ - code-generator that can just substitute it.+type HappyReduction m = +	   Int +	-> (Lexeme)+	-> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> m HappyAbsSyn)+	-> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> m HappyAbsSyn)] +	-> HappyStk HappyAbsSyn +	-> [(Lexeme)] -> m HappyAbsSyn+-}++action_0,+ action_1,+ action_2,+ action_3,+ action_4,+ action_5,+ action_6,+ action_7,+ action_8,+ action_9,+ action_10,+ action_11,+ action_12,+ action_13,+ action_14,+ action_15,+ action_16,+ action_17,+ action_18,+ action_19,+ action_20,+ action_21,+ action_22,+ action_23,+ action_24,+ action_25,+ action_26,+ action_27,+ action_28,+ action_29,+ action_30,+ action_31,+ action_32,+ action_33,+ action_34,+ action_35,+ action_36,+ action_37,+ action_38,+ action_39,+ action_40,+ action_41,+ action_42,+ action_43,+ action_44,+ action_45,+ action_46,+ action_47,+ action_48,+ action_49,+ action_50,+ action_51,+ action_52,+ action_53,+ action_54,+ action_55,+ action_56,+ action_57,+ action_58,+ action_59,+ action_60,+ action_61,+ action_62,+ action_63,+ action_64,+ action_65,+ action_66,+ action_67,+ action_68,+ action_69,+ action_70,+ action_71,+ action_72,+ action_73,+ action_74,+ action_75,+ action_76,+ action_77,+ action_78,+ action_79,+ action_80,+ action_81,+ action_82,+ action_83,+ action_84,+ action_85,+ action_86,+ action_87,+ action_88,+ action_89,+ action_90,+ action_91,+ action_92,+ action_93,+ action_94,+ action_95,+ action_96,+ action_97,+ action_98,+ action_99,+ action_100,+ action_101,+ action_102,+ action_103,+ action_104,+ action_105,+ action_106,+ action_107,+ action_108,+ action_109,+ action_110,+ action_111,+ action_112,+ action_113,+ action_114,+ action_115,+ action_116,+ action_117,+ action_118,+ action_119,+ action_120,+ action_121,+ action_122,+ action_123,+ action_124,+ action_125,+ action_126,+ action_127,+ action_128,+ action_129,+ action_130,+ action_131,+ action_132,+ action_133,+ action_134,+ action_135,+ action_136,+ action_137,+ action_138,+ action_139,+ action_140,+ action_141,+ action_142,+ action_143,+ action_144,+ action_145,+ action_146,+ action_147,+ action_148,+ action_149,+ action_150,+ action_151,+ action_152,+ action_153,+ action_154,+ action_155,+ action_156,+ action_157,+ action_158,+ action_159,+ action_160,+ action_161,+ action_162,+ action_163,+ action_164,+ action_165,+ action_166,+ action_167,+ action_168,+ action_169,+ action_170,+ action_171,+ action_172,+ action_173,+ action_174,+ action_175,+ action_176,+ action_177,+ action_178,+ action_179,+ action_180,+ action_181,+ action_182,+ action_183,+ action_184,+ action_185,+ action_186,+ action_187,+ action_188,+ action_189,+ action_190,+ action_191,+ action_192,+ action_193,+ action_194,+ action_195,+ action_196,+ action_197,+ action_198,+ action_199,+ action_200,+ action_201,+ action_202,+ action_203,+ action_204,+ action_205,+ action_206,+ action_207,+ action_208,+ action_209,+ action_210,+ action_211,+ action_212,+ action_213,+ action_214,+ action_215,+ action_216,+ action_217,+ action_218,+ action_219,+ action_220,+ action_221,+ action_222,+ action_223,+ action_224,+ action_225,+ action_226,+ action_227,+ action_228,+ action_229,+ action_230,+ action_231 :: () => Int -> ({-HappyReduction (CM) = -}+	   Int +	-> (Lexeme)+	-> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)+	-> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)] +	-> HappyStk HappyAbsSyn +	-> [(Lexeme)] -> (CM) HappyAbsSyn)++happyReduce_2,+ happyReduce_3,+ happyReduce_4,+ happyReduce_5,+ happyReduce_6,+ happyReduce_7,+ happyReduce_8,+ happyReduce_9,+ happyReduce_10,+ happyReduce_11,+ happyReduce_12,+ happyReduce_13,+ happyReduce_14,+ happyReduce_15,+ happyReduce_16,+ happyReduce_17,+ happyReduce_18,+ happyReduce_19,+ happyReduce_20,+ happyReduce_21,+ happyReduce_22,+ happyReduce_23,+ happyReduce_24,+ happyReduce_25,+ happyReduce_26,+ happyReduce_27,+ happyReduce_28,+ happyReduce_29,+ happyReduce_30,+ happyReduce_31,+ happyReduce_32,+ happyReduce_33,+ happyReduce_34,+ happyReduce_35,+ happyReduce_36,+ happyReduce_37,+ happyReduce_38,+ happyReduce_39,+ happyReduce_40,+ happyReduce_41,+ happyReduce_42,+ happyReduce_43,+ happyReduce_44,+ happyReduce_45,+ happyReduce_46,+ happyReduce_47,+ happyReduce_48,+ happyReduce_49,+ happyReduce_50,+ happyReduce_51,+ happyReduce_52,+ happyReduce_53,+ happyReduce_54,+ happyReduce_55,+ happyReduce_56,+ happyReduce_57,+ happyReduce_58,+ happyReduce_59,+ happyReduce_60,+ happyReduce_61,+ happyReduce_62,+ happyReduce_63,+ happyReduce_64,+ happyReduce_65,+ happyReduce_66,+ happyReduce_67,+ happyReduce_68,+ happyReduce_69,+ happyReduce_70,+ happyReduce_71,+ happyReduce_72,+ happyReduce_73,+ happyReduce_74,+ happyReduce_75,+ happyReduce_76,+ happyReduce_77,+ happyReduce_78,+ happyReduce_79,+ happyReduce_80,+ happyReduce_81,+ happyReduce_82,+ happyReduce_83,+ happyReduce_84,+ happyReduce_85,+ happyReduce_86,+ happyReduce_87,+ happyReduce_88,+ happyReduce_89,+ happyReduce_90,+ happyReduce_91,+ happyReduce_92,+ happyReduce_93,+ happyReduce_94,+ happyReduce_95,+ happyReduce_96,+ happyReduce_97,+ happyReduce_98,+ happyReduce_99,+ happyReduce_100,+ happyReduce_101,+ happyReduce_102,+ happyReduce_103,+ happyReduce_104,+ happyReduce_105,+ happyReduce_106,+ happyReduce_107,+ happyReduce_108,+ happyReduce_109,+ happyReduce_110,+ happyReduce_111,+ happyReduce_112,+ happyReduce_113,+ happyReduce_114 :: () => ({-HappyReduction (CM) = -}+	   Int +	-> (Lexeme)+	-> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)+	-> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)] +	-> HappyStk HappyAbsSyn +	-> [(Lexeme)] -> (CM) HappyAbsSyn)++happyExpList :: Happy_Data_Array.Array Int Int+happyExpList = Happy_Data_Array.listArray (0,847) ([0,0,0,0,0,0,0,0,0,0,65408,58371,0,33312,31,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,4100,0,0,0,0,0,64,63520,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,61440,15,0,0,0,0,0,0,896,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8192,0,0,0,0,0,0,4096,124,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8188,1824,0,64529,0,0,0,0,0,0,0,2,0,0,0,0,0,0,16,0,0,0,0,0,0,128,0,0,0,0,0,0,1024,0,0,0,4094,896,32768,32264,0,0,0,0,0,0,0,1,0,0,0,0,0,0,8,0,0,0,0,0,0,64,0,0,57344,255,56,32768,2016,0,0,0,2047,456,16384,16132,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,512,16384,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,0,1,0,0,0,0,0,0,0,512,0,0,0,0,0,0,4096,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,31760,0,0,0,65504,14592,0,57480,7,0,0,0,0,0,0,16,0,0,63488,63,14,8192,504,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,65408,57347,0,33312,31,0,0,64512,31,7,4352,252,0,0,57344,255,56,34816,2016,0,0,0,2047,448,16384,16132,0,0,0,16376,3584,0,63522,1,0,0,65472,28673,0,49424,15,0,0,65024,32783,3,2176,126,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8188,1792,0,64529,0,0,0,65504,14336,0,57480,7,0,0,0,0,0,1024,31,0,0,0,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,4096,0,0,0,0,0,0,0,1,0,0,0,0,0,0,4,0,0,0,0,128,0,0,0,0,0,0,1024,32768,0,0,0,0,0,2048,0,0,0,0,0,0,512,0,0,0,0,0,0,0,2,0,2,0,0,65280,51719,1,1088,63,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3072,0,0,0,0,0,0,24576,0,0,0,0,0,0,0,3,0,0,0,0,0,0,24,0,0,0,0,0,0,192,0,0,0,0,0,0,1536,0,0,0,0,0,0,49152,0,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,2048,0,0,0,0,0,0,32768,0,0,0,0,0,512,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,512,0,0,0,64512,31,7,4352,252,0,0,57344,255,57,34816,2016,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,32768,0,0,0,0,0,0,0,0,256,0,0,0,0,0,0,0,0,0,0,57344,1,0,16,0,0,0,0,0,0,0,2,0,0,0,0,0,1024,16,0,0,0,0,0,0,128,0,0,49152,511,112,4096,4033,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,512,8,0,0,0,0,0,0,0,0,0,57344,16639,57,34816,2016,0,0,0,0,64,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,4,0,0,0,0,32,0,0,0,0,0,0,0,0,256,0,0,0,0,0,0,0,0,0,0,8188,1832,0,64529,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0,8,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,192,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,61440,32895,28,17408,1008,0,0,0,0,0,0,2,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,65280,49159,1,1088,63,0,0,0,0,512,16384,0,0,0,49152,511,114,4096,4033,0,0,0,0,0,0,0,0,0,0,0,0,1024,0,0,0,0,0,0,0,1024,0,0,0,0,0,1024,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,128,0,1,0,0,0,0,128,0,256,0,0,32768,1023,228,8192,8066,0,0,0,0,0,0,16400,0,0,0,65504,14656,0,57480,7,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,4096,0,8,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,32768,15,0,0,64,2,0,0,0,0,0,0,8,0,0,0,1024,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8196,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,31,0,0,128,4,0,0,248,0,0,1024,32,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,4094,912,32768,32264,0,0,0,0,0,0,128,0,0,0,0,0,3,0,0,0,0,0,0,256,8192,0,0,0,0,0,2048,0,1,0,0,63488,0,0,0,8196,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,128,4096,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,57344,3,0,0,32784,0,0,0,0,0,0,0,0,0,0,248,0,0,1024,32,0,0,0,0,0,0,0,0,0,0,0,0,0,1024,0,0,0,0,0,0,8192,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0+	])++{-# NOINLINE happyExpListPerState #-}+happyExpListPerState st =+    token_strs_expected+  where token_strs = ["error","%dummy","%start_fregelparser","%start_exprparser","programSpecs","programSpec","recordSpecs","recordSpec","fieldSpecs","fieldSpec","field","type","types","opt_deriving","deriving_constructors","exprWithSmplDefs","smplDefs","smplDef","defFun","defVar","defTuple","defVertComp","var","vars","csVars","expr","expr8","expr7","expr6","expr5","expr4","op4","expr3","op3","expr2","dhsFields","tableExpr","expr1","termination","predExpr","expr0","expr0s","csExprs","gen","agg","constructor","constVal","T_INT","T_BOOL","T_DOUBLE","T_STRING","T_PAIR","A_SUM","A_PROD","A_MINIMUM","A_MAXIMUM","A_OR","A_AND","A_RANDOM","G_FREGEL","G_GMAP","G_GZIP","G_GITER","TC_FIX","TC_ITER","TC_UNTIL","TC_WHILE","DATA","DERIVING","LET","IN","IF","THEN","ELSE","CURR","PREV","VAL","IS","RS","GOF","EQUAL","DBLCOLON","COMMA","SEMICOLON","BACKSLASH","RARROW","LARROW","DOTHAT","PIPE","DBLAND","DBLOR","EQ","NE","LT","LE","GT","GE","PLUS","MINUS","AST","SLASH","BACKQUOTE","LPAREN","RPAREN","LBRACE","RBRACE","LBRACKET","RBRACKET","BOOL","INT","FLOAT","STRING","IDENT","CONSTRUCTOR","%eof"]+        bit_start = st * 115+        bit_end = (st + 1) * 115+        read_bit = readArrayBit happyExpList+        bits = map read_bit [bit_start..bit_end - 1]+        bits_indexed = zip bits [0..114]+        token_strs_expected = concatMap f bits_indexed+        f (False, _) = []+        f (True, nr) = [token_strs !! nr]++action_0 (5) = happyGoto action_43+action_0 (6) = happyGoto action_3+action_0 (7) = happyGoto action_4+action_0 _ = happyReduce_5++action_1 (53) = happyShift action_20+action_1 (54) = happyShift action_21+action_1 (55) = happyShift action_22+action_1 (56) = happyShift action_23+action_1 (57) = happyShift action_24+action_1 (58) = happyShift action_25+action_1 (59) = happyShift action_26+action_1 (60) = happyShift action_27+action_1 (61) = happyShift action_28+action_1 (62) = happyShift action_29+action_1 (63) = happyShift action_30+action_1 (72) = happyShift action_31+action_1 (75) = happyShift action_32+action_1 (76) = happyShift action_33+action_1 (77) = happyShift action_34+action_1 (99) = happyShift action_35+action_1 (103) = happyShift action_36+action_1 (109) = happyShift action_37+action_1 (110) = happyShift action_38+action_1 (111) = happyShift action_39+action_1 (112) = happyShift action_40+action_1 (113) = happyShift action_41+action_1 (114) = happyShift action_42+action_1 (23) = happyGoto action_5+action_1 (26) = happyGoto action_6+action_1 (27) = happyGoto action_7+action_1 (28) = happyGoto action_8+action_1 (29) = happyGoto action_9+action_1 (30) = happyGoto action_10+action_1 (31) = happyGoto action_11+action_1 (33) = happyGoto action_12+action_1 (35) = happyGoto action_13+action_1 (37) = happyGoto action_14+action_1 (38) = happyGoto action_15+action_1 (41) = happyGoto action_16+action_1 (45) = happyGoto action_17+action_1 (46) = happyGoto action_18+action_1 (47) = happyGoto action_19+action_1 _ = happyFail (happyExpListPerState 1)++action_2 (6) = happyGoto action_3+action_2 (7) = happyGoto action_4+action_2 _ = happyFail (happyExpListPerState 2)++action_3 _ = happyReduce_2++action_4 (68) = happyShift action_85+action_4 (103) = happyShift action_86+action_4 (113) = happyShift action_41+action_4 (8) = happyGoto action_78+action_4 (18) = happyGoto action_79+action_4 (19) = happyGoto action_80+action_4 (20) = happyGoto action_81+action_4 (21) = happyGoto action_82+action_4 (22) = happyGoto action_83+action_4 (23) = happyGoto action_84+action_4 _ = happyFail (happyExpListPerState 4)++action_5 (88) = happyShift action_77+action_5 (103) = happyShift action_36+action_5 (109) = happyShift action_37+action_5 (110) = happyShift action_38+action_5 (111) = happyShift action_39+action_5 (112) = happyShift action_40+action_5 (113) = happyShift action_41+action_5 (23) = happyGoto action_56+action_5 (41) = happyGoto action_57+action_5 (42) = happyGoto action_76+action_5 (47) = happyGoto action_19+action_5 _ = happyReduce_92++action_6 (1) = happyAccept+action_6 _ = happyFail (happyExpListPerState 6)++action_7 _ = happyReduce_44++action_8 (91) = happyShift action_75+action_8 _ = happyReduce_46++action_9 (90) = happyShift action_74+action_9 _ = happyReduce_48++action_10 _ = happyReduce_50++action_11 (92) = happyShift action_66+action_11 (93) = happyShift action_67+action_11 (94) = happyShift action_68+action_11 (95) = happyShift action_69+action_11 (96) = happyShift action_70+action_11 (97) = happyShift action_71+action_11 (98) = happyShift action_72+action_11 (99) = happyShift action_73+action_11 (32) = happyGoto action_65+action_11 _ = happyReduce_57++action_12 (100) = happyShift action_62+action_12 (101) = happyShift action_63+action_12 (102) = happyShift action_64+action_12 (34) = happyGoto action_61+action_12 _ = happyReduce_60++action_13 _ = happyReduce_65++action_14 (88) = happyShift action_60+action_14 _ = happyReduce_69++action_15 _ = happyReduce_71++action_16 _ = happyReduce_80++action_17 (107) = happyShift action_59+action_17 _ = happyFail (happyExpListPerState 17)++action_18 (103) = happyShift action_36+action_18 (109) = happyShift action_37+action_18 (110) = happyShift action_38+action_18 (111) = happyShift action_39+action_18 (112) = happyShift action_40+action_18 (113) = happyShift action_41+action_18 (23) = happyGoto action_56+action_18 (41) = happyGoto action_57+action_18 (42) = happyGoto action_58+action_18 (47) = happyGoto action_19+action_18 _ = happyFail (happyExpListPerState 18)++action_19 _ = happyReduce_91++action_20 _ = happyReduce_105++action_21 _ = happyReduce_106++action_22 _ = happyReduce_103++action_23 _ = happyReduce_104++action_24 _ = happyReduce_108++action_25 _ = happyReduce_107++action_26 (53) = happyShift action_20+action_26 (54) = happyShift action_21+action_26 (55) = happyShift action_22+action_26 (56) = happyShift action_23+action_26 (57) = happyShift action_24+action_26 (58) = happyShift action_25+action_26 (59) = happyShift action_26+action_26 (60) = happyShift action_27+action_26 (61) = happyShift action_28+action_26 (62) = happyShift action_29+action_26 (63) = happyShift action_30+action_26 (72) = happyShift action_31+action_26 (75) = happyShift action_32+action_26 (76) = happyShift action_33+action_26 (77) = happyShift action_34+action_26 (99) = happyShift action_35+action_26 (103) = happyShift action_36+action_26 (109) = happyShift action_37+action_26 (110) = happyShift action_38+action_26 (111) = happyShift action_39+action_26 (112) = happyShift action_40+action_26 (113) = happyShift action_41+action_26 (114) = happyShift action_42+action_26 (23) = happyGoto action_5+action_26 (26) = happyGoto action_55+action_26 (27) = happyGoto action_7+action_26 (28) = happyGoto action_8+action_26 (29) = happyGoto action_9+action_26 (30) = happyGoto action_10+action_26 (31) = happyGoto action_11+action_26 (33) = happyGoto action_12+action_26 (35) = happyGoto action_13+action_26 (37) = happyGoto action_14+action_26 (38) = happyGoto action_15+action_26 (41) = happyGoto action_16+action_26 (45) = happyGoto action_17+action_26 (46) = happyGoto action_18+action_26 (47) = happyGoto action_19+action_26 _ = happyFail (happyExpListPerState 26)++action_27 (113) = happyShift action_41+action_27 (23) = happyGoto action_54+action_27 _ = happyFail (happyExpListPerState 27)++action_28 (113) = happyShift action_41+action_28 (23) = happyGoto action_53+action_28 _ = happyFail (happyExpListPerState 28)++action_29 (113) = happyShift action_41+action_29 (23) = happyGoto action_52+action_29 _ = happyFail (happyExpListPerState 29)++action_30 (113) = happyShift action_41+action_30 (23) = happyGoto action_51+action_30 _ = happyFail (happyExpListPerState 30)++action_31 (53) = happyShift action_20+action_31 (54) = happyShift action_21+action_31 (55) = happyShift action_22+action_31 (56) = happyShift action_23+action_31 (57) = happyShift action_24+action_31 (58) = happyShift action_25+action_31 (59) = happyShift action_26+action_31 (60) = happyShift action_27+action_31 (61) = happyShift action_28+action_31 (62) = happyShift action_29+action_31 (63) = happyShift action_30+action_31 (75) = happyShift action_32+action_31 (76) = happyShift action_33+action_31 (77) = happyShift action_34+action_31 (99) = happyShift action_35+action_31 (103) = happyShift action_36+action_31 (109) = happyShift action_37+action_31 (110) = happyShift action_38+action_31 (111) = happyShift action_39+action_31 (112) = happyShift action_40+action_31 (113) = happyShift action_41+action_31 (114) = happyShift action_42+action_31 (23) = happyGoto action_5+action_31 (28) = happyGoto action_50+action_31 (29) = happyGoto action_9+action_31 (30) = happyGoto action_10+action_31 (31) = happyGoto action_11+action_31 (33) = happyGoto action_12+action_31 (35) = happyGoto action_13+action_31 (37) = happyGoto action_14+action_31 (38) = happyGoto action_15+action_31 (41) = happyGoto action_16+action_31 (45) = happyGoto action_17+action_31 (46) = happyGoto action_18+action_31 (47) = happyGoto action_19+action_31 _ = happyFail (happyExpListPerState 31)++action_32 (113) = happyShift action_41+action_32 (23) = happyGoto action_49+action_32 _ = happyFail (happyExpListPerState 32)++action_33 (113) = happyShift action_41+action_33 (23) = happyGoto action_48+action_33 _ = happyFail (happyExpListPerState 33)++action_34 (113) = happyShift action_41+action_34 (23) = happyGoto action_47+action_34 _ = happyFail (happyExpListPerState 34)++action_35 (53) = happyShift action_20+action_35 (54) = happyShift action_21+action_35 (55) = happyShift action_22+action_35 (56) = happyShift action_23+action_35 (57) = happyShift action_24+action_35 (58) = happyShift action_25+action_35 (59) = happyShift action_26+action_35 (60) = happyShift action_27+action_35 (61) = happyShift action_28+action_35 (62) = happyShift action_29+action_35 (63) = happyShift action_30+action_35 (75) = happyShift action_32+action_35 (76) = happyShift action_33+action_35 (77) = happyShift action_34+action_35 (103) = happyShift action_36+action_35 (109) = happyShift action_37+action_35 (110) = happyShift action_38+action_35 (111) = happyShift action_39+action_35 (112) = happyShift action_40+action_35 (113) = happyShift action_41+action_35 (114) = happyShift action_42+action_35 (23) = happyGoto action_5+action_35 (35) = happyGoto action_46+action_35 (37) = happyGoto action_14+action_35 (38) = happyGoto action_15+action_35 (41) = happyGoto action_16+action_35 (45) = happyGoto action_17+action_35 (46) = happyGoto action_18+action_35 (47) = happyGoto action_19+action_35 _ = happyFail (happyExpListPerState 35)++action_36 (53) = happyShift action_20+action_36 (54) = happyShift action_21+action_36 (55) = happyShift action_22+action_36 (56) = happyShift action_23+action_36 (57) = happyShift action_24+action_36 (58) = happyShift action_25+action_36 (59) = happyShift action_26+action_36 (60) = happyShift action_27+action_36 (61) = happyShift action_28+action_36 (62) = happyShift action_29+action_36 (63) = happyShift action_30+action_36 (72) = happyShift action_31+action_36 (75) = happyShift action_32+action_36 (76) = happyShift action_33+action_36 (77) = happyShift action_34+action_36 (99) = happyShift action_35+action_36 (103) = happyShift action_36+action_36 (109) = happyShift action_37+action_36 (110) = happyShift action_38+action_36 (111) = happyShift action_39+action_36 (112) = happyShift action_40+action_36 (113) = happyShift action_41+action_36 (114) = happyShift action_42+action_36 (23) = happyGoto action_5+action_36 (26) = happyGoto action_45+action_36 (27) = happyGoto action_7+action_36 (28) = happyGoto action_8+action_36 (29) = happyGoto action_9+action_36 (30) = happyGoto action_10+action_36 (31) = happyGoto action_11+action_36 (33) = happyGoto action_12+action_36 (35) = happyGoto action_13+action_36 (37) = happyGoto action_14+action_36 (38) = happyGoto action_15+action_36 (41) = happyGoto action_16+action_36 (45) = happyGoto action_17+action_36 (46) = happyGoto action_18+action_36 (47) = happyGoto action_19+action_36 _ = happyFail (happyExpListPerState 36)++action_37 _ = happyReduce_113++action_38 _ = happyReduce_111++action_39 _ = happyReduce_112++action_40 _ = happyReduce_114++action_41 _ = happyReduce_39++action_42 _ = happyReduce_110++action_43 (84) = happyShift action_44+action_43 (115) = happyAccept+action_43 _ = happyFail (happyExpListPerState 43)++action_44 (6) = happyGoto action_117+action_44 (7) = happyGoto action_4+action_44 _ = happyReduce_5++action_45 (83) = happyShift action_115+action_45 (104) = happyShift action_116+action_45 _ = happyFail (happyExpListPerState 45)++action_46 _ = happyReduce_64++action_47 _ = happyReduce_76++action_48 _ = happyReduce_75++action_49 _ = happyReduce_74++action_50 (73) = happyShift action_114+action_50 (91) = happyShift action_75+action_50 _ = happyFail (happyExpListPerState 50)++action_51 (113) = happyShift action_41+action_51 (23) = happyGoto action_113+action_51 _ = happyFail (happyExpListPerState 51)++action_52 (113) = happyShift action_41+action_52 (23) = happyGoto action_112+action_52 _ = happyFail (happyExpListPerState 52)++action_53 (113) = happyShift action_41+action_53 (23) = happyGoto action_111+action_53 _ = happyFail (happyExpListPerState 53)++action_54 (113) = happyShift action_41+action_54 (23) = happyGoto action_110+action_54 _ = happyFail (happyExpListPerState 54)++action_55 _ = happyReduce_109++action_56 _ = happyReduce_92++action_57 _ = happyReduce_95++action_58 (103) = happyShift action_36+action_58 (109) = happyShift action_37+action_58 (110) = happyShift action_38+action_58 (111) = happyShift action_39+action_58 (112) = happyShift action_40+action_58 (113) = happyShift action_41+action_58 (23) = happyGoto action_56+action_58 (41) = happyGoto action_96+action_58 (47) = happyGoto action_19+action_58 _ = happyReduce_78++action_59 (53) = happyShift action_20+action_59 (54) = happyShift action_21+action_59 (55) = happyShift action_22+action_59 (56) = happyShift action_23+action_59 (57) = happyShift action_24+action_59 (58) = happyShift action_25+action_59 (59) = happyShift action_26+action_59 (60) = happyShift action_27+action_59 (61) = happyShift action_28+action_59 (62) = happyShift action_29+action_59 (63) = happyShift action_30+action_59 (72) = happyShift action_31+action_59 (75) = happyShift action_32+action_59 (76) = happyShift action_33+action_59 (77) = happyShift action_34+action_59 (99) = happyShift action_35+action_59 (103) = happyShift action_36+action_59 (109) = happyShift action_37+action_59 (110) = happyShift action_38+action_59 (111) = happyShift action_39+action_59 (112) = happyShift action_40+action_59 (113) = happyShift action_41+action_59 (114) = happyShift action_42+action_59 (23) = happyGoto action_5+action_59 (26) = happyGoto action_109+action_59 (27) = happyGoto action_7+action_59 (28) = happyGoto action_8+action_59 (29) = happyGoto action_9+action_59 (30) = happyGoto action_10+action_59 (31) = happyGoto action_11+action_59 (33) = happyGoto action_12+action_59 (35) = happyGoto action_13+action_59 (37) = happyGoto action_14+action_59 (38) = happyGoto action_15+action_59 (41) = happyGoto action_16+action_59 (45) = happyGoto action_17+action_59 (46) = happyGoto action_18+action_59 (47) = happyGoto action_19+action_59 _ = happyFail (happyExpListPerState 59)++action_60 (113) = happyShift action_95+action_60 (11) = happyGoto action_93+action_60 (36) = happyGoto action_108+action_60 _ = happyFail (happyExpListPerState 60)++action_61 (53) = happyShift action_20+action_61 (54) = happyShift action_21+action_61 (55) = happyShift action_22+action_61 (56) = happyShift action_23+action_61 (57) = happyShift action_24+action_61 (58) = happyShift action_25+action_61 (59) = happyShift action_26+action_61 (60) = happyShift action_27+action_61 (61) = happyShift action_28+action_61 (62) = happyShift action_29+action_61 (63) = happyShift action_30+action_61 (75) = happyShift action_32+action_61 (76) = happyShift action_33+action_61 (77) = happyShift action_34+action_61 (103) = happyShift action_36+action_61 (109) = happyShift action_37+action_61 (110) = happyShift action_38+action_61 (111) = happyShift action_39+action_61 (112) = happyShift action_40+action_61 (113) = happyShift action_41+action_61 (114) = happyShift action_42+action_61 (23) = happyGoto action_5+action_61 (35) = happyGoto action_107+action_61 (37) = happyGoto action_14+action_61 (38) = happyGoto action_15+action_61 (41) = happyGoto action_16+action_61 (45) = happyGoto action_17+action_61 (46) = happyGoto action_18+action_61 (47) = happyGoto action_19+action_61 _ = happyFail (happyExpListPerState 61)++action_62 _ = happyReduce_66++action_63 _ = happyReduce_67++action_64 (113) = happyShift action_41+action_64 (23) = happyGoto action_106+action_64 _ = happyFail (happyExpListPerState 64)++action_65 (53) = happyShift action_20+action_65 (54) = happyShift action_21+action_65 (55) = happyShift action_22+action_65 (56) = happyShift action_23+action_65 (57) = happyShift action_24+action_65 (58) = happyShift action_25+action_65 (59) = happyShift action_26+action_65 (60) = happyShift action_27+action_65 (61) = happyShift action_28+action_65 (62) = happyShift action_29+action_65 (63) = happyShift action_30+action_65 (75) = happyShift action_32+action_65 (76) = happyShift action_33+action_65 (77) = happyShift action_34+action_65 (99) = happyShift action_35+action_65 (103) = happyShift action_36+action_65 (109) = happyShift action_37+action_65 (110) = happyShift action_38+action_65 (111) = happyShift action_39+action_65 (112) = happyShift action_40+action_65 (113) = happyShift action_41+action_65 (114) = happyShift action_42+action_65 (23) = happyGoto action_5+action_65 (33) = happyGoto action_105+action_65 (35) = happyGoto action_13+action_65 (37) = happyGoto action_14+action_65 (38) = happyGoto action_15+action_65 (41) = happyGoto action_16+action_65 (45) = happyGoto action_17+action_65 (46) = happyGoto action_18+action_65 (47) = happyGoto action_19+action_65 _ = happyFail (happyExpListPerState 65)++action_66 (53) = happyShift action_20+action_66 (54) = happyShift action_21+action_66 (55) = happyShift action_22+action_66 (56) = happyShift action_23+action_66 (57) = happyShift action_24+action_66 (58) = happyShift action_25+action_66 (59) = happyShift action_26+action_66 (60) = happyShift action_27+action_66 (61) = happyShift action_28+action_66 (62) = happyShift action_29+action_66 (63) = happyShift action_30+action_66 (75) = happyShift action_32+action_66 (76) = happyShift action_33+action_66 (77) = happyShift action_34+action_66 (99) = happyShift action_35+action_66 (103) = happyShift action_36+action_66 (109) = happyShift action_37+action_66 (110) = happyShift action_38+action_66 (111) = happyShift action_39+action_66 (112) = happyShift action_40+action_66 (113) = happyShift action_41+action_66 (114) = happyShift action_42+action_66 (23) = happyGoto action_5+action_66 (31) = happyGoto action_104+action_66 (33) = happyGoto action_12+action_66 (35) = happyGoto action_13+action_66 (37) = happyGoto action_14+action_66 (38) = happyGoto action_15+action_66 (41) = happyGoto action_16+action_66 (45) = happyGoto action_17+action_66 (46) = happyGoto action_18+action_66 (47) = happyGoto action_19+action_66 _ = happyFail (happyExpListPerState 66)++action_67 (53) = happyShift action_20+action_67 (54) = happyShift action_21+action_67 (55) = happyShift action_22+action_67 (56) = happyShift action_23+action_67 (57) = happyShift action_24+action_67 (58) = happyShift action_25+action_67 (59) = happyShift action_26+action_67 (60) = happyShift action_27+action_67 (61) = happyShift action_28+action_67 (62) = happyShift action_29+action_67 (63) = happyShift action_30+action_67 (75) = happyShift action_32+action_67 (76) = happyShift action_33+action_67 (77) = happyShift action_34+action_67 (99) = happyShift action_35+action_67 (103) = happyShift action_36+action_67 (109) = happyShift action_37+action_67 (110) = happyShift action_38+action_67 (111) = happyShift action_39+action_67 (112) = happyShift action_40+action_67 (113) = happyShift action_41+action_67 (114) = happyShift action_42+action_67 (23) = happyGoto action_5+action_67 (31) = happyGoto action_103+action_67 (33) = happyGoto action_12+action_67 (35) = happyGoto action_13+action_67 (37) = happyGoto action_14+action_67 (38) = happyGoto action_15+action_67 (41) = happyGoto action_16+action_67 (45) = happyGoto action_17+action_67 (46) = happyGoto action_18+action_67 (47) = happyGoto action_19+action_67 _ = happyFail (happyExpListPerState 67)++action_68 (53) = happyShift action_20+action_68 (54) = happyShift action_21+action_68 (55) = happyShift action_22+action_68 (56) = happyShift action_23+action_68 (57) = happyShift action_24+action_68 (58) = happyShift action_25+action_68 (59) = happyShift action_26+action_68 (60) = happyShift action_27+action_68 (61) = happyShift action_28+action_68 (62) = happyShift action_29+action_68 (63) = happyShift action_30+action_68 (75) = happyShift action_32+action_68 (76) = happyShift action_33+action_68 (77) = happyShift action_34+action_68 (99) = happyShift action_35+action_68 (103) = happyShift action_36+action_68 (109) = happyShift action_37+action_68 (110) = happyShift action_38+action_68 (111) = happyShift action_39+action_68 (112) = happyShift action_40+action_68 (113) = happyShift action_41+action_68 (114) = happyShift action_42+action_68 (23) = happyGoto action_5+action_68 (31) = happyGoto action_102+action_68 (33) = happyGoto action_12+action_68 (35) = happyGoto action_13+action_68 (37) = happyGoto action_14+action_68 (38) = happyGoto action_15+action_68 (41) = happyGoto action_16+action_68 (45) = happyGoto action_17+action_68 (46) = happyGoto action_18+action_68 (47) = happyGoto action_19+action_68 _ = happyFail (happyExpListPerState 68)++action_69 (53) = happyShift action_20+action_69 (54) = happyShift action_21+action_69 (55) = happyShift action_22+action_69 (56) = happyShift action_23+action_69 (57) = happyShift action_24+action_69 (58) = happyShift action_25+action_69 (59) = happyShift action_26+action_69 (60) = happyShift action_27+action_69 (61) = happyShift action_28+action_69 (62) = happyShift action_29+action_69 (63) = happyShift action_30+action_69 (75) = happyShift action_32+action_69 (76) = happyShift action_33+action_69 (77) = happyShift action_34+action_69 (99) = happyShift action_35+action_69 (103) = happyShift action_36+action_69 (109) = happyShift action_37+action_69 (110) = happyShift action_38+action_69 (111) = happyShift action_39+action_69 (112) = happyShift action_40+action_69 (113) = happyShift action_41+action_69 (114) = happyShift action_42+action_69 (23) = happyGoto action_5+action_69 (31) = happyGoto action_101+action_69 (33) = happyGoto action_12+action_69 (35) = happyGoto action_13+action_69 (37) = happyGoto action_14+action_69 (38) = happyGoto action_15+action_69 (41) = happyGoto action_16+action_69 (45) = happyGoto action_17+action_69 (46) = happyGoto action_18+action_69 (47) = happyGoto action_19+action_69 _ = happyFail (happyExpListPerState 69)++action_70 (53) = happyShift action_20+action_70 (54) = happyShift action_21+action_70 (55) = happyShift action_22+action_70 (56) = happyShift action_23+action_70 (57) = happyShift action_24+action_70 (58) = happyShift action_25+action_70 (59) = happyShift action_26+action_70 (60) = happyShift action_27+action_70 (61) = happyShift action_28+action_70 (62) = happyShift action_29+action_70 (63) = happyShift action_30+action_70 (75) = happyShift action_32+action_70 (76) = happyShift action_33+action_70 (77) = happyShift action_34+action_70 (99) = happyShift action_35+action_70 (103) = happyShift action_36+action_70 (109) = happyShift action_37+action_70 (110) = happyShift action_38+action_70 (111) = happyShift action_39+action_70 (112) = happyShift action_40+action_70 (113) = happyShift action_41+action_70 (114) = happyShift action_42+action_70 (23) = happyGoto action_5+action_70 (31) = happyGoto action_100+action_70 (33) = happyGoto action_12+action_70 (35) = happyGoto action_13+action_70 (37) = happyGoto action_14+action_70 (38) = happyGoto action_15+action_70 (41) = happyGoto action_16+action_70 (45) = happyGoto action_17+action_70 (46) = happyGoto action_18+action_70 (47) = happyGoto action_19+action_70 _ = happyFail (happyExpListPerState 70)++action_71 (53) = happyShift action_20+action_71 (54) = happyShift action_21+action_71 (55) = happyShift action_22+action_71 (56) = happyShift action_23+action_71 (57) = happyShift action_24+action_71 (58) = happyShift action_25+action_71 (59) = happyShift action_26+action_71 (60) = happyShift action_27+action_71 (61) = happyShift action_28+action_71 (62) = happyShift action_29+action_71 (63) = happyShift action_30+action_71 (75) = happyShift action_32+action_71 (76) = happyShift action_33+action_71 (77) = happyShift action_34+action_71 (99) = happyShift action_35+action_71 (103) = happyShift action_36+action_71 (109) = happyShift action_37+action_71 (110) = happyShift action_38+action_71 (111) = happyShift action_39+action_71 (112) = happyShift action_40+action_71 (113) = happyShift action_41+action_71 (114) = happyShift action_42+action_71 (23) = happyGoto action_5+action_71 (31) = happyGoto action_99+action_71 (33) = happyGoto action_12+action_71 (35) = happyGoto action_13+action_71 (37) = happyGoto action_14+action_71 (38) = happyGoto action_15+action_71 (41) = happyGoto action_16+action_71 (45) = happyGoto action_17+action_71 (46) = happyGoto action_18+action_71 (47) = happyGoto action_19+action_71 _ = happyFail (happyExpListPerState 71)++action_72 _ = happyReduce_61++action_73 _ = happyReduce_62++action_74 (53) = happyShift action_20+action_74 (54) = happyShift action_21+action_74 (55) = happyShift action_22+action_74 (56) = happyShift action_23+action_74 (57) = happyShift action_24+action_74 (58) = happyShift action_25+action_74 (59) = happyShift action_26+action_74 (60) = happyShift action_27+action_74 (61) = happyShift action_28+action_74 (62) = happyShift action_29+action_74 (63) = happyShift action_30+action_74 (75) = happyShift action_32+action_74 (76) = happyShift action_33+action_74 (77) = happyShift action_34+action_74 (99) = happyShift action_35+action_74 (103) = happyShift action_36+action_74 (109) = happyShift action_37+action_74 (110) = happyShift action_38+action_74 (111) = happyShift action_39+action_74 (112) = happyShift action_40+action_74 (113) = happyShift action_41+action_74 (114) = happyShift action_42+action_74 (23) = happyGoto action_5+action_74 (30) = happyGoto action_98+action_74 (31) = happyGoto action_11+action_74 (33) = happyGoto action_12+action_74 (35) = happyGoto action_13+action_74 (37) = happyGoto action_14+action_74 (38) = happyGoto action_15+action_74 (41) = happyGoto action_16+action_74 (45) = happyGoto action_17+action_74 (46) = happyGoto action_18+action_74 (47) = happyGoto action_19+action_74 _ = happyFail (happyExpListPerState 74)++action_75 (53) = happyShift action_20+action_75 (54) = happyShift action_21+action_75 (55) = happyShift action_22+action_75 (56) = happyShift action_23+action_75 (57) = happyShift action_24+action_75 (58) = happyShift action_25+action_75 (59) = happyShift action_26+action_75 (60) = happyShift action_27+action_75 (61) = happyShift action_28+action_75 (62) = happyShift action_29+action_75 (63) = happyShift action_30+action_75 (75) = happyShift action_32+action_75 (76) = happyShift action_33+action_75 (77) = happyShift action_34+action_75 (99) = happyShift action_35+action_75 (103) = happyShift action_36+action_75 (109) = happyShift action_37+action_75 (110) = happyShift action_38+action_75 (111) = happyShift action_39+action_75 (112) = happyShift action_40+action_75 (113) = happyShift action_41+action_75 (114) = happyShift action_42+action_75 (23) = happyGoto action_5+action_75 (29) = happyGoto action_97+action_75 (30) = happyGoto action_10+action_75 (31) = happyGoto action_11+action_75 (33) = happyGoto action_12+action_75 (35) = happyGoto action_13+action_75 (37) = happyGoto action_14+action_75 (38) = happyGoto action_15+action_75 (41) = happyGoto action_16+action_75 (45) = happyGoto action_17+action_75 (46) = happyGoto action_18+action_75 (47) = happyGoto action_19+action_75 _ = happyFail (happyExpListPerState 75)++action_76 (103) = happyShift action_36+action_76 (109) = happyShift action_37+action_76 (110) = happyShift action_38+action_76 (111) = happyShift action_39+action_76 (112) = happyShift action_40+action_76 (113) = happyShift action_41+action_76 (23) = happyGoto action_56+action_76 (41) = happyGoto action_96+action_76 (47) = happyGoto action_19+action_76 _ = happyReduce_77++action_77 (113) = happyShift action_95+action_77 (11) = happyGoto action_93+action_77 (36) = happyGoto action_94+action_77 _ = happyFail (happyExpListPerState 77)++action_78 _ = happyReduce_6++action_79 _ = happyReduce_4++action_80 _ = happyReduce_31++action_81 _ = happyReduce_32++action_82 _ = happyReduce_33++action_83 _ = happyReduce_34++action_84 (81) = happyShift action_92+action_84 (113) = happyShift action_41+action_84 (23) = happyGoto action_90+action_84 (24) = happyGoto action_91+action_84 _ = happyFail (happyExpListPerState 84)++action_85 (114) = happyShift action_42+action_85 (46) = happyGoto action_89+action_85 _ = happyFail (happyExpListPerState 85)++action_86 (113) = happyShift action_41+action_86 (23) = happyGoto action_87+action_86 (25) = happyGoto action_88+action_86 _ = happyFail (happyExpListPerState 86)++action_87 (83) = happyShift action_136+action_87 _ = happyFail (happyExpListPerState 87)++action_88 (83) = happyShift action_134+action_88 (104) = happyShift action_135+action_88 _ = happyFail (happyExpListPerState 88)++action_89 (81) = happyShift action_133+action_89 _ = happyFail (happyExpListPerState 89)++action_90 (76) = happyShift action_132+action_90 _ = happyReduce_40++action_91 (81) = happyShift action_131+action_91 (113) = happyShift action_41+action_91 (23) = happyGoto action_130+action_91 _ = happyFail (happyExpListPerState 91)++action_92 (53) = happyShift action_20+action_92 (54) = happyShift action_21+action_92 (55) = happyShift action_22+action_92 (56) = happyShift action_23+action_92 (57) = happyShift action_24+action_92 (58) = happyShift action_25+action_92 (59) = happyShift action_26+action_92 (60) = happyShift action_27+action_92 (61) = happyShift action_28+action_92 (62) = happyShift action_29+action_92 (63) = happyShift action_30+action_92 (70) = happyShift action_129+action_92 (72) = happyShift action_31+action_92 (75) = happyShift action_32+action_92 (76) = happyShift action_33+action_92 (77) = happyShift action_34+action_92 (99) = happyShift action_35+action_92 (103) = happyShift action_36+action_92 (109) = happyShift action_37+action_92 (110) = happyShift action_38+action_92 (111) = happyShift action_39+action_92 (112) = happyShift action_40+action_92 (113) = happyShift action_41+action_92 (114) = happyShift action_42+action_92 (16) = happyGoto action_127+action_92 (23) = happyGoto action_5+action_92 (26) = happyGoto action_128+action_92 (27) = happyGoto action_7+action_92 (28) = happyGoto action_8+action_92 (29) = happyGoto action_9+action_92 (30) = happyGoto action_10+action_92 (31) = happyGoto action_11+action_92 (33) = happyGoto action_12+action_92 (35) = happyGoto action_13+action_92 (37) = happyGoto action_14+action_92 (38) = happyGoto action_15+action_92 (41) = happyGoto action_16+action_92 (45) = happyGoto action_17+action_92 (46) = happyGoto action_18+action_92 (47) = happyGoto action_19+action_92 _ = happyFail (happyExpListPerState 92)++action_93 _ = happyReduce_72++action_94 (88) = happyShift action_125+action_94 _ = happyReduce_70++action_95 _ = happyReduce_11++action_96 _ = happyReduce_96++action_97 (90) = happyShift action_74+action_97 _ = happyReduce_47++action_98 _ = happyReduce_49++action_99 (98) = happyShift action_72+action_99 (99) = happyShift action_73+action_99 (32) = happyGoto action_65+action_99 _ = happyReduce_52++action_100 (98) = happyShift action_72+action_100 (99) = happyShift action_73+action_100 (32) = happyGoto action_65+action_100 _ = happyReduce_55++action_101 (98) = happyShift action_72+action_101 (99) = happyShift action_73+action_101 (32) = happyGoto action_65+action_101 _ = happyReduce_51++action_102 (98) = happyShift action_72+action_102 (99) = happyShift action_73+action_102 (32) = happyGoto action_65+action_102 _ = happyReduce_56++action_103 (98) = happyShift action_72+action_103 (99) = happyShift action_73+action_103 (32) = happyGoto action_65+action_103 _ = happyReduce_54++action_104 (98) = happyShift action_72+action_104 (99) = happyShift action_73+action_104 (32) = happyGoto action_65+action_104 _ = happyReduce_53++action_105 (100) = happyShift action_62+action_105 (101) = happyShift action_63+action_105 (34) = happyGoto action_61+action_105 _ = happyReduce_59++action_106 (102) = happyShift action_126+action_106 _ = happyFail (happyExpListPerState 106)++action_107 _ = happyReduce_63++action_108 (88) = happyShift action_125+action_108 _ = happyReduce_68++action_109 (89) = happyShift action_124+action_109 _ = happyFail (happyExpListPerState 109)++action_110 (64) = happyShift action_121+action_110 (103) = happyShift action_122+action_110 (39) = happyGoto action_123+action_110 _ = happyFail (happyExpListPerState 110)++action_111 _ = happyReduce_82++action_112 _ = happyReduce_83++action_113 (64) = happyShift action_121+action_113 (103) = happyShift action_122+action_113 (39) = happyGoto action_120+action_113 _ = happyFail (happyExpListPerState 113)++action_114 (53) = happyShift action_20+action_114 (54) = happyShift action_21+action_114 (55) = happyShift action_22+action_114 (56) = happyShift action_23+action_114 (57) = happyShift action_24+action_114 (58) = happyShift action_25+action_114 (59) = happyShift action_26+action_114 (60) = happyShift action_27+action_114 (61) = happyShift action_28+action_114 (62) = happyShift action_29+action_114 (63) = happyShift action_30+action_114 (75) = happyShift action_32+action_114 (76) = happyShift action_33+action_114 (77) = happyShift action_34+action_114 (99) = happyShift action_35+action_114 (103) = happyShift action_36+action_114 (109) = happyShift action_37+action_114 (110) = happyShift action_38+action_114 (111) = happyShift action_39+action_114 (112) = happyShift action_40+action_114 (113) = happyShift action_41+action_114 (114) = happyShift action_42+action_114 (23) = happyGoto action_5+action_114 (28) = happyGoto action_119+action_114 (29) = happyGoto action_9+action_114 (30) = happyGoto action_10+action_114 (31) = happyGoto action_11+action_114 (33) = happyGoto action_12+action_114 (35) = happyGoto action_13+action_114 (37) = happyGoto action_14+action_114 (38) = happyGoto action_15+action_114 (41) = happyGoto action_16+action_114 (45) = happyGoto action_17+action_114 (46) = happyGoto action_18+action_114 (47) = happyGoto action_19+action_114 _ = happyFail (happyExpListPerState 114)++action_115 (53) = happyShift action_20+action_115 (54) = happyShift action_21+action_115 (55) = happyShift action_22+action_115 (56) = happyShift action_23+action_115 (57) = happyShift action_24+action_115 (58) = happyShift action_25+action_115 (59) = happyShift action_26+action_115 (60) = happyShift action_27+action_115 (61) = happyShift action_28+action_115 (62) = happyShift action_29+action_115 (63) = happyShift action_30+action_115 (72) = happyShift action_31+action_115 (75) = happyShift action_32+action_115 (76) = happyShift action_33+action_115 (77) = happyShift action_34+action_115 (99) = happyShift action_35+action_115 (103) = happyShift action_36+action_115 (109) = happyShift action_37+action_115 (110) = happyShift action_38+action_115 (111) = happyShift action_39+action_115 (112) = happyShift action_40+action_115 (113) = happyShift action_41+action_115 (114) = happyShift action_42+action_115 (23) = happyGoto action_5+action_115 (26) = happyGoto action_118+action_115 (27) = happyGoto action_7+action_115 (28) = happyGoto action_8+action_115 (29) = happyGoto action_9+action_115 (30) = happyGoto action_10+action_115 (31) = happyGoto action_11+action_115 (33) = happyGoto action_12+action_115 (35) = happyGoto action_13+action_115 (37) = happyGoto action_14+action_115 (38) = happyGoto action_15+action_115 (41) = happyGoto action_16+action_115 (45) = happyGoto action_17+action_115 (46) = happyGoto action_18+action_115 (47) = happyGoto action_19+action_115 _ = happyFail (happyExpListPerState 115)++action_116 _ = happyReduce_93++action_117 _ = happyReduce_3++action_118 (43) = happyGoto action_157+action_118 _ = happyReduce_97++action_119 (74) = happyShift action_156+action_119 (91) = happyShift action_75+action_119 _ = happyFail (happyExpListPerState 119)++action_120 (113) = happyShift action_41+action_120 (23) = happyGoto action_155+action_120 _ = happyFail (happyExpListPerState 120)++action_121 _ = happyReduce_85++action_122 (64) = happyShift action_121+action_122 (65) = happyShift action_152+action_122 (66) = happyShift action_153+action_122 (67) = happyShift action_154+action_122 (103) = happyShift action_122+action_122 (39) = happyGoto action_151+action_122 _ = happyFail (happyExpListPerState 122)++action_123 (113) = happyShift action_41+action_123 (23) = happyGoto action_150+action_123 _ = happyFail (happyExpListPerState 123)++action_124 (103) = happyShift action_149+action_124 (113) = happyShift action_41+action_124 (23) = happyGoto action_147+action_124 (44) = happyGoto action_148+action_124 _ = happyFail (happyExpListPerState 124)++action_125 (113) = happyShift action_95+action_125 (11) = happyGoto action_146+action_125 _ = happyFail (happyExpListPerState 125)++action_126 (53) = happyShift action_20+action_126 (54) = happyShift action_21+action_126 (55) = happyShift action_22+action_126 (56) = happyShift action_23+action_126 (57) = happyShift action_24+action_126 (58) = happyShift action_25+action_126 (59) = happyShift action_26+action_126 (60) = happyShift action_27+action_126 (61) = happyShift action_28+action_126 (62) = happyShift action_29+action_126 (63) = happyShift action_30+action_126 (75) = happyShift action_32+action_126 (76) = happyShift action_33+action_126 (77) = happyShift action_34+action_126 (99) = happyShift action_35+action_126 (103) = happyShift action_36+action_126 (109) = happyShift action_37+action_126 (110) = happyShift action_38+action_126 (111) = happyShift action_39+action_126 (112) = happyShift action_40+action_126 (113) = happyShift action_41+action_126 (114) = happyShift action_42+action_126 (23) = happyGoto action_5+action_126 (33) = happyGoto action_145+action_126 (35) = happyGoto action_13+action_126 (37) = happyGoto action_14+action_126 (38) = happyGoto action_15+action_126 (41) = happyGoto action_16+action_126 (45) = happyGoto action_17+action_126 (46) = happyGoto action_18+action_126 (47) = happyGoto action_19+action_126 _ = happyFail (happyExpListPerState 126)++action_127 _ = happyReduce_36++action_128 _ = happyReduce_28++action_129 (103) = happyShift action_86+action_129 (113) = happyShift action_41+action_129 (17) = happyGoto action_143+action_129 (18) = happyGoto action_144+action_129 (19) = happyGoto action_80+action_129 (20) = happyGoto action_81+action_129 (21) = happyGoto action_82+action_129 (22) = happyGoto action_83+action_129 (23) = happyGoto action_84+action_129 _ = happyFail (happyExpListPerState 129)++action_130 _ = happyReduce_41++action_131 (53) = happyShift action_20+action_131 (54) = happyShift action_21+action_131 (55) = happyShift action_22+action_131 (56) = happyShift action_23+action_131 (57) = happyShift action_24+action_131 (58) = happyShift action_25+action_131 (59) = happyShift action_26+action_131 (60) = happyShift action_27+action_131 (61) = happyShift action_28+action_131 (62) = happyShift action_29+action_131 (63) = happyShift action_30+action_131 (70) = happyShift action_129+action_131 (72) = happyShift action_31+action_131 (75) = happyShift action_32+action_131 (76) = happyShift action_33+action_131 (77) = happyShift action_34+action_131 (99) = happyShift action_35+action_131 (103) = happyShift action_36+action_131 (109) = happyShift action_37+action_131 (110) = happyShift action_38+action_131 (111) = happyShift action_39+action_131 (112) = happyShift action_40+action_131 (113) = happyShift action_41+action_131 (114) = happyShift action_42+action_131 (16) = happyGoto action_142+action_131 (23) = happyGoto action_5+action_131 (26) = happyGoto action_128+action_131 (27) = happyGoto action_7+action_131 (28) = happyGoto action_8+action_131 (29) = happyGoto action_9+action_131 (30) = happyGoto action_10+action_131 (31) = happyGoto action_11+action_131 (33) = happyGoto action_12+action_131 (35) = happyGoto action_13+action_131 (37) = happyGoto action_14+action_131 (38) = happyGoto action_15+action_131 (41) = happyGoto action_16+action_131 (45) = happyGoto action_17+action_131 (46) = happyGoto action_18+action_131 (47) = happyGoto action_19+action_131 _ = happyFail (happyExpListPerState 131)++action_132 (75) = happyShift action_141+action_132 _ = happyFail (happyExpListPerState 132)++action_133 (114) = happyShift action_42+action_133 (46) = happyGoto action_140+action_133 _ = happyFail (happyExpListPerState 133)++action_134 (113) = happyShift action_41+action_134 (23) = happyGoto action_139+action_134 _ = happyFail (happyExpListPerState 134)++action_135 (81) = happyShift action_138+action_135 _ = happyFail (happyExpListPerState 135)++action_136 (113) = happyShift action_41+action_136 (23) = happyGoto action_137+action_136 _ = happyFail (happyExpListPerState 136)++action_137 _ = happyReduce_42++action_138 (53) = happyShift action_20+action_138 (54) = happyShift action_21+action_138 (55) = happyShift action_22+action_138 (56) = happyShift action_23+action_138 (57) = happyShift action_24+action_138 (58) = happyShift action_25+action_138 (59) = happyShift action_26+action_138 (60) = happyShift action_27+action_138 (61) = happyShift action_28+action_138 (62) = happyShift action_29+action_138 (63) = happyShift action_30+action_138 (70) = happyShift action_129+action_138 (72) = happyShift action_31+action_138 (75) = happyShift action_32+action_138 (76) = happyShift action_33+action_138 (77) = happyShift action_34+action_138 (99) = happyShift action_35+action_138 (103) = happyShift action_36+action_138 (109) = happyShift action_37+action_138 (110) = happyShift action_38+action_138 (111) = happyShift action_39+action_138 (112) = happyShift action_40+action_138 (113) = happyShift action_41+action_138 (114) = happyShift action_42+action_138 (16) = happyGoto action_173+action_138 (23) = happyGoto action_5+action_138 (26) = happyGoto action_128+action_138 (27) = happyGoto action_7+action_138 (28) = happyGoto action_8+action_138 (29) = happyGoto action_9+action_138 (30) = happyGoto action_10+action_138 (31) = happyGoto action_11+action_138 (33) = happyGoto action_12+action_138 (35) = happyGoto action_13+action_138 (37) = happyGoto action_14+action_138 (38) = happyGoto action_15+action_138 (41) = happyGoto action_16+action_138 (45) = happyGoto action_17+action_138 (46) = happyGoto action_18+action_138 (47) = happyGoto action_19+action_138 _ = happyFail (happyExpListPerState 138)++action_139 _ = happyReduce_43++action_140 (105) = happyShift action_172+action_140 _ = happyFail (happyExpListPerState 140)++action_141 (81) = happyShift action_171+action_141 _ = happyFail (happyExpListPerState 141)++action_142 _ = happyReduce_35++action_143 (71) = happyShift action_169+action_143 (84) = happyShift action_170+action_143 _ = happyFail (happyExpListPerState 143)++action_144 _ = happyReduce_29++action_145 (100) = happyShift action_62+action_145 (101) = happyShift action_63+action_145 (34) = happyGoto action_61+action_145 _ = happyReduce_58++action_146 _ = happyReduce_73++action_147 (87) = happyShift action_168+action_147 _ = happyFail (happyExpListPerState 147)++action_148 (43) = happyGoto action_167+action_148 _ = happyReduce_97++action_149 (113) = happyShift action_41+action_149 (23) = happyGoto action_166+action_149 _ = happyFail (happyExpListPerState 149)++action_150 _ = happyReduce_81++action_151 (104) = happyShift action_165+action_151 _ = happyFail (happyExpListPerState 151)++action_152 (53) = happyShift action_20+action_152 (54) = happyShift action_21+action_152 (55) = happyShift action_22+action_152 (56) = happyShift action_23+action_152 (57) = happyShift action_24+action_152 (58) = happyShift action_25+action_152 (59) = happyShift action_26+action_152 (60) = happyShift action_27+action_152 (61) = happyShift action_28+action_152 (62) = happyShift action_29+action_152 (63) = happyShift action_30+action_152 (72) = happyShift action_31+action_152 (75) = happyShift action_32+action_152 (76) = happyShift action_33+action_152 (77) = happyShift action_34+action_152 (99) = happyShift action_35+action_152 (103) = happyShift action_36+action_152 (109) = happyShift action_37+action_152 (110) = happyShift action_38+action_152 (111) = happyShift action_39+action_152 (112) = happyShift action_40+action_152 (113) = happyShift action_41+action_152 (114) = happyShift action_42+action_152 (23) = happyGoto action_5+action_152 (26) = happyGoto action_164+action_152 (27) = happyGoto action_7+action_152 (28) = happyGoto action_8+action_152 (29) = happyGoto action_9+action_152 (30) = happyGoto action_10+action_152 (31) = happyGoto action_11+action_152 (33) = happyGoto action_12+action_152 (35) = happyGoto action_13+action_152 (37) = happyGoto action_14+action_152 (38) = happyGoto action_15+action_152 (41) = happyGoto action_16+action_152 (45) = happyGoto action_17+action_152 (46) = happyGoto action_18+action_152 (47) = happyGoto action_19+action_152 _ = happyFail (happyExpListPerState 152)++action_153 (103) = happyShift action_162+action_153 (40) = happyGoto action_163+action_153 _ = happyFail (happyExpListPerState 153)++action_154 (103) = happyShift action_162+action_154 (40) = happyGoto action_161+action_154 _ = happyFail (happyExpListPerState 154)++action_155 _ = happyReduce_84++action_156 (53) = happyShift action_20+action_156 (54) = happyShift action_21+action_156 (55) = happyShift action_22+action_156 (56) = happyShift action_23+action_156 (57) = happyShift action_24+action_156 (58) = happyShift action_25+action_156 (59) = happyShift action_26+action_156 (60) = happyShift action_27+action_156 (61) = happyShift action_28+action_156 (62) = happyShift action_29+action_156 (63) = happyShift action_30+action_156 (75) = happyShift action_32+action_156 (76) = happyShift action_33+action_156 (77) = happyShift action_34+action_156 (99) = happyShift action_35+action_156 (103) = happyShift action_36+action_156 (109) = happyShift action_37+action_156 (110) = happyShift action_38+action_156 (111) = happyShift action_39+action_156 (112) = happyShift action_40+action_156 (113) = happyShift action_41+action_156 (114) = happyShift action_42+action_156 (23) = happyGoto action_5+action_156 (28) = happyGoto action_160+action_156 (29) = happyGoto action_9+action_156 (30) = happyGoto action_10+action_156 (31) = happyGoto action_11+action_156 (33) = happyGoto action_12+action_156 (35) = happyGoto action_13+action_156 (37) = happyGoto action_14+action_156 (38) = happyGoto action_15+action_156 (41) = happyGoto action_16+action_156 (45) = happyGoto action_17+action_156 (46) = happyGoto action_18+action_156 (47) = happyGoto action_19+action_156 _ = happyFail (happyExpListPerState 156)++action_157 (83) = happyShift action_158+action_157 (104) = happyShift action_159+action_157 _ = happyFail (happyExpListPerState 157)++action_158 (53) = happyShift action_20+action_158 (54) = happyShift action_21+action_158 (55) = happyShift action_22+action_158 (56) = happyShift action_23+action_158 (57) = happyShift action_24+action_158 (58) = happyShift action_25+action_158 (59) = happyShift action_26+action_158 (60) = happyShift action_27+action_158 (61) = happyShift action_28+action_158 (62) = happyShift action_29+action_158 (63) = happyShift action_30+action_158 (72) = happyShift action_31+action_158 (75) = happyShift action_32+action_158 (76) = happyShift action_33+action_158 (77) = happyShift action_34+action_158 (99) = happyShift action_35+action_158 (103) = happyShift action_36+action_158 (109) = happyShift action_37+action_158 (110) = happyShift action_38+action_158 (111) = happyShift action_39+action_158 (112) = happyShift action_40+action_158 (113) = happyShift action_41+action_158 (114) = happyShift action_42+action_158 (23) = happyGoto action_5+action_158 (26) = happyGoto action_188+action_158 (27) = happyGoto action_7+action_158 (28) = happyGoto action_8+action_158 (29) = happyGoto action_9+action_158 (30) = happyGoto action_10+action_158 (31) = happyGoto action_11+action_158 (33) = happyGoto action_12+action_158 (35) = happyGoto action_13+action_158 (37) = happyGoto action_14+action_158 (38) = happyGoto action_15+action_158 (41) = happyGoto action_16+action_158 (45) = happyGoto action_17+action_158 (46) = happyGoto action_18+action_158 (47) = happyGoto action_19+action_158 _ = happyFail (happyExpListPerState 158)++action_159 _ = happyReduce_94++action_160 (91) = happyShift action_75+action_160 _ = happyReduce_45++action_161 (104) = happyShift action_187+action_161 _ = happyFail (happyExpListPerState 161)++action_162 (85) = happyShift action_186+action_162 _ = happyFail (happyExpListPerState 162)++action_163 (104) = happyShift action_185+action_163 _ = happyFail (happyExpListPerState 163)++action_164 (104) = happyShift action_184+action_164 _ = happyFail (happyExpListPerState 164)++action_165 _ = happyReduce_89++action_166 (83) = happyShift action_183+action_166 _ = happyFail (happyExpListPerState 166)++action_167 (83) = happyShift action_158+action_167 (108) = happyShift action_182+action_167 _ = happyFail (happyExpListPerState 167)++action_168 (80) = happyShift action_181+action_168 (113) = happyShift action_41+action_168 (23) = happyGoto action_180+action_168 _ = happyFail (happyExpListPerState 168)++action_169 (53) = happyShift action_20+action_169 (54) = happyShift action_21+action_169 (55) = happyShift action_22+action_169 (56) = happyShift action_23+action_169 (57) = happyShift action_24+action_169 (58) = happyShift action_25+action_169 (59) = happyShift action_26+action_169 (60) = happyShift action_27+action_169 (61) = happyShift action_28+action_169 (62) = happyShift action_29+action_169 (63) = happyShift action_30+action_169 (72) = happyShift action_31+action_169 (75) = happyShift action_32+action_169 (76) = happyShift action_33+action_169 (77) = happyShift action_34+action_169 (99) = happyShift action_35+action_169 (103) = happyShift action_36+action_169 (109) = happyShift action_37+action_169 (110) = happyShift action_38+action_169 (111) = happyShift action_39+action_169 (112) = happyShift action_40+action_169 (113) = happyShift action_41+action_169 (114) = happyShift action_42+action_169 (23) = happyGoto action_5+action_169 (26) = happyGoto action_179+action_169 (27) = happyGoto action_7+action_169 (28) = happyGoto action_8+action_169 (29) = happyGoto action_9+action_169 (30) = happyGoto action_10+action_169 (31) = happyGoto action_11+action_169 (33) = happyGoto action_12+action_169 (35) = happyGoto action_13+action_169 (37) = happyGoto action_14+action_169 (38) = happyGoto action_15+action_169 (41) = happyGoto action_16+action_169 (45) = happyGoto action_17+action_169 (46) = happyGoto action_18+action_169 (47) = happyGoto action_19+action_169 _ = happyFail (happyExpListPerState 169)++action_170 (103) = happyShift action_86+action_170 (113) = happyShift action_41+action_170 (18) = happyGoto action_178+action_170 (19) = happyGoto action_80+action_170 (20) = happyGoto action_81+action_170 (21) = happyGoto action_82+action_170 (22) = happyGoto action_83+action_170 (23) = happyGoto action_84+action_170 _ = happyFail (happyExpListPerState 170)++action_171 (53) = happyShift action_20+action_171 (54) = happyShift action_21+action_171 (55) = happyShift action_22+action_171 (56) = happyShift action_23+action_171 (57) = happyShift action_24+action_171 (58) = happyShift action_25+action_171 (59) = happyShift action_26+action_171 (60) = happyShift action_27+action_171 (61) = happyShift action_28+action_171 (62) = happyShift action_29+action_171 (63) = happyShift action_30+action_171 (70) = happyShift action_129+action_171 (72) = happyShift action_31+action_171 (75) = happyShift action_32+action_171 (76) = happyShift action_33+action_171 (77) = happyShift action_34+action_171 (99) = happyShift action_35+action_171 (103) = happyShift action_36+action_171 (109) = happyShift action_37+action_171 (110) = happyShift action_38+action_171 (111) = happyShift action_39+action_171 (112) = happyShift action_40+action_171 (113) = happyShift action_41+action_171 (114) = happyShift action_42+action_171 (16) = happyGoto action_177+action_171 (23) = happyGoto action_5+action_171 (26) = happyGoto action_128+action_171 (27) = happyGoto action_7+action_171 (28) = happyGoto action_8+action_171 (29) = happyGoto action_9+action_171 (30) = happyGoto action_10+action_171 (31) = happyGoto action_11+action_171 (33) = happyGoto action_12+action_171 (35) = happyGoto action_13+action_171 (37) = happyGoto action_14+action_171 (38) = happyGoto action_15+action_171 (41) = happyGoto action_16+action_171 (45) = happyGoto action_17+action_171 (46) = happyGoto action_18+action_171 (47) = happyGoto action_19+action_171 _ = happyFail (happyExpListPerState 171)++action_172 (113) = happyShift action_95+action_172 (9) = happyGoto action_174+action_172 (10) = happyGoto action_175+action_172 (11) = happyGoto action_176+action_172 _ = happyFail (happyExpListPerState 172)++action_173 _ = happyReduce_37++action_174 (83) = happyShift action_193+action_174 (106) = happyShift action_194+action_174 _ = happyFail (happyExpListPerState 174)++action_175 _ = happyReduce_8++action_176 (82) = happyShift action_192+action_176 _ = happyFail (happyExpListPerState 176)++action_177 _ = happyReduce_38++action_178 _ = happyReduce_30++action_179 _ = happyReduce_27++action_180 _ = happyReduce_102++action_181 (113) = happyShift action_41+action_181 (23) = happyGoto action_191+action_181 _ = happyFail (happyExpListPerState 181)++action_182 _ = happyReduce_79++action_183 (113) = happyShift action_41+action_183 (23) = happyGoto action_190+action_183 _ = happyFail (happyExpListPerState 183)++action_184 _ = happyReduce_86++action_185 _ = happyReduce_87++action_186 (113) = happyShift action_41+action_186 (23) = happyGoto action_189+action_186 _ = happyFail (happyExpListPerState 186)++action_187 _ = happyReduce_88++action_188 _ = happyReduce_98++action_189 (86) = happyShift action_207+action_189 _ = happyFail (happyExpListPerState 189)++action_190 (104) = happyShift action_206+action_190 _ = happyFail (happyExpListPerState 190)++action_191 _ = happyReduce_101++action_192 (48) = happyShift action_199+action_192 (49) = happyShift action_200+action_192 (50) = happyShift action_201+action_192 (51) = happyShift action_202+action_192 (52) = happyShift action_203+action_192 (103) = happyShift action_204+action_192 (114) = happyShift action_205+action_192 (12) = happyGoto action_198+action_192 _ = happyFail (happyExpListPerState 192)++action_193 (113) = happyShift action_95+action_193 (10) = happyGoto action_197+action_193 (11) = happyGoto action_176+action_193 _ = happyFail (happyExpListPerState 193)++action_194 (69) = happyShift action_196+action_194 (14) = happyGoto action_195+action_194 _ = happyReduce_22++action_195 _ = happyReduce_7++action_196 (103) = happyShift action_213+action_196 (114) = happyShift action_214+action_196 _ = happyFail (happyExpListPerState 196)++action_197 _ = happyReduce_9++action_198 _ = happyReduce_10++action_199 _ = happyReduce_12++action_200 _ = happyReduce_13++action_201 _ = happyReduce_15++action_202 _ = happyReduce_14++action_203 (48) = happyShift action_199+action_203 (49) = happyShift action_200+action_203 (50) = happyShift action_201+action_203 (51) = happyShift action_202+action_203 (52) = happyShift action_203+action_203 (103) = happyShift action_204+action_203 (114) = happyShift action_205+action_203 (12) = happyGoto action_212+action_203 _ = happyFail (happyExpListPerState 203)++action_204 (48) = happyShift action_199+action_204 (49) = happyShift action_200+action_204 (50) = happyShift action_201+action_204 (51) = happyShift action_202+action_204 (52) = happyShift action_203+action_204 (103) = happyShift action_204+action_204 (114) = happyShift action_205+action_204 (12) = happyGoto action_210+action_204 (13) = happyGoto action_211+action_204 _ = happyFail (happyExpListPerState 204)++action_205 _ = happyReduce_19++action_206 (87) = happyShift action_209+action_206 _ = happyFail (happyExpListPerState 206)++action_207 (53) = happyShift action_20+action_207 (54) = happyShift action_21+action_207 (55) = happyShift action_22+action_207 (56) = happyShift action_23+action_207 (57) = happyShift action_24+action_207 (58) = happyShift action_25+action_207 (59) = happyShift action_26+action_207 (60) = happyShift action_27+action_207 (61) = happyShift action_28+action_207 (62) = happyShift action_29+action_207 (63) = happyShift action_30+action_207 (72) = happyShift action_31+action_207 (75) = happyShift action_32+action_207 (76) = happyShift action_33+action_207 (77) = happyShift action_34+action_207 (99) = happyShift action_35+action_207 (103) = happyShift action_36+action_207 (109) = happyShift action_37+action_207 (110) = happyShift action_38+action_207 (111) = happyShift action_39+action_207 (112) = happyShift action_40+action_207 (113) = happyShift action_41+action_207 (114) = happyShift action_42+action_207 (23) = happyGoto action_5+action_207 (26) = happyGoto action_208+action_207 (27) = happyGoto action_7+action_207 (28) = happyGoto action_8+action_207 (29) = happyGoto action_9+action_207 (30) = happyGoto action_10+action_207 (31) = happyGoto action_11+action_207 (33) = happyGoto action_12+action_207 (35) = happyGoto action_13+action_207 (37) = happyGoto action_14+action_207 (38) = happyGoto action_15+action_207 (41) = happyGoto action_16+action_207 (45) = happyGoto action_17+action_207 (46) = happyGoto action_18+action_207 (47) = happyGoto action_19+action_207 _ = happyFail (happyExpListPerState 207)++action_208 (104) = happyShift action_224+action_208 _ = happyFail (happyExpListPerState 208)++action_209 (78) = happyShift action_222+action_209 (79) = happyShift action_223+action_209 _ = happyFail (happyExpListPerState 209)++action_210 (83) = happyShift action_220+action_210 (104) = happyShift action_221+action_210 _ = happyFail (happyExpListPerState 210)++action_211 (83) = happyShift action_218+action_211 (104) = happyShift action_219+action_211 _ = happyFail (happyExpListPerState 211)++action_212 (48) = happyShift action_199+action_212 (49) = happyShift action_200+action_212 (50) = happyShift action_201+action_212 (51) = happyShift action_202+action_212 (52) = happyShift action_203+action_212 (103) = happyShift action_204+action_212 (114) = happyShift action_205+action_212 (12) = happyGoto action_217+action_212 _ = happyFail (happyExpListPerState 212)++action_213 (114) = happyShift action_216+action_213 (15) = happyGoto action_215+action_213 _ = happyFail (happyExpListPerState 213)++action_214 _ = happyReduce_23++action_215 (83) = happyShift action_229+action_215 (104) = happyShift action_230+action_215 _ = happyFail (happyExpListPerState 215)++action_216 _ = happyReduce_25++action_217 _ = happyReduce_16++action_218 (48) = happyShift action_199+action_218 (49) = happyShift action_200+action_218 (50) = happyShift action_201+action_218 (51) = happyShift action_202+action_218 (52) = happyShift action_203+action_218 (103) = happyShift action_204+action_218 (114) = happyShift action_205+action_218 (12) = happyGoto action_228+action_218 _ = happyFail (happyExpListPerState 218)++action_219 _ = happyReduce_18++action_220 (48) = happyShift action_199+action_220 (49) = happyShift action_200+action_220 (50) = happyShift action_201+action_220 (51) = happyShift action_202+action_220 (52) = happyShift action_203+action_220 (103) = happyShift action_204+action_220 (114) = happyShift action_205+action_220 (12) = happyGoto action_227+action_220 _ = happyFail (happyExpListPerState 220)++action_221 _ = happyReduce_17++action_222 (113) = happyShift action_41+action_222 (23) = happyGoto action_226+action_222 _ = happyFail (happyExpListPerState 222)++action_223 (113) = happyShift action_41+action_223 (23) = happyGoto action_225+action_223 _ = happyFail (happyExpListPerState 223)++action_224 _ = happyReduce_90++action_225 _ = happyReduce_100++action_226 _ = happyReduce_99++action_227 _ = happyReduce_20++action_228 _ = happyReduce_21++action_229 (114) = happyShift action_231+action_229 _ = happyFail (happyExpListPerState 229)++action_230 _ = happyReduce_24++action_231 _ = happyReduce_26++happyReduce_2 = happySpecReduce_1  5 happyReduction_2+happyReduction_2 (HappyAbsSyn6  happy_var_1)+	 =  HappyAbsSyn5+		 ([happy_var_1]+	)+happyReduction_2 _  = notHappyAtAll ++happyReduce_3 = happySpecReduce_3  5 happyReduction_3+happyReduction_3 (HappyAbsSyn6  happy_var_3)+	_+	(HappyAbsSyn5  happy_var_1)+	 =  HappyAbsSyn5+		 (happy_var_3:happy_var_1+	)+happyReduction_3 _ _ _  = notHappyAtAll ++happyReduce_4 = happySpecReduce_2  6 happyReduction_4+happyReduction_4 (HappyAbsSyn18  happy_var_2)+	(HappyAbsSyn7  happy_var_1)+	 =  HappyAbsSyn6+		 (DProgramSpec0 (reverse happy_var_1) happy_var_2 (if happy_var_1 == [] then getData happy_var_2 else getData (head happy_var_1))+	)+happyReduction_4 _ _  = notHappyAtAll ++happyReduce_5 = happySpecReduce_0  7 happyReduction_5+happyReduction_5  =  HappyAbsSyn7+		 ([ ]+	)++happyReduce_6 = happySpecReduce_2  7 happyReduction_6+happyReduction_6 (HappyAbsSyn8  happy_var_2)+	(HappyAbsSyn7  happy_var_1)+	 =  HappyAbsSyn7+		 (happy_var_2:happy_var_1+	)+happyReduction_6 _ _  = notHappyAtAll ++happyReduce_7 = happyReduce 8 8 happyReduction_7+happyReduction_7 (_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn9  happy_var_6) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn46  happy_var_4) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn8+		 (DRecordSpec happy_var_4 (reverse happy_var_6) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_8 = happySpecReduce_1  9 happyReduction_8+happyReduction_8 (HappyAbsSyn10  happy_var_1)+	 =  HappyAbsSyn9+		 ([happy_var_1]+	)+happyReduction_8 _  = notHappyAtAll ++happyReduce_9 = happySpecReduce_3  9 happyReduction_9+happyReduction_9 (HappyAbsSyn10  happy_var_3)+	_+	(HappyAbsSyn9  happy_var_1)+	 =  HappyAbsSyn9+		 (happy_var_3:happy_var_1+	)+happyReduction_9 _ _ _  = notHappyAtAll ++happyReduce_10 = happySpecReduce_3  10 happyReduction_10+happyReduction_10 (HappyAbsSyn12  happy_var_3)+	_+	(HappyAbsSyn11  happy_var_1)+	 =  HappyAbsSyn10+		 ((happy_var_1, happy_var_3)+	)+happyReduction_10 _ _ _  = notHappyAtAll ++happyReduce_11 = happySpecReduce_1  11 happyReduction_11+happyReduction_11 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn11+		 (DField (strToken happy_var_1) (getData happy_var_1)+	)+happyReduction_11 _  = notHappyAtAll ++happyReduce_12 = happySpecReduce_1  12 happyReduction_12+happyReduction_12 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTInt (getData happy_var_1)+	)+happyReduction_12 _  = notHappyAtAll ++happyReduce_13 = happySpecReduce_1  12 happyReduction_13+happyReduction_13 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTBool (getData happy_var_1)+	)+happyReduction_13 _  = notHappyAtAll ++happyReduce_14 = happySpecReduce_1  12 happyReduction_14+happyReduction_14 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTString (getData happy_var_1)+	)+happyReduction_14 _  = notHappyAtAll ++happyReduce_15 = happySpecReduce_1  12 happyReduction_15+happyReduction_15 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTDouble (getData happy_var_1)+	)+happyReduction_15 _  = notHappyAtAll ++happyReduce_16 = happySpecReduce_3  12 happyReduction_16+happyReduction_16 (HappyAbsSyn12  happy_var_3)+	(HappyAbsSyn12  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTRecord (DConstructor "Pair" (getData happy_var_1)) [happy_var_2, happy_var_3] (getData happy_var_1)+	)+happyReduction_16 _ _ _  = notHappyAtAll ++happyReduce_17 = happySpecReduce_3  12 happyReduction_17+happyReduction_17 _+	(HappyAbsSyn12  happy_var_2)+	_+	 =  HappyAbsSyn12+		 (happy_var_2+	)+happyReduction_17 _ _ _  = notHappyAtAll ++happyReduce_18 = happySpecReduce_3  12 happyReduction_18+happyReduction_18 _+	(HappyAbsSyn13  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTTuple (reverse happy_var_2) (getData happy_var_1)+	)+happyReduction_18 _ _ _  = notHappyAtAll ++happyReduce_19 = happySpecReduce_1  12 happyReduction_19+happyReduction_19 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn12+		 (DTRecord (DConstructor (strToken happy_var_1) (getData happy_var_1)) [] (getData happy_var_1)+	)+happyReduction_19 _  = notHappyAtAll ++happyReduce_20 = happySpecReduce_3  13 happyReduction_20+happyReduction_20 (HappyAbsSyn12  happy_var_3)+	_+	(HappyAbsSyn12  happy_var_1)+	 =  HappyAbsSyn13+		 ([happy_var_3, happy_var_1]+	)+happyReduction_20 _ _ _  = notHappyAtAll ++happyReduce_21 = happySpecReduce_3  13 happyReduction_21+happyReduction_21 (HappyAbsSyn12  happy_var_3)+	_+	(HappyAbsSyn13  happy_var_1)+	 =  HappyAbsSyn13+		 (happy_var_3:happy_var_1+	)+happyReduction_21 _ _ _  = notHappyAtAll ++happyReduce_22 = happySpecReduce_0  14 happyReduction_22+happyReduction_22  =  HappyAbsSyn14+		 (()+	)++happyReduce_23 = happySpecReduce_2  14 happyReduction_23+happyReduction_23 _+	_+	 =  HappyAbsSyn14+		 (()+	)++happyReduce_24 = happyReduce 4 14 happyReduction_24+happyReduction_24 (_ `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn14+		 (()+	) `HappyStk` happyRest++happyReduce_25 = happySpecReduce_1  15 happyReduction_25+happyReduction_25 _+	 =  HappyAbsSyn14+		 (()+	)++happyReduce_26 = happySpecReduce_3  15 happyReduction_26+happyReduction_26 _+	_+	_+	 =  HappyAbsSyn14+		 (()+	)++happyReduce_27 = happyReduce 4 16 happyReduction_27+happyReduction_27 ((HappyAbsSyn26  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn17  happy_var_2) `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn16+		 ((reverse happy_var_2, happy_var_4)+	) `HappyStk` happyRest++happyReduce_28 = happySpecReduce_1  16 happyReduction_28+happyReduction_28 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn16+		 (([], happy_var_1)+	)+happyReduction_28 _  = notHappyAtAll ++happyReduce_29 = happySpecReduce_1  17 happyReduction_29+happyReduction_29 (HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn17+		 ([happy_var_1]+	)+happyReduction_29 _  = notHappyAtAll ++happyReduce_30 = happySpecReduce_3  17 happyReduction_30+happyReduction_30 (HappyAbsSyn18  happy_var_3)+	_+	(HappyAbsSyn17  happy_var_1)+	 =  HappyAbsSyn17+		 (happy_var_3:happy_var_1+	)+happyReduction_30 _ _ _  = notHappyAtAll ++happyReduce_31 = happySpecReduce_1  18 happyReduction_31+happyReduction_31 (HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1+	)+happyReduction_31 _  = notHappyAtAll ++happyReduce_32 = happySpecReduce_1  18 happyReduction_32+happyReduction_32 (HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1+	)+happyReduction_32 _  = notHappyAtAll ++happyReduce_33 = happySpecReduce_1  18 happyReduction_33+happyReduction_33 (HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1+	)+happyReduction_33 _  = notHappyAtAll ++happyReduce_34 = happySpecReduce_1  18 happyReduction_34+happyReduction_34 (HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1+	)+happyReduction_34 _  = notHappyAtAll ++happyReduce_35 = happyReduce 4 19 happyReduction_35+happyReduction_35 ((HappyAbsSyn16  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn24  happy_var_2) `HappyStk`+	(HappyAbsSyn23  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn18+		 (DDefFun0 happy_var_1 (reverse happy_var_2) (fst happy_var_4) (snd happy_var_4) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_36 = happySpecReduce_3  20 happyReduction_36+happyReduction_36 (HappyAbsSyn16  happy_var_3)+	_+	(HappyAbsSyn23  happy_var_1)+	 =  HappyAbsSyn18+		 (DDefVar0 happy_var_1 (fst happy_var_3) (snd happy_var_3) (getData happy_var_1)+	)+happyReduction_36 _ _ _  = notHappyAtAll ++happyReduce_37 = happyReduce 5 21 happyReduction_37+happyReduction_37 ((HappyAbsSyn16  happy_var_5) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn24  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn18+		 (DDefTuple0 (reverse happy_var_2) (fst happy_var_5) (snd happy_var_5) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_38 = happyMonadReduce 6 22 happyReduction_38+happyReduction_38 ((HappyAbsSyn16  happy_var_6) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_2) `HappyStk`+	(HappyAbsSyn23  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_2 "v" >> return (DDefVertComp0 happy_var_1 (fst happy_var_6) (snd happy_var_6) (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn18 r))++happyReduce_39 = happySpecReduce_1  23 happyReduction_39+happyReduction_39 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn23+		 (DVar (strToken happy_var_1) (getData happy_var_1)+	)+happyReduction_39 _  = notHappyAtAll ++happyReduce_40 = happySpecReduce_1  24 happyReduction_40+happyReduction_40 (HappyAbsSyn23  happy_var_1)+	 =  HappyAbsSyn24+		 ([happy_var_1]+	)+happyReduction_40 _  = notHappyAtAll ++happyReduce_41 = happySpecReduce_2  24 happyReduction_41+happyReduction_41 (HappyAbsSyn23  happy_var_2)+	(HappyAbsSyn24  happy_var_1)+	 =  HappyAbsSyn24+		 (happy_var_2:happy_var_1+	)+happyReduction_41 _ _  = notHappyAtAll ++happyReduce_42 = happySpecReduce_3  25 happyReduction_42+happyReduction_42 (HappyAbsSyn23  happy_var_3)+	_+	(HappyAbsSyn23  happy_var_1)+	 =  HappyAbsSyn24+		 ([happy_var_3,happy_var_1]+	)+happyReduction_42 _ _ _  = notHappyAtAll ++happyReduce_43 = happySpecReduce_3  25 happyReduction_43+happyReduction_43 (HappyAbsSyn23  happy_var_3)+	_+	(HappyAbsSyn24  happy_var_1)+	 =  HappyAbsSyn24+		 (happy_var_3:happy_var_1+	)+happyReduction_43 _ _ _  = notHappyAtAll ++happyReduce_44 = happySpecReduce_1  26 happyReduction_44+happyReduction_44 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_44 _  = notHappyAtAll ++happyReduce_45 = happyReduce 6 27 happyReduction_45+happyReduction_45 ((HappyAbsSyn26  happy_var_6) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn26  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn26  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DIf0 happy_var_2 happy_var_4 happy_var_6 (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_46 = happySpecReduce_1  27 happyReduction_46+happyReduction_46 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_46 _  = notHappyAtAll ++happyReduce_47 = happySpecReduce_3  28 happyReduction_47+happyReduction_47 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "||" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_47 _ _ _  = notHappyAtAll ++happyReduce_48 = happySpecReduce_1  28 happyReduction_48+happyReduction_48 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_48 _  = notHappyAtAll ++happyReduce_49 = happySpecReduce_3  29 happyReduction_49+happyReduction_49 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "&&" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_49 _ _ _  = notHappyAtAll ++happyReduce_50 = happySpecReduce_1  29 happyReduction_50+happyReduction_50 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_50 _  = notHappyAtAll ++happyReduce_51 = happySpecReduce_3  30 happyReduction_51+happyReduction_51 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "<=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_51 _ _ _  = notHappyAtAll ++happyReduce_52 = happySpecReduce_3  30 happyReduction_52+happyReduction_52 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp ">=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_52 _ _ _  = notHappyAtAll ++happyReduce_53 = happySpecReduce_3  30 happyReduction_53+happyReduction_53 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "==" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_53 _ _ _  = notHappyAtAll ++happyReduce_54 = happySpecReduce_3  30 happyReduction_54+happyReduction_54 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "!=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_54 _ _ _  = notHappyAtAll ++happyReduce_55 = happySpecReduce_3  30 happyReduction_55+happyReduction_55 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp ">" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_55 _ _ _  = notHappyAtAll ++happyReduce_56 = happySpecReduce_3  30 happyReduction_56+happyReduction_56 (HappyAbsSyn26  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp "<" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1)+	)+happyReduction_56 _ _ _  = notHappyAtAll ++happyReduce_57 = happySpecReduce_1  30 happyReduction_57+happyReduction_57 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_57 _  = notHappyAtAll ++happyReduce_58 = happyReduce 5 31 happyReduction_58+happyReduction_58 ((HappyAbsSyn26  happy_var_5) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn26  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DFunAp0 (v2f happy_var_3) [happy_var_1,happy_var_5] (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_59 = happySpecReduce_3  31 happyReduction_59+happyReduction_59 (HappyAbsSyn26  happy_var_3)+	(HappyAbsSyn32  happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp happy_var_2 (getData happy_var_1)) [happy_var_1, happy_var_3] (getData happy_var_1)+	)+happyReduction_59 _ _ _  = notHappyAtAll ++happyReduce_60 = happySpecReduce_1  31 happyReduction_60+happyReduction_60 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_60 _  = notHappyAtAll ++happyReduce_61 = happySpecReduce_1  32 happyReduction_61+happyReduction_61 _+	 =  HappyAbsSyn32+		 ("+"+	)++happyReduce_62 = happySpecReduce_1  32 happyReduction_62+happyReduction_62 _+	 =  HappyAbsSyn32+		 ("-"+	)++happyReduce_63 = happySpecReduce_3  33 happyReduction_63+happyReduction_63 (HappyAbsSyn26  happy_var_3)+	(HappyAbsSyn32  happy_var_2)+	(HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (DBinOp happy_var_2 (getData happy_var_1)) [happy_var_1, happy_var_3] (getData happy_var_1)+	)+happyReduction_63 _ _ _  = notHappyAtAll ++happyReduce_64 = happySpecReduce_2  33 happyReduction_64+happyReduction_64 (HappyAbsSyn26  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn26+		 (if isConstNum happy_var_2 then negConst happy_var_2 else DFunAp0 (DFun "neg" (getData happy_var_1)) [happy_var_2] (getData happy_var_1)+	)+happyReduction_64 _ _  = notHappyAtAll ++happyReduce_65 = happySpecReduce_1  33 happyReduction_65+happyReduction_65 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_65 _  = notHappyAtAll ++happyReduce_66 = happySpecReduce_1  34 happyReduction_66+happyReduction_66 _+	 =  HappyAbsSyn32+		 ("*"+	)++happyReduce_67 = happySpecReduce_1  34 happyReduction_67+happyReduction_67 _+	 =  HappyAbsSyn32+		 ("/"+	)++happyReduce_68 = happySpecReduce_3  35 happyReduction_68+happyReduction_68 (HappyAbsSyn36  happy_var_3)+	_+	(HappyAbsSyn37  happy_var_1)+	 =  HappyAbsSyn26+		 (DFieldAcc0 happy_var_1 (reverse happy_var_3) (getData happy_var_1)+	)+happyReduction_68 _ _ _  = notHappyAtAll ++happyReduce_69 = happySpecReduce_1  35 happyReduction_69+happyReduction_69 (HappyAbsSyn37  happy_var_1)+	 =  HappyAbsSyn26+		 (DFieldAcc0 happy_var_1 [] (getData happy_var_1)+	)+happyReduction_69 _  = notHappyAtAll ++happyReduce_70 = happyMonadReduce 3 35 happyReduction_70+happyReduction_70 ((HappyAbsSyn36  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_1 "e" >> return (DFieldAccE0 (DEdge (getData happy_var_1)) (reverse happy_var_3) (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn26 r))++happyReduce_71 = happySpecReduce_1  35 happyReduction_71+happyReduction_71 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_71 _  = notHappyAtAll ++happyReduce_72 = happySpecReduce_1  36 happyReduction_72+happyReduction_72 (HappyAbsSyn11  happy_var_1)+	 =  HappyAbsSyn36+		 ([happy_var_1]+	)+happyReduction_72 _  = notHappyAtAll ++happyReduce_73 = happySpecReduce_3  36 happyReduction_73+happyReduction_73 (HappyAbsSyn11  happy_var_3)+	_+	(HappyAbsSyn36  happy_var_1)+	 =  HappyAbsSyn36+		 (happy_var_3:happy_var_1+	)+happyReduction_73 _ _ _  = notHappyAtAll ++happyReduce_74 = happySpecReduce_2  37 happyReduction_74+happyReduction_74 (HappyAbsSyn23  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn37+		 (DCurr happy_var_2 (getData happy_var_1)+	)+happyReduction_74 _ _  = notHappyAtAll ++happyReduce_75 = happySpecReduce_2  37 happyReduction_75+happyReduction_75 (HappyAbsSyn23  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn37+		 (DPrev happy_var_2 (getData happy_var_1)+	)+happyReduction_75 _ _  = notHappyAtAll ++happyReduce_76 = happySpecReduce_2  37 happyReduction_76+happyReduction_76 (HappyAbsSyn23  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn37+		 (DVal  happy_var_2 (getData happy_var_1)+	)+happyReduction_76 _ _  = notHappyAtAll ++happyReduce_77 = happySpecReduce_2  38 happyReduction_77+happyReduction_77 (HappyAbsSyn42  happy_var_2)+	(HappyAbsSyn23  happy_var_1)+	 =  HappyAbsSyn26+		 (DFunAp0 (v2f happy_var_1) (reverse happy_var_2) (getData happy_var_1)+	)+happyReduction_77 _ _  = notHappyAtAll ++happyReduce_78 = happySpecReduce_2  38 happyReduction_78+happyReduction_78 (HappyAbsSyn42  happy_var_2)+	(HappyAbsSyn46  happy_var_1)+	 =  HappyAbsSyn26+		 (DConsAp0 happy_var_1 (reverse happy_var_2) (getData happy_var_1)+	)+happyReduction_78 _ _  = notHappyAtAll ++happyReduce_79 = happyReduce 7 38 happyReduction_79+happyReduction_79 (_ `HappyStk`+	(HappyAbsSyn42  happy_var_6) `HappyStk`+	(HappyAbsSyn44  happy_var_5) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn26  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn45  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DAggr0 happy_var_1 happy_var_3 happy_var_5 (reverse happy_var_6) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_80 = happySpecReduce_1  38 happyReduction_80+happyReduction_80 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn26+		 (happy_var_1+	)+happyReduction_80 _  = notHappyAtAll ++happyReduce_81 = happyReduce 5 38 happyReduction_81+happyReduction_81 ((HappyAbsSyn23  happy_var_5) `HappyStk`+	(HappyAbsSyn39  happy_var_4) `HappyStk`+	(HappyAbsSyn23  happy_var_3) `HappyStk`+	(HappyAbsSyn23  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DPregel0 happy_var_2 happy_var_3 happy_var_4 happy_var_5 (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_82 = happySpecReduce_3  38 happyReduction_82+happyReduction_82 (HappyAbsSyn23  happy_var_3)+	(HappyAbsSyn23  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn26+		 (DGMap0 happy_var_2 happy_var_3 (getData happy_var_1)+	)+happyReduction_82 _ _ _  = notHappyAtAll ++happyReduce_83 = happySpecReduce_3  38 happyReduction_83+happyReduction_83 (HappyAbsSyn23  happy_var_3)+	(HappyAbsSyn23  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn26+		 (DGZip0 happy_var_2 happy_var_3 (getData happy_var_1)+	)+happyReduction_83 _ _ _  = notHappyAtAll ++happyReduce_84 = happyReduce 5 38 happyReduction_84+happyReduction_84 ((HappyAbsSyn23  happy_var_5) `HappyStk`+	(HappyAbsSyn39  happy_var_4) `HappyStk`+	(HappyAbsSyn23  happy_var_3) `HappyStk`+	(HappyAbsSyn23  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DGIter0 happy_var_2 happy_var_3 happy_var_4 happy_var_5 (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_85 = happySpecReduce_1  39 happyReduction_85+happyReduction_85 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn39+		 (DTermF0 (getData happy_var_1)+	)+happyReduction_85 _  = notHappyAtAll ++happyReduce_86 = happyReduce 4 39 happyReduction_86+happyReduction_86 (_ `HappyStk`+	(HappyAbsSyn26  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn39+		 (DTermI0 happy_var_3 (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_87 = happyReduce 4 39 happyReduction_87+happyReduction_87 (_ `HappyStk`+	(HappyAbsSyn26  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn39+		 (DTermU0 happy_var_3 (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_88 = happyReduce 4 39 happyReduction_88+happyReduction_88 (_ `HappyStk`+	(HappyAbsSyn26  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn39+		 (DTermU0 (DFunAp0 (DFun "not" (getData happy_var_1)) [happy_var_3] (getData happy_var_1)) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_89 = happySpecReduce_3  39 happyReduction_89+happyReduction_89 _+	(HappyAbsSyn39  happy_var_2)+	_+	 =  HappyAbsSyn39+		 (happy_var_2+	)+happyReduction_89 _ _ _  = notHappyAtAll ++happyReduce_90 = happyMonadReduce 6 40 happyReduction_90+happyReduction_90 (_ `HappyStk`+	(HappyAbsSyn26  happy_var_5) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_3 "g" >> return happy_var_5))+	) (\r -> happyReturn (HappyAbsSyn26 r))++happyReduce_91 = happySpecReduce_1  41 happyReduction_91+happyReduction_91 (HappyAbsSyn47  happy_var_1)+	 =  HappyAbsSyn26+		 (DCExp0 happy_var_1 (getData happy_var_1)+	)+happyReduction_91 _  = notHappyAtAll ++happyReduce_92 = happySpecReduce_1  41 happyReduction_92+happyReduction_92 (HappyAbsSyn23  happy_var_1)+	 =  HappyAbsSyn26+		 (DVExp0 happy_var_1 (getData happy_var_1)+	)+happyReduction_92 _  = notHappyAtAll ++happyReduce_93 = happySpecReduce_3  41 happyReduction_93+happyReduction_93 _+	(HappyAbsSyn26  happy_var_2)+	_+	 =  HappyAbsSyn26+		 (happy_var_2+	)+happyReduction_93 _ _ _  = notHappyAtAll ++happyReduce_94 = happyReduce 6 41 happyReduction_94+happyReduction_94 (_ `HappyStk`+	(HappyAbsSyn42  happy_var_5) `HappyStk`+	(HappyAbsSyn26  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn26  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn26+		 (DTuple0 (happy_var_2:happy_var_4:reverse happy_var_5) (getData happy_var_1)+	) `HappyStk` happyRest++happyReduce_95 = happySpecReduce_1  42 happyReduction_95+happyReduction_95 (HappyAbsSyn26  happy_var_1)+	 =  HappyAbsSyn42+		 ([happy_var_1]+	)+happyReduction_95 _  = notHappyAtAll ++happyReduce_96 = happySpecReduce_2  42 happyReduction_96+happyReduction_96 (HappyAbsSyn26  happy_var_2)+	(HappyAbsSyn42  happy_var_1)+	 =  HappyAbsSyn42+		 (happy_var_2:happy_var_1+	)+happyReduction_96 _ _  = notHappyAtAll ++happyReduce_97 = happySpecReduce_0  43 happyReduction_97+happyReduction_97  =  HappyAbsSyn42+		 ([]+	)++happyReduce_98 = happySpecReduce_3  43 happyReduction_98+happyReduction_98 (HappyAbsSyn26  happy_var_3)+	_+	(HappyAbsSyn42  happy_var_1)+	 =  HappyAbsSyn42+		 (happy_var_3:happy_var_1+	)+happyReduction_98 _ _ _  = notHappyAtAll ++happyReduce_99 = happyMonadReduce 8 44 happyReduction_99+happyReduction_99 ((HappyAbsSyn23  happy_var_8) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_2 "e" >> mustbe happy_var_4 "u" >> mustbe happy_var_8 "v" >> return (DGenI (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn44 r))++happyReduce_100 = happyMonadReduce 8 44 happyReduction_100+happyReduction_100 ((HappyAbsSyn23  happy_var_8) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_2 "e" >> mustbe happy_var_4 "u" >> mustbe happy_var_8 "v" >> return (DGenO (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn44 r))++happyReduce_101 = happyMonadReduce 4 44 happyReduction_101+happyReduction_101 ((HappyAbsSyn23  happy_var_4) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_1 "u" >> mustbe happy_var_4 "v" >> return (DGenG (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn44 r))++happyReduce_102 = happyMonadReduce 3 44 happyReduction_102+happyReduction_102 ((HappyAbsSyn23  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn23  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mustbe happy_var_1 "u" >> mustbe happy_var_3 "v" >> return (DGenG (getData happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn44 r))++happyReduce_103 = happySpecReduce_1  45 happyReduction_103+happyReduction_103 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggMin0 (getData happy_var_1)+	)+happyReduction_103 _  = notHappyAtAll ++happyReduce_104 = happySpecReduce_1  45 happyReduction_104+happyReduction_104 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggMax0 (getData happy_var_1)+	)+happyReduction_104 _  = notHappyAtAll ++happyReduce_105 = happySpecReduce_1  45 happyReduction_105+happyReduction_105 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggSum0 (getData happy_var_1)+	)+happyReduction_105 _  = notHappyAtAll ++happyReduce_106 = happySpecReduce_1  45 happyReduction_106+happyReduction_106 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggProd0 (getData happy_var_1)+	)+happyReduction_106 _  = notHappyAtAll ++happyReduce_107 = happySpecReduce_1  45 happyReduction_107+happyReduction_107 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggAnd0 (getData happy_var_1)+	)+happyReduction_107 _  = notHappyAtAll ++happyReduce_108 = happySpecReduce_1  45 happyReduction_108+happyReduction_108 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggOr0 (getData happy_var_1)+	)+happyReduction_108 _  = notHappyAtAll ++happyReduce_109 = happySpecReduce_2  45 happyReduction_109+happyReduction_109 (HappyAbsSyn26  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn45+		 (DAggChoice0 happy_var_2 (getData happy_var_1)+	)+happyReduction_109 _ _  = notHappyAtAll ++happyReduce_110 = happySpecReduce_1  46 happyReduction_110+happyReduction_110 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn46+		 (DConstructor (strToken happy_var_1) (getData happy_var_1)+	)+happyReduction_110 _  = notHappyAtAll ++happyReduce_111 = happySpecReduce_1  47 happyReduction_111+happyReduction_111 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn47+		 (DCInt    (readToken happy_var_1) (getData happy_var_1)+	)+happyReduction_111 _  = notHappyAtAll ++happyReduce_112 = happySpecReduce_1  47 happyReduction_112+happyReduction_112 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn47+		 (DCDouble (readTokenF happy_var_1) (getData happy_var_1)+	)+happyReduction_112 _  = notHappyAtAll ++happyReduce_113 = happySpecReduce_1  47 happyReduction_113+happyReduction_113 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn47+		 (DCBool   (readToken happy_var_1) (getData happy_var_1)+	)+happyReduction_113 _  = notHappyAtAll ++happyReduce_114 = happySpecReduce_1  47 happyReduction_114+happyReduction_114 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn47+		 (DCString (strToken happy_var_1) (getData happy_var_1)+	)+happyReduction_114 _  = notHappyAtAll ++happyNewToken action sts stk [] =+	action 115 115 notHappyAtAll (HappyState action) sts stk []++happyNewToken action sts stk (tk:tks) =+	let cont i = action i i tk (HappyState action) sts stk tks in+	case tk of {+	(L _ L_CONSTRUCTOR "Int") -> cont 48;+	(L _ L_CONSTRUCTOR "Bool") -> cont 49;+	(L _ L_CONSTRUCTOR "Double") -> cont 50;+	(L _ L_CONSTRUCTOR "String") -> cont 51;+	(L _ L_CONSTRUCTOR "Pair") -> cont 52;+	(L _ L_IDENT "sum") -> cont 53;+	(L _ L_IDENT "prod") -> cont 54;+	(L _ L_IDENT "minimum") -> cont 55;+	(L _ L_IDENT "maximum") -> cont 56;+	(L _ L_IDENT "or") -> cont 57;+	(L _ L_IDENT "and") -> cont 58;+	(L _ L_IDENT "random") -> cont 59;+	(L _ L_IDENT "fregel") -> cont 60;+	(L _ L_IDENT "gmap") -> cont 61;+	(L _ L_IDENT "gzip") -> cont 62;+	(L _ L_IDENT "giter") -> cont 63;+	(L _ L_CONSTRUCTOR "Fix") -> cont 64;+	(L _ L_CONSTRUCTOR "Iter") -> cont 65;+	(L _ L_CONSTRUCTOR "Until") -> cont 66;+	(L _ L_CONSTRUCTOR "While") -> cont 67;+	(L _ L_DATA _) -> cont 68;+	(L _ L_DERIVING _) -> cont 69;+	(L _ L_LET _) -> cont 70;+	(L _ L_IN _) -> cont 71;+	(L _ L_IF _) -> cont 72;+	(L _ L_THEN _) -> cont 73;+	(L _ L_ELSE _) -> cont 74;+	(L _ L_CURR _) -> cont 75;+	(L _ L_PREV _) -> cont 76;+	(L _ L_VAL _) -> cont 77;+	(L _ L_IS _) -> cont 78;+	(L _ L_RS _) -> cont 79;+	(L _ L_GOF _) -> cont 80;+	(L _ L_EQUAL _) -> cont 81;+	(L _ L_DBLCOLON _) -> cont 82;+	(L _ L_COMMA _) -> cont 83;+	(L _ L_SEMICOLON _) -> cont 84;+	(L _ L_BACKSLASH _) -> cont 85;+	(L _ L_RARROW _) -> cont 86;+	(L _ L_LARROW _) -> cont 87;+	(L _ L_DOTHAT _) -> cont 88;+	(L _ L_PIPE _) -> cont 89;+	(L _ L_DBLAND _) -> cont 90;+	(L _ L_DBLOR _) -> cont 91;+	(L _ L_EQ _) -> cont 92;+	(L _ L_NE _) -> cont 93;+	(L _ L_LT _) -> cont 94;+	(L _ L_LE _) -> cont 95;+	(L _ L_GT _) -> cont 96;+	(L _ L_GE _) -> cont 97;+	(L _ L_PLUS _) -> cont 98;+	(L _ L_MINUS _) -> cont 99;+	(L _ L_AST _) -> cont 100;+	(L _ L_SLASH _) -> cont 101;+	(L _ L_BACKQUOTE _) -> cont 102;+	(L _ L_LPAREN _) -> cont 103;+	(L _ L_RPAREN _) -> cont 104;+	(L _ L_LBRACE _) -> cont 105;+	(L _ L_RBRACE _) -> cont 106;+	(L _ L_LBRACKET _) -> cont 107;+	(L _ L_RBRACKET _) -> cont 108;+	(L _ L_BOOL _) -> cont 109;+	(L _ L_INT _) -> cont 110;+	(L _ L_FLOAT _) -> cont 111;+	(L _ L_STRING _) -> cont 112;+	(L _ L_IDENT _) -> cont 113;+	(L _ L_CONSTRUCTOR _) -> cont 114;+	_ -> happyError' ((tk:tks), [])+	}++happyError_ explist 115 tk tks = happyError' (tks, explist)+happyError_ explist _ tk tks = happyError' ((tk:tks), explist)++happyThen :: () => CM a -> (a -> CM b) -> CM b+happyThen = (>>=)+happyReturn :: () => a -> CM a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> CM a+happyReturn1 = \a tks -> (return) a+happyError' :: () => ([(Lexeme)], [String]) -> CM a+happyError' = (\(tokens, _) -> parseError tokens)+fregelparser tks = happySomeParser where+ happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn5 z -> happyReturn z; _other -> notHappyAtAll })++exprparser tks = happySomeParser where+ happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn26 z -> happyReturn z; _other -> notHappyAtAll })++happySeq = happyDontSeq+++-- misc functions++-- extracs the string from a token+strToken :: Lexeme -> String+strToken (L _ _ s) = s++-- reads data from a token+readToken :: Read a => Lexeme -> a+readToken = read . strToken++-- reads data from a token+readTokenF :: Lexeme -> Double+readTokenF = read . correct . strToken+  where correct str =   -- workaround for "0."+          let r = reverse str+          in reverse $ (if head r == '.' then ('0':) else id) r++instance DAdditionalData Lexeme Pos where+  getData (L p t s) = p+  setData p (L _ t s) = L p t s++-- a token must be a specific name+mustbe :: DVar Pos -> String -> CM ()+mustbe (DVar name p) str = if name == str+                            then return ()+                            else error $ "Parse error: variable name must be " ++ str ++ " at " ++ showPosn p+              +parseError :: [Lexeme] -> a+parseError ((L p t s):ts) = error $ "Parse error: " ++ s ++ " at " ++ showPosn p++-- to make negative integral/float literals                                     +isConstNum :: DExpr0 Pos -> Bool+isConstNum (DCExp0 (DCInt _ _) _) = True+isConstNum (DCExp0 (DCDouble _ _) _) = True+isConstNum _ = False++negConst :: DExpr0 Pos -> DExpr0 Pos+negConst (DCExp0 (DCInt i a) b) = (DCExp0 (DCInt (-i) a) b)+negConst (DCExp0 (DCDouble d a) b) = (DCExp0 (DCDouble (-d) a) b)++-- currently, these are meaningless+data Params = Params +            deriving (Eq, Show)++initParams = Params ++data CompilerState  = CompilerState ++type CM a = State CompilerState a++runCM m ps = runState m (initState ps)+    +initState ps = CompilerState++main = do str <- getContents+          let ast0 = parseString0 str+              ast = map convert0 ast0+          print ast0+          print ast++{- for test use+main = do getContents >>= mapM_ (\file -> check file >>= putStrLn . show) . lines+-- checking function: parse = parse . prettyPrint . parse ? +check file = +  do ast <- parseFile file+     print ast+     let pp = foldr (\x y -> x ++ "\n" ++ y) "" (map ppAST0 ast)+     putStrLn pp+     let ast2 = parseString0 pp+     print ast2+     return (map (mapData (\_ -> "")) ast == map (mapData (\_ -> "")) ast2)  --ignore line/pos+-}++--- misc functions to be used by other modules++parseStringExpr0 str = +      let ts = snd (right (scanner str))+          ast = fst $ runCM (exprparser ts) initParams   +      in ast++parseString0 :: String -> [DProgramSpec0 Pos]+parseString0 str = +      let ts = snd (right (scanner str))+          ast = fst $ runCM (fregelparser ts) initParams   +      in ast++parseString :: String -> [DProgramSpec String]+parseString str = map (mapData (\_ -> "")) $ map convert0 $ parseString0 str+         +parseFile file =+         do str <- readFile file+            return $ parseString str +         +processFile file =+  do ast <- parseFile file+     print ast++parseFile' file = +  do ast <- parseFile file+     return ast++parseFile'' file = +  do asts <- parseFile file+     return (propRecs asts)+  where propRecs xs =+          let rss = concatMap (\(DProgramSpec rs _ _) -> rs) xs+          in map (\(DProgramSpec _ x a) -> DProgramSpec rss x a) xs++parseString' ss = parseString ss+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}++++++++# 1 "/usr/include/stdc-predef.h" 1 3 4++# 17 "/usr/include/stdc-predef.h" 3 4++++++++++++++++++++++++++++++++++++++++++++{-# LINE 7 "<command-line>" #-}+{-# LINE 1 "/usr/lib/ghc/include/ghcversion.h" #-}++++++++++++++++{-# LINE 7 "<command-line>" #-}+{-# LINE 1 "/tmp/ghc8336_0/ghc_2.h" #-}+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++{-# LINE 7 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++++++++++{-# LINE 43 "templates/GenericTemplate.hs" #-}++data Happy_IntList = HappyCons Int Happy_IntList++++++++{-# LINE 65 "templates/GenericTemplate.hs" #-}++{-# LINE 75 "templates/GenericTemplate.hs" #-}++{-# LINE 84 "templates/GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is (1), it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =+        happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +         (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++{-# LINE 137 "templates/GenericTemplate.hs" #-}++{-# LINE 147 "templates/GenericTemplate.hs" #-}+indexShortOffAddr arr off = arr Happy_Data_Array.! off+++{-# INLINE happyLt #-}+happyLt x y = (x < y)+++++++readArrayBit arr bit =+    Bits.testBit (indexShortOffAddr arr (bit `div` 16)) (bit `mod` 16)+++++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++++newtype HappyState b c = HappyState+        (Int ->                    -- token number+         Int ->                    -- token number (yes, again)+         b ->                           -- token semantic value+         HappyState b c ->              -- current state+         [HappyState b c] ->            -- state stack+         c)++++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state (1) tk st sts stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (i) -> i }) in+--     trace "shifting the error token" $+     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk+     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k - ((1) :: Int)) sts of+         sts1@(((st1@(HappyState (action))):(_))) ->+                let r = fn stk in  -- it doesn't hurt to always seq here...+                happyDoSeq r (action nt j tk st1 sts1 r)++happyMonadReduce k nt fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+      case happyDrop k ((st):(sts)) of+        sts1@(((st1@(HappyState (action))):(_))) ->+          let drop_stk = happyDropStk k stk in+          happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))++happyMonad2Reduce k nt fn (1) tk st sts stk+     = happyFail [] (1) tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+      case happyDrop k ((st):(sts)) of+        sts1@(((st1@(HappyState (action))):(_))) ->+         let drop_stk = happyDropStk k stk++++++             _ = nt :: Int+             new_state = action++          in+          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))++happyDrop (0) l = l+happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t++happyDropStk (0) l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction++{-# LINE 267 "templates/GenericTemplate.hs" #-}+happyGoto action j tk st = action j j tk (HappyState action)+++-----------------------------------------------------------------------------+-- Error recovery ((1) is the error token)++-- parse error if we are in recovery and we fail again+happyFail explist (1) tk old_st _ stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (i) -> i }) in+--      trace "failing" $ +        happyError_ explist i tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  (1) tk old_st (((HappyState (action))):(sts)) +                                                (saved_tok `HappyStk` _ `HappyStk` stk) =+--      trace ("discarding state, depth " ++ show (length stk))  $+        action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail explist i tk (HappyState (action)) sts stk =+--      trace "entering error recovery" $+        action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll :: a+notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions++++++++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--      happySeq = happyDoSeq+-- otherwise it emits+--      happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.++{-# LINE 333 "templates/GenericTemplate.hs" #-}+{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ compiler/Parser.y view
@@ -0,0 +1,451 @@+{-++cabal install happy alex+        +-}+{+{-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-}+module Parser where+import Lexer hiding (main)+import Spec+import Spec0+import Convert0+import Control.Monad.State+    +}+%monad { CM }+%name fregelparser+%partial exprparser expr+%tokentype { Lexeme }+%error { parseError }++%token+-- special patterns (must be defined first)+  T_INT         { (L _ L_CONSTRUCTOR "Int") }+  T_BOOL        { (L _ L_CONSTRUCTOR "Bool") }+  T_DOUBLE      { (L _ L_CONSTRUCTOR "Double") }+  T_STRING      { (L _ L_CONSTRUCTOR "String") }+  T_PAIR        { (L _ L_CONSTRUCTOR "Pair") }+  A_SUM         { (L _ L_IDENT "sum") }+  A_PROD        { (L _ L_IDENT "prod") }+  A_MINIMUM     { (L _ L_IDENT "minimum") }+  A_MAXIMUM     { (L _ L_IDENT "maximum") }+  A_OR          { (L _ L_IDENT "or") }+  A_AND         { (L _ L_IDENT "and") }+  A_RANDOM      { (L _ L_IDENT "random") }+  G_FREGEL      { (L _ L_IDENT "fregel") }+  G_GMAP        { (L _ L_IDENT "gmap") }+  G_GZIP        { (L _ L_IDENT "gzip") }+  G_GITER       { (L _ L_IDENT "giter") }+  TC_FIX        { (L _ L_CONSTRUCTOR "Fix") }+  TC_ITER       { (L _ L_CONSTRUCTOR "Iter") }+  TC_UNTIL      { (L _ L_CONSTRUCTOR "Until") }+  TC_WHILE      { (L _ L_CONSTRUCTOR "While") }+-- normal tokens+  DATA          { (L _ L_DATA _) }+  DERIVING      { (L _ L_DERIVING _) }+  LET           { (L _ L_LET _) }+  IN            { (L _ L_IN _) }+  IF            { (L _ L_IF _) }+  THEN          { (L _ L_THEN _) }+  ELSE          { (L _ L_ELSE _) }+  CURR          { (L _ L_CURR _) }+  PREV          { (L _ L_PREV _) }+  VAL           { (L _ L_VAL _) }+  IS            { (L _ L_IS _) }+  RS            { (L _ L_RS _) }+  GOF           { (L _ L_GOF _) }+  EQUAL         { (L _ L_EQUAL _) }+  DBLCOLON      { (L _ L_DBLCOLON _) }+  COMMA         { (L _ L_COMMA _) }+  SEMICOLON     { (L _ L_SEMICOLON _) }+  BACKSLASH     { (L _ L_BACKSLASH _) }+  RARROW        { (L _ L_RARROW _) }+  LARROW        { (L _ L_LARROW _) }+  DOTHAT        { (L _ L_DOTHAT _) }+  PIPE          { (L _ L_PIPE _) }+  DBLAND        { (L _ L_DBLAND _) }+  DBLOR         { (L _ L_DBLOR _) }+  EQ            { (L _ L_EQ _) }+  NE            { (L _ L_NE _) }+  LT            { (L _ L_LT _) }+  LE            { (L _ L_LE _) }+  GT            { (L _ L_GT _) }+  GE            { (L _ L_GE _) }+  PLUS          { (L _ L_PLUS _) }+  MINUS         { (L _ L_MINUS _) }+  AST           { (L _ L_AST _) }+  SLASH         { (L _ L_SLASH _) }+  BACKQUOTE     { (L _ L_BACKQUOTE _) }+  LPAREN        { (L _ L_LPAREN _) }  +  RPAREN        { (L _ L_RPAREN _) }+  LBRACE        { (L _ L_LBRACE _) }  +  RBRACE        { (L _ L_RBRACE _) }+  LBRACKET      { (L _ L_LBRACKET _) }  +  RBRACKET      { (L _ L_RBRACKET _) }+  BOOL          { (L _ L_BOOL _) }+  INT           { (L _ L_INT _) }+  FLOAT         { (L _ L_FLOAT _) }+  STRING        { (L _ L_STRING _) }+  IDENT         { (L _ L_IDENT _) }+  CONSTRUCTOR   { (L _ L_CONSTRUCTOR _) }+++%%+-- the start ;  left-recursion is more efficient for Happy (but the list needs to be reversed)+programSpecs :: { [DProgramSpec0 Pos] }+programSpecs : +   programSpec                        { [$1]  }+ | programSpecs SEMICOLON programSpec { $3:$1 }++programSpec :: { DProgramSpec0 Pos }+programSpec :+   recordSpecs smplDef { DProgramSpec0 (reverse $1) $2 (if $1 == [] then getData $2 else getData (head $1)) }++recordSpecs :: { [ DRecordSpec Pos] }+recordSpecs :+   {- empty -}               { [ ] }+ | recordSpecs recordSpec    { $2:$1 }++recordSpec :: { DRecordSpec Pos }+recordSpec :+   DATA constructor EQUAL constructor LBRACE fieldSpecs RBRACE opt_deriving { DRecordSpec $4 (reverse $6) (getData $1) } ++fieldSpecs :: { [(DField Pos, DType Pos)] }+fieldSpecs :+   fieldSpec                    { [$1] }+ | fieldSpecs COMMA fieldSpec   { $3:$1 }++fieldSpec :: { (DField Pos, DType Pos) }+fieldSpec : +   field DBLCOLON type { ($1, $3) }++field :: { DField Pos }+field :+   IDENT  { DField (strToken $1) (getData $1)}++type :: { DType Pos }+type :+   T_INT               { DTInt (getData $1) }+ | T_BOOL              { DTBool (getData $1) }+ | T_STRING            { DTString (getData $1) }+ | T_DOUBLE            { DTDouble (getData $1) }+ | T_PAIR type type    { DTRecord (DConstructor "Pair" (getData $1)) [$2, $3] (getData $1) }+ | LPAREN type RPAREN  { $2 }+ | LPAREN types RPAREN { DTTuple (reverse $2) (getData $1) }+ | CONSTRUCTOR         { DTRecord (DConstructor (strToken $1) (getData $1)) [] (getData $1) }++types :: { [DType Pos] }+types :+   type COMMA type   { [$3, $1]}+ | types COMMA type  { $3:$1 }++-- ignored+opt_deriving :: { () }+opt_deriving :+    {- empty -}                          { () }+  | DERIVING CONSTRUCTOR                 { () }+  | DERIVING LPAREN deriving_constructors RPAREN  { () }++deriving_constructors :: { () }+deriving_constructors :+   CONSTRUCTOR                             { () }+ | deriving_constructors COMMA CONSTRUCTOR { () }++exprWithSmplDefs :: { ([DSmplDef0 Pos], DExpr0 Pos) }+exprWithSmplDefs :+   LET smplDefs IN expr { (reverse $2, $4) }+ | expr                 { ([], $1) }++smplDefs :: { [DSmplDef0 Pos] }+smplDefs :+   smplDef                    { [$1] }+ | smplDefs SEMICOLON smplDef { $3:$1 } ++smplDef :: { DSmplDef0 Pos }+smplDef :+   defFun      { $1 }+ | defVar      { $1 }+ | defTuple    { $1 }+ | defVertComp { $1 } ++defFun :: { DSmplDef0 Pos }+defFun :+   var vars EQUAL exprWithSmplDefs  { DDefFun0 $1 (reverse $2) (fst $4) (snd $4) (getData $1) }++defVar :: { DSmplDef0 Pos }+defVar :+   var EQUAL exprWithSmplDefs       { DDefVar0 $1 (fst $3) (snd $3) (getData $1) }++defTuple :: { DSmplDef0 Pos }+defTuple :+   LPAREN csVars RPAREN EQUAL exprWithSmplDefs { DDefTuple0 (reverse $2) (fst $5) (snd $5) (getData $1) }++defVertComp :: { DSmplDef0 Pos }+defVertComp :+   var var PREV CURR EQUAL exprWithSmplDefs {% mustbe $2 "v" >> return (DDefVertComp0 $1 (fst $6) (snd $6) (getData $1)) }++var :: { DVar Pos }+var :+   IDENT  { DVar (strToken $1) (getData $1)}++vars :: { [DVar Pos] }+vars :+   var      { [$1] }+ | vars var { $2:$1 }++csVars :: { [DVar Pos] }+csVars :+   var COMMA var    { [$3,$1] }+ | csVars COMMA var { $3:$1 }++-- expression hierarchy+expr :: { DExpr0 Pos }+expr :+   expr8                                 { $1 }++expr8 :: { DExpr0 Pos }+expr8 :+   IF expr7 THEN expr7 ELSE expr7        { DIf0 $2 $4 $6 (getData $1) }    + | expr7                                 { $1 }++expr7 :: { DExpr0 Pos }+expr7 :+   expr7 DBLOR expr6                     { DFunAp0 (DBinOp "||" (getData $2)) [$1,$3] (getData $1) }+ | expr6                                 { $1 }++expr6 :: { DExpr0 Pos }+expr6 :+   expr6 DBLAND expr5                    { DFunAp0 (DBinOp "&&" (getData $2)) [$1,$3] (getData $1) }+ | expr5                                 { $1 }++expr5 :: { DExpr0 Pos }+expr5 :+   expr4 LE expr4                        { DFunAp0 (DBinOp "<=" (getData $2)) [$1,$3] (getData $1) }+ | expr4 GE expr4                        { DFunAp0 (DBinOp ">=" (getData $2)) [$1,$3] (getData $1) }+ | expr4 EQ expr4                        { DFunAp0 (DBinOp "==" (getData $2)) [$1,$3] (getData $1) }+ | expr4 NE expr4                        { DFunAp0 (DBinOp "!=" (getData $2)) [$1,$3] (getData $1) }+ | expr4 GT expr4                        { DFunAp0 (DBinOp ">" (getData $2)) [$1,$3] (getData $1) }+ | expr4 LT expr4                        { DFunAp0 (DBinOp "<" (getData $2)) [$1,$3] (getData $1) }+ | expr4                                 { $1 }++expr4 :: { DExpr0 Pos }+expr4 :+   expr3 BACKQUOTE var BACKQUOTE expr3   { DFunAp0 (v2f $3) [$1,$5] (getData $1) }+ | expr4 op4 expr3                       { DFunAp0 (DBinOp $2 (getData $1)) [$1, $3] (getData $1) }+ | expr3                                 { $1 }++op4 :: { String }+op4 :+   PLUS                                  { "+" }+ | MINUS                                 { "-" }++expr3 :: { DExpr0 Pos }+expr3 :+   expr3 op3 expr2                       { DFunAp0 (DBinOp $2 (getData $1)) [$1, $3] (getData $1) }+ | MINUS expr2                           { if isConstNum $2 then negConst $2 else DFunAp0 (DFun "neg" (getData $1)) [$2] (getData $1) }+ | expr2                                 { $1 }++op3 :: { String }+op3 :+   AST                                   { "*" }+ | SLASH                                 { "/" }++expr2 :: { DExpr0 Pos }+expr2 :+   tableExpr DOTHAT dhsFields            { DFieldAcc0 $1 (reverse $3) (getData $1) }+ | tableExpr                             { DFieldAcc0 $1 [] (getData $1) }+ | var DOTHAT dhsFields                  {% mustbe $1 "e" >> return (DFieldAccE0 (DEdge (getData $1)) (reverse $3) (getData $1)) }+ | expr1                                 { $1 }++dhsFields :: { [DField Pos] }+dhsFields :+   field                                 { [$1] }+ | dhsFields DOTHAT field                { $3:$1 }++tableExpr :: { DTableExpr Pos }+tableExpr :+   CURR var                              { DCurr $2 (getData $1) }+ | PREV var                              { DPrev $2 (getData $1) }+ | VAL  var                              { DVal  $2 (getData $1) }+ +expr1 :: { DExpr0 Pos }+expr1 : +   var expr0s                            { DFunAp0 (v2f $1) (reverse $2) (getData $1) }+ | constructor expr0s                    { DConsAp0 $1 (reverse $2) (getData $1) }+ | agg LBRACKET expr PIPE gen csExprs RBRACKET { DAggr0 $1 $3 $5 (reverse $6) (getData $1) }+ | expr0                                 { $1 }+ | G_FREGEL var var termination var      { DPregel0 $2 $3 $4 $5 (getData $1) }+ | G_GMAP var var                        { DGMap0 $2 $3 (getData $1) }+ | G_GZIP var var                        { DGZip0 $2 $3 (getData $1) }+ | G_GITER var var termination var       { DGIter0 $2 $3 $4 $5 (getData $1) }++termination :: { DTermination0 Pos }+termination :+   TC_FIX                            { DTermF0 (getData $1)    }+ | LPAREN TC_ITER expr RPAREN        { DTermI0 $3 (getData $1) }+ | LPAREN TC_UNTIL predExpr RPAREN   { DTermU0 $3 (getData $1) }+ | LPAREN TC_WHILE predExpr RPAREN   { DTermU0 (DFunAp0 (DFun "not" (getData $1)) [$3] (getData $1)) (getData $1) } + | LPAREN termination RPAREN         { $2       }++predExpr :: { DExpr0 Pos }+predExpr :+  LPAREN BACKSLASH var RARROW expr RPAREN {% mustbe $3 "g" >> return $5 }++expr0 :: { DExpr0 Pos }+expr0 :+   constVal                              { DCExp0 $1 (getData $1) }+ | var                                   { DVExp0 $1 (getData $1) }+ | LPAREN expr RPAREN                    { $2          }+ | LPAREN expr COMMA expr csExprs RPAREN { DTuple0 ($2:$4:reverse $5) (getData $1) }++expr0s :: { [DExpr0 Pos] }+expr0s :+   expr0                                 { [$1] }+ | expr0s expr0                          { $2:$1 }++csExprs :: { [DExpr0 Pos] }+csExprs :+   {- empty -}                           { [] }+ | csExprs COMMA expr                    { $3:$1 }++gen :: { DGen Pos }+gen :+   LPAREN var COMMA var RPAREN LARROW IS var {% mustbe $2 "e" >> mustbe $4 "u" >> mustbe $8 "v" >> return (DGenI (getData $1)) }+ | LPAREN var COMMA var RPAREN LARROW RS var {% mustbe $2 "e" >> mustbe $4 "u" >> mustbe $8 "v" >> return (DGenO (getData $1)) }+ | var LARROW GOF var                        {% mustbe $1 "u" >> mustbe $4 "v" >> return (DGenG (getData $1)) }+ | var LARROW var                            {% mustbe $1 "u" >> mustbe $3 "v" >> return (DGenG (getData $1)) }++agg :: { DAgg0 Pos }+agg :+   A_MINIMUM     { DAggMin0 (getData $1)  }+ | A_MAXIMUM     { DAggMax0 (getData $1)  }+ | A_SUM         { DAggSum0 (getData $1)  }+ | A_PROD        { DAggProd0 (getData $1) }+ | A_AND         { DAggAnd0 (getData $1)  }+ | A_OR          { DAggOr0 (getData $1)   }+ | A_RANDOM expr { DAggChoice0 $2 (getData $1)  }++constructor :: { DConstructor Pos }+constructor :+   CONSTRUCTOR { DConstructor (strToken $1) (getData $1) }++constVal :: { DConst Pos }+constVal :+   INT    { DCInt    (readToken $1) (getData $1) }+ | FLOAT  { DCDouble (readTokenF $1) (getData $1) }+ | BOOL   { DCBool   (readToken $1) (getData $1) }+ | STRING { DCString (strToken $1) (getData $1) }+++{ -- misc functions++-- extracs the string from a token+strToken :: Lexeme -> String+strToken (L _ _ s) = s++-- reads data from a token+readToken :: Read a => Lexeme -> a+readToken = read . strToken++-- reads data from a token+readTokenF :: Lexeme -> Double+readTokenF = read . correct . strToken+  where correct str =   -- workaround for "0."+          let r = reverse str+          in reverse $ (if head r == '.' then ('0':) else id) r++instance DAdditionalData Lexeme Pos where+  getData (L p t s) = p+  setData p (L _ t s) = L p t s++-- a token must be a specific name+mustbe :: DVar Pos -> String -> CM ()+mustbe (DVar name p) str = if name == str+                            then return ()+                            else error $ "Parse error: variable name must be " ++ str ++ " at " ++ showPosn p+              +parseError :: [Lexeme] -> a+parseError ((L p t s):ts) = error $ "Parse error: " ++ s ++ " at " ++ showPosn p++-- to make negative integral/float literals                                     +isConstNum :: DExpr0 Pos -> Bool+isConstNum (DCExp0 (DCInt _ _) _) = True+isConstNum (DCExp0 (DCDouble _ _) _) = True+isConstNum _ = False++negConst :: DExpr0 Pos -> DExpr0 Pos+negConst (DCExp0 (DCInt i a) b) = (DCExp0 (DCInt (-i) a) b)+negConst (DCExp0 (DCDouble d a) b) = (DCExp0 (DCDouble (-d) a) b)++-- currently, these are meaningless+data Params = Params +            deriving (Eq, Show)++initParams = Params ++data CompilerState  = CompilerState ++type CM a = State CompilerState a++runCM m ps = runState m (initState ps)+    +initState ps = CompilerState++main = do str <- getContents+          let ast0 = parseString0 str+              ast = map convert0 ast0+          print ast0+          print ast++{- for test use+main = do getContents >>= mapM_ (\file -> check file >>= putStrLn . show) . lines+-- checking function: parse = parse . prettyPrint . parse ? +check file = +  do ast <- parseFile file+     print ast+     let pp = foldr (\x y -> x ++ "\n" ++ y) "" (map ppAST0 ast)+     putStrLn pp+     let ast2 = parseString0 pp+     print ast2+     return (map (mapData (\_ -> "")) ast == map (mapData (\_ -> "")) ast2)  --ignore line/pos+-}++--- misc functions to be used by other modules++parseStringExpr0 str = +      let ts = snd (right (scanner str))+          ast = fst $ runCM (exprparser ts) initParams   +      in ast++parseString0 :: String -> [DProgramSpec0 Pos]+parseString0 str = +      let ts = snd (right (scanner str))+          ast = fst $ runCM (fregelparser ts) initParams   +      in ast++parseString :: String -> [DProgramSpec String]+parseString str = map (mapData (\_ -> "")) $ map convert0 $ parseString0 str+         +parseFile file =+         do str <- readFile file+            return $ parseString str +         +processFile file =+  do ast <- parseFile file+     print ast++parseFile' file = +  do ast <- parseFile file+     return ast++parseFile'' file = +  do asts <- parseFile file+     return (propRecs asts)+  where propRecs xs =+          let rss = concatMap (\(DProgramSpec rs _ _) -> rs) xs+          in map (\(DProgramSpec _ x a) -> DProgramSpec rss x a) xs++parseString' ss = parseString ss++}
+ compiler/README view
@@ -0,0 +1,150 @@++1. Please install alex, happy and groom++   cabal install alex happy groom++2. Then, make it!++   make++ The compiler command fregel must have been produced.++3. Compile your Fregel code ++   ./fregel ../sample-programs/re.fgl++ Two Java files must have been created:++   reAllI.java    for 'reAll' defined in re.fgl.+   re3.java       for 're3' defined in re.fgl.++ If you want to compile it into Pregel+ code, run the following command:++ $ ./fregel -p ../sample-programs/re.fgl++ Two c++ files must have been created:++   reAllI.cpp    for 'reAll' defined in re.fgl.+   re3.cpp       for 're3' defined in re.fgl.++4. Compile the generated code, and Run it++4.1 [Giraph] Compile the Java source and make a jar file, and Run it++ Assumption:+ +   Giraph 1.2.0 is installed in ~/giraph-1.2.0+   Hadoop 1.2.1 is installed in ~/hadoop-1.2.1++ First, make a directory mysrc and extract class files from the jar file of giraph-examples:++   bash+   cd ~+   mkdir mysrc+   cd mysrc+   jar xf ~/giraph-1.2.0/giraph-examples/target/giraph-examples-1.2.0-for-hadoop-1.2.1-jar-with-dependencies.jar+   rm -rf  org/apache/giraph/examples/+   exit++ You can reuse this directory 'mysrc' for multiple fregel programs.++ Next, copy the java files generated by Fregel compiler to the directory mysrc:++   cp *.java ~/mysrc++ Compile the source to make a jar file:++   bash+   cd ~/mysrc+   javac *.java -cp ~/hadoop-1.2.1/hadoop-core-1.2.1.jar:.+   cd ..+   jar cf myprog.jar -C mysrc/ .+   exit+   + Run reAll in the jar file with Hadoop (be careful that the initial letter of the class name is capital):++   ~/hadoop-1.2.1/bin/start-all.sh+   ~/hadoop-1.2.1/bin/hadoop dfs -copyFromLocal ../sample-programs/graph4.txt /user/hduser/input/graph4.txt+   ~/hadoop-1.2.1/bin/hadoop dfs -ls /user/hduser/input+   ~/hadoop-1.2.1/bin/hadoop jar ~/myprog.jar org.apache.giraph.GiraphRunner 'ReAll$VertexComputation' -mc 'ReAll$MasterComputation' -vif 'ReAll$InputFormat' -vof 'ReAll$OutputFormat'-vip /user/hduser/input/graph4.txt -op /user/hduser/output/reAll -w 1 ++ Please replace 'reAll' (and 'ReAll') with others such as 're3' (and 'Re3') to run other programs.+ For example, if you compiled the sssp code (../sample-programs/sssp.fgl), the command is++   ~/hadoop-1.2.1/bin/hadoop jar ~/myprog.jar org.apache.giraph.GiraphRunner 'Sssp$VertexComputation' -mc 'Sssp$MasterComputation' -vif 'Sssp$InputFormat' -vof 'Sssp$OutputFormat' -vip /user/hduser/input/graph4.txt -op /user/hduser/output/sssp -w 1++4.2 [Pregel+] Compile the Java source and make a jar file++ Assumption:++   Hadoop 1.2.1 is installed.+   Pregel+ system is installed.+   MPICH is installed.+   Your system is amd64 (64bit Linux).+   The following environment variables are set properly:++     JAVA_HOME       for the java directiry, e.g., /usr/lib/jvm/java-8-oracle/+     HADOOP_HOME     for the Hadoop directory, e.g., ~/hadoop-1.2.1/+     REGEL_PLUS_HOME for the Pregel+ system directory, e.g., ~/system/+     CLASSPATH       for listing up all jar files about Hadoop (see Pregel+'s document)+     LD_LIBRARY_PATH to include directories of libhdfs.so and libjvm.so, e.g., $HADOOP_HOME/c++/Linux-amd64-64/lib and $JAVA_HOME/jre/lib/amd64/server/++   For example, the last two can be set by the following script (you may append it to your .bashrc):+   +     JPLATFORM=amd64+     PLATFORM=Linux-amd64-64+     export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${HADOOP_HOME}/c++/${PLATFORM}/lib:${JAVA_HOME}/jre/lib/${JPLATFORM}/server/+     CLASSPATH=$( ls $HADOOP_HOME/*.jar $HADOOP_HOME/lib/*.jar | sed -e 'H;$!d;g;s/\n//;s/\n/:/g' )+     export CLASSPATH+++ To compile a Pregel+ code, it is comvenient to use a Makefile with the following content:+ +### Makefile starts ###+CCOMPILE=mpic+++JPLATFORM=amd64+PLATFORM=Linux-amd64-64+CPPFLAGS= -I$(HADOOP_HOME)/src/c++/libhdfs -I$(JAVA_HOME)/include -I$(JAVA_HOME)/include/linux -I$(PREGEL_PLUS_HOME) +LIB = -L$(HADOOP_HOME)/c++/$(PLATFORM)/lib -L$(JAVA_HOME)/jre/lib/$(JPLATFORM)/server/+LDFLAGS = -ljvm -lhdfs -Wno-deprecated -O3++%: %.cpp+	$(CCOMPILE) $< $(CPPFLAGS) $(LIB) $(LDFLAGS) -o $@++### Makefile ends ###++ Copy the Makefile to the same directory as the generated code, e.g., reAll.cpp and re3.cpp.++ Then, the following command builds the executables:++   make reAll re3++ Next, you need to upload your graph data to the specific directory in the HDFS. The directory is /PROGRAM_NAME/input/ for PROGRAM_NAME.cpp .+ For example, you can do it by the following command for reAll.cpp:+ +   ${HADOOP_HOME}/bin/start-dfs.sh+   ${HADOOP_HOME}/bin/hadoop dfs -copyFromLocal ../sample-programs/graph4-pp.txt /reAll/input/graph4-pp.txt+   ${HADOOP_HOME}/bin/hadoop dfs -ls /reAll/input/++ A graph data is a text file in which each line represents a vertex in the following format:++   vid \t val degree nb1 len1 nb2 len2 ...++ Here, nb1, nb2, ... are vids of the neighbors, and len1, len2, ... are values associated to edges to the neighbors.++ Then, you need a machine file that lists the machines to be used in the computation. For example, a simple machine file to use two local cpu cores consists of the following single line:++   localhost:2++ For the details, see Pregel+'s document. + + Now, you are ready to run the program. Execute the following command, in which machines.txt is the machine file and '-n 2' means to use two threads:++   mpirun -f machines.txt -n 2 $(pwd)/reAll++ The output is given in the directory /reAll/output/ in the HDFS. You can check the result by the following command:+ +   ${HADOOP_HOME}/bin/hadoop dfs -cat /reAll/output/*++ In general, the result is given in /PROGRAM_NAME/output for PROGRAM_NAME.cpp .+
+ compiler/Spec.lhs view
@@ -0,0 +1,877 @@+> {-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-}++> module Spec where+> import Control.Monad.State+> import Data.List+++BNF of the DSL (ver 1.0p2)+++position of let-bindings is limited.++Program specification is I/O type definitions and a program body++  ProgramSpec := RecordSpec* Prog+  RecordSpec := 'data' Constructor '=' Constructor '{' Field '::' Type (',' Field '::' Type )* '}' 'deriving' '(' 'Eq' ',' 'Show' ')'+   -- simple version Constructor '{' Field '::' Type (',' Field '::' Type )* '}'+   -- not runnable in Haskell, though++> data DProgramSpec a = DProgramSpec [DRecordSpec a] (DProg a) a deriving (Show, Eq)+> data DRecordSpec a = DRecordSpec (DConstructor a) [(DField a, DType a)] a deriving (Show, Eq)++  +A program body is a graph function with ground definitions.+The argument is 'g'!  (this will be used in all global aggregations)++  Prog := Fun 'g' '=' 'let' GroundDefs 'in' GraphExpr+  GroundDefs := GroundDef (';' GraphDef)*    -- not indentation-based++> data DProg a = DProg (DFun a) [DGroundDef a] (DGraphExpr a) a deriving (Show, Eq)++A ground definition can contain definitions of vertex-compute functions.+A vertex-compute function receives two special tables Prev and Curr.++  GroundDef := DefVertComp | DefVertInit | DefGraphFun | DefGraphVar | SmplDef +  DefVertComp := Fun 'v' 'prev' 'curr' '=' (Expr | 'let' SmplDefs 'in' Expr) +  DefVertInit := Fun 'v' '=' (Expr | 'let' SmplDefs 'in' Expr) +  DefGraphVar := Var '=' GraphExpr+  DefGraphFun := Fun Var '=' (GraphExpr | 'let' DefGraphVars 'in' GraphExpr)++> data DGroundDef a = DGDefVC (DDefVertComp a) a+>                   | DGDefVI (DDefVertInit a) a+>                   | DGDefGV (DDefGraphVar a) a+>                   | DGDefGF (DDefGraphFun a) a+>                   | DGDefSmpl (DSmplDef a) a +>                    deriving (Show, Eq)+> data DDefVertComp a = DDefVertComp (DFun a) [DSmplDef a] (DExpr a) a deriving (Show, Eq)+> data DDefVertInit a = DDefVertInit (DFun a) [DSmplDef a] (DExpr a) a deriving (Show, Eq)+> data DDefGraphVar a = DDefGraphVar (DVar a) (DGraphExpr a) a deriving (Show, Eq)+> data DDefGraphFun a = DDefGraphFun (DFun a) (DVar a) [DDefGraphVar a] (DGraphExpr a) a deriving (Show, Eq)++A graph expression is made by 'pregel', 'gmap', 'gzip', 'giter', ... and restricted 'let' expressions.+-- pregel can be invoked on a variable and not on an expression++  GraphExpr := 'fregel' Fun Fun Termination Var+             | 'gmap' Fun Var+             | 'gzip' Var Var+             | 'giter' Fun Fun Termination Var+             | Var+  Termination := 'Fix'+               | '(' 'Iter' Expr ')'+               | '(' 'UntilAny' PredVExpr ')'+               | '(' 'UntilAll' PredVExpr ')'+               | '(' 'Until' PredExpr ')'+               | '(' 'While' PredExpr ')'+               | '(' Termination ')'++  UltilAny, UntilAll, While are replaced with Until + aux.+  +  PredExpr := '(' '\' 'g' '->' Expr ')'  # "\g->" is necessary to be run on Haskell+  PredVExpr := '(' '\' 'v' '->' Expr ')' # "\v->" is necessary to be run on Haskell+  DefGraphVars := DefGraphVar (';' DefGraphVar)*     -- not indentation-based++> data DGraphExpr a = DPregel (DFun a) (DFun a) (DTermination a) (DGraphExpr a) a -- (DVar a) a+>                   | DGMap (DFun a) (DGraphExpr a) a  -- (DVar a) a+>                   | DGZip (DGraphExpr a) (DGraphExpr a) a --(DVar a) (DVar a) a+>                   | DGIter (DFun a) (DFun a) (DTermination a) (DGraphExpr a) a -- (DVar a) a+>                   | DGVar (DVar a) a+>                    deriving (Show, Eq)+> data DTermination a = DTermF a+>                     | DTermI (DExpr a) a+>                     | DTermU (DExpr a) a+>                     | DTermV2H a           -- for internal use+>                      deriving (Show, Eq)++Definition of simple functions and variables (+ tuple binding).+(Is it necessary to distiguish these two?)++  SmplDef := DefFun | DefVar | DefTuple+  DefFun := Fun Var+ '=' (Expr | 'let' SmplDefs 'in' Expr)+  DefVar := Var '=' (Expr | 'let' SmplDefs 'in' Expr)+  DefTuple := '(' Var (',' Var)+ ')' '=' (Expr | 'let' SmplDefs 'in' Expr)+  SmplDefs := SmplDef (';' SmplDef)*             -- not indentation-based++> data DSmplDef a = DDefFun (DFun a) [DVar a] [DSmplDef a] (DExpr a) a+>                 | DDefVar (DVar a) [DSmplDef a] (DExpr a) a+>                 | DDefTuple [DVar a] [DSmplDef a] (DExpr a) a+>                  deriving (Show, Eq)++Expressions.+No anonimous function.+No let-expression ("let" is only allowed in the head of a function definition).++  Expr := If | Tuple | FunAp | Var | Const | FieldAccess | Aggr+        | '(' Expr ')'   -- this is for concrete syntax++  If := 'if' Expr 'then' Expr 'else' Expr+  Tuple := '(' Expr (',' Expr)+ ')'+  FunAp := Fun Expr++         | Constructor Expr++         | Expr '`' Fun '`' Expr+         | Expr BinOp Expr++  FieldAccess := (TableExpr | Edge ) (('.^' ('_fst' | '_snd'))* '.^' Field)?+  TableExpr := 'curr' Var | 'prev' Var | 'val' Var++Aggr := Agg '[' Expr '|' Gen (',' Expr )* ']'+      | Agg Expr '[' Expr '|' Gen (',' Expr )* ']'++  Edge := 'e'++  Gen := '(' 'e' ',' 'u' ')' '<-' 'is' 'v'+       | '(' 'e' ',' 'u' ')' '<-' 'rs' 'v'+       | 'u' '<-' 'g'   ++> data DExpr a = DIf (DExpr a) (DExpr a) (DExpr a) a+>              | DTuple [DExpr a] a+>              | DFunAp (DFun a) [DExpr a] a+>              | DConsAp (DConstructor a) [DExpr a] a+>              | DFieldAcc (DTableExpr a) [DField a] a+>              | DFieldAccE (DEdge a) [DField a] a+>              | DAggr (DAgg a) (DExpr a) (DGen a) [DExpr a] a+>              | DCheckTerm (DExpr a) a -- Iwasaki: condition for termination+>              | DVExp (DVar a) a+>              | DCExp (DConst a) a+>              deriving (Show, Eq)+> data DGen a = DGenI a+>             | DGenO a+>             | DGenG a+>             | DGenTermG a  -- Iwasaki; aggregation for judging termination+>             deriving (Show, Eq)+> data DEdge a = DEdge a deriving (Show, Eq)+> data DTableExpr a = DPrev (DVar a) a+>                   | DCurr (DVar a) a+>                   | DVal (DVar a) a+>                   deriving (Show, Eq)++The identities must start with small letters or the underscore.+Prime symbols are allowed only at the end.++  BinOP := '+' | '-' | '*' | '/'+         | '==' | '!=' | '<' | '>' | '>=' | '<=' +         | '&&' | '||'+  Agg := 'minimum' | 'maximum' | 'sum' | 'prod' | 'and' | 'or' | 'choice'+  Fun := [a-z_][a-zA-Z_0-9]*[']*+  Var := [a-z_][a-zA-Z_0-9]*[']*+  Field := [a-z_][a-zA-Z_0-9]*[']*+  Constructor := [A-Z][a-zA-Z_0-9]*[']*++> data DAgg a = DAggMin a+>             | DAggMax a+>             | DAggSum a+>             | DAggProd a+>             | DAggAnd a+>             | DAggOr a+>             | DAggChoice (DExpr a) a  -- random choice with default value+>             | DTupledAgg [DAgg a] a   -- for internal use+>               deriving (Show, Eq)+> data DConstructor a = DConstructor String a deriving (Show, Eq)+> data DFun a = DFun String a +>             | DBinOp String a +>               deriving (Show, Eq)+> data DVar a = DVar String a deriving (Show, Eq)+> data DField a = {- DFfst a | DFsnd a | -} DField String a deriving (Show, Eq)++Constants (integer, boolean, string, floating point number, ...)++ Const := Integer | Boolean | String | Double ++ Integer := '-'? ( [1-9][0-9]* | '0' )+ Boolean := 'True' | 'False'+ String  := '"' [^"]* '"'                  -- simple definition+ Double  := '-'? ( [1-9][0-9]* | '0' ) '.' [0-9]* ++> data DConst a = DCInt Int a +>               | DCBool Bool a +>               | DCString String a+>               | DCDouble Double a+>                 deriving (Show, Eq)++Types of each component in the I/O records.++ Type := 'Int' | 'Bool' | 'String' | 'Double' | '(' Type (',' Type)* ')'++> data DType a = DTInt a+>             | DTBool a+>             | DTString a+>             | DTDouble a+>             | DTTuple [DType a] a+>             | DTRecord (DConstructor a) [DType a] a  -- for internal use+>               deriving (Show, Eq)++------------------------- pretty printer? ------------------++> ppList :: String -> [String] -> String+> ppList c ss = foldr (\(s, c) r -> c ++ s ++ r) "" $ zip ss ("":repeat c)++> ppProgramSpec :: DProgramSpec a -> [String]+> ppProgramSpec (DProgramSpec rs p _) =+>   (concatMap ppRecordSpec rs) ++ ppProg p++> ppRecordSpec :: DRecordSpec a -> [String]+> ppRecordSpec (DRecordSpec c fts _) =+>   ["data " ++ ppConstructor c ++ " = " ++ ppConstructor c ++ "{" ++ ppfts ++ "} deriving (Eq, Show)"]+>   where ppfts = ppList ", " (map (\(f, t) -> ppField f++"::"++ppType t) fts)++> indentWith :: String -> [String] -> [String]+> indentWith s (l:ls) = (s++l) :map ((map (const ' ') s)++) ls+> indentWith s ([]) = []++> indent :: [String] -> [String]+> indent ls = indentWith "  " ls++> ppProg :: DProg a -> [String]+> ppProg (DProg f ds e _) = [ppFun f ++ " g = "] ++ rest+>   where rest = if length ds == 0 then indent (ppGraphExpr e)+>                else indent $ let_in (concat $ insList ";" "" $ map ppGroundDef ds) (ppGraphExpr e)++> let_in :: [String] -> [String] -> [String]+> let_in ds e = indentWith "let " ds ++ indentWith "in " e++> ppGroundDef :: DGroundDef a -> [String]+> ppGroundDef (DGDefVC d _) = ppDefVertComp d+> ppGroundDef (DGDefVI d _) = ppDefVertInit d+> ppGroundDef (DGDefGV d _) = ppDefGraphVar d +> ppGroundDef (DGDefGF d _) = ppDefGraphFun d+> ppGroundDef (DGDefSmpl d _) = ppSmplDef d++> ppDefVertComp :: DDefVertComp a -> [String]+> ppDefVertComp (DDefVertComp f ds e _) =+>   if length ds == 0 then indentWith (ppFun f ++ " v prev curr = ") (ppExpr e)+>   else [ppFun f ++" v prev curr = "] ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef ds) (ppExpr e))++> ppDefVertInit :: DDefVertInit a -> [String]+> ppDefVertInit (DDefVertInit f ds e _) =+>   if length ds == 0 then indentWith (ppFun f ++ " v = ") (ppExpr e)+>   else [ppFun f ++" v = "] ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef ds) (ppExpr e))++> ppDefGraphVar :: DDefGraphVar a -> [String]+> ppDefGraphVar (DDefGraphVar v e _) =+>   indentWith (ppVar v ++ " = ") (ppGraphExpr e)+>   ++> ppDefGraphFun :: DDefGraphFun a -> [String]+> ppDefGraphFun (DDefGraphFun f v ds e _) =+>   if length ds == 0+>   then header ++ indent (ppGraphExpr e)+>   else header ++ indent (let_in (concat $ insList ";" "" $ map ppDefGraphVar ds) (ppGraphExpr e))+>   where header = [ ppFun f ++ " " ++ (ppVar v) ++ " = " ]++> ppGraphExpr :: DGraphExpr a -> [String]  -- this is a singleton list (of String)+> ppGraphExpr (DPregel f0 ft t g _) =+>   [ppList " " (["fregel", ppFun f0, ppFun ft, ppTermination t] ++ (addParen $ ppGraphExpr g))]+> ppGraphExpr (DGMap f g _) =+>   [ppList " " (["gmap", ppFun f] ++ (addParen $ ppGraphExpr g))]+> ppGraphExpr (DGZip g1 g2 _) =+>   [ppList " " (["gzip"] ++ (addParen $ ppGraphExpr g1) ++ (addParen $ ppGraphExpr g2))]+> ppGraphExpr (DGIter f0 ft t g _) =+>   [ppList " " (["giter", ppFun f0, ppFun ft, ppTermination t] ++ (addParen $ ppGraphExpr g))]+> ppGraphExpr (DGVar g _) = +>   [ppVar g]+> addParen [s] = ["(" ++ s ++ ")"]++> ppTermination :: DTermination a -> String+> ppTermination (DTermF _)= "Fix"+> ppTermination (DTermI e _) = "(Iter (" ++ ppList " " (ppExpr e) ++ "))"+> ppTermination (DTermU e _) = "(Until (\\g->" ++ ppList " " (ppExpr e) ++ "))"+> ppTermination (DTermV2H _) = "V2H"++> ppSmplDef :: DSmplDef a -> [String]+> ppSmplDef (DDefFun f vs ds e _) =+>   if length ds == 0+>   then header ++ indent (ppExpr e)+>   else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef ds) (ppExpr e))+>   where header = [ ppFun f ++ " " ++ ppList " " (map ppVar vs) ++ " = " ]+> ppSmplDef (DDefVar v ds e _) = +>   if length ds == 0+>   then header ++ indent (ppExpr e)+>   else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef ds) (ppExpr e))+>   where header = [ ppVar v ++ " = "]+> ppSmplDef (DDefTuple vs ds e _) = +>   if length ds == 0+>   then header ++ indent (ppExpr e)+>   else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef ds) (ppExpr e))+>   where header = ["(" ++ ppList ", " (map ppVar vs) ++ ") = "]++> ppExpr :: DExpr a-> [String]+> ppExpr (DIf c t e _) = indentWith "if " (ppExpr c) +++>                        indentWith "then " (ppExpr t) +++>                        indentWith "else " (ppExpr e)+> ppExpr (DTuple es _) = indentWith "(" (concat $ insList "," ")" $ map ppExpr es)+> ppExpr (DFunAp (DBinOp o _) (e1:e2:[]) _) = [flatE e1 ++ " " ++ o ++ " " ++ flatE e2]+> ppExpr (DFunAp f es _) = [ppList " " (ppFun f: map flatE es)]+> ppExpr (DConsAp c es _) = [ppList " " (ppConstructor c: map flatE es)]+> ppExpr (DFieldAcc e fs _) = [ ppTableExpr e ++ (concat $ map ((".^"++).ppField) fs) ]+> ppExpr (DFieldAccE e fs _) = [ ppEdge e ++ (concat $ map ((".^"++).ppField) fs) ]+> ppExpr (DAggr a e g es _) =+>   [ppAgg a ++ " [ " ++ flatE2 e ++  " | " ++ ppGen g ++ ps ++ " ] "]+>   where ps = if length es == 0 then ""+>              else "," ++ ppList "," (map flatE es)+> ppExpr (DVExp v _) = [ppVar v]+> ppExpr (DCExp c _) = [ppConst c]++> ppTableExpr (DPrev v _) = "prev " ++ ppVar v+> ppTableExpr (DCurr v _) = "curr " ++ ppVar v+> ppTableExpr (DVal v _) = "val " ++ ppVar v++> ppEdge (DEdge _) = "e"++> ppAgg (DAggMin _)  = "minimum"+> ppAgg (DAggMax _)  = "maximum"+> ppAgg (DAggSum _)  = "sum"+> ppAgg (DAggProd _) = "prod"+> ppAgg (DAggAnd _)  = "and"+> ppAgg (DAggOr _)   = "or"+> ppAgg (DAggChoice x _) = "random " ++ flatE x++> ppGen (DGenI _) = "(e, u) <- is v"+> ppGen (DGenO _) = "(e, u) <- rs v"+> ppGen (DGenG _) = "u <- g"+> ppGen (DGenTermG _) = "u <- g"++> flatE :: DExpr a -> String+> flatE = enclose . ppList " " . ppExpr++> flatE2 :: DExpr a -> String+> flatE2 = ppList " " . ppExpr++> enclose :: String -> String+> enclose s = "(" ++ s ++ ")"++> insList :: String -> String -> [[String]] -> [[String]]+> insList c cl sss = map (\(ss, s) -> init ss ++ ((last ss++s):[])) $ reverse $ zip (reverse sss) (cl:repeat c)++> ppField (DField f _) = f+> -- ppField (DFfst _) = "_fst"+> -- ppField (DFsnd _) = "_snd"+> ppFun (DFun f _) = f+> ppFun (DBinOp f _) = "(" ++ f ++ ")"+> ppVar (DVar v _) = v+> ppType (DTInt _) = "Int"+> ppType (DTBool _) = "Bool"+> ppType (DTString _) = "String"+> ppType (DTDouble _) = "Double"+> ppType (DTTuple ts _) = "(" ++ ppList ", " (map ppType ts) ++ ")"+> ppType (DTRecord c [] _) = getName c+> ppType (DTRecord c ts _) = "(" ++ getName c ++ concatMap (" "++) (map ppType ts) ++ ")"+> ppConstructor (DConstructor c _) = c++> ppConst (DCInt i _) = show i+> ppConst (DCBool b _) = show b+> ppConst (DCString s _) = "\"" ++ s ++ "\""+> ppConst (DCDouble d _) = show d++++> ppAST :: DProgramSpec a -> String+> ppAST = unlines . ppProgramSpec++> right (Right a) = a+> right (Left a) = error $ show a+++> class PrettyShow a where+>     prettyShow :: a -> String++> flattening = removeMultiSpace . ppList " "+> removeMultiSpace s = map fst $ filter (\(a, b) -> not (a == ' ' && b == ' ')) $ zip s ('@':init s)++> instance PrettyShow (DProgramSpec a) where+>     prettyShow = flattening . ppProgramSpec ++> instance PrettyShow (DTermination a) where+>     prettyShow = ppTermination++> instance PrettyShow (DDefGraphFun a) where+>     prettyShow = flattening . ppDefGraphFun++> instance PrettyShow (DDefGraphVar a) where+>     prettyShow = flattening . ppDefGraphVar++> instance PrettyShow (DRecordSpec a) where+>     prettyShow = flattening . ppRecordSpec ++> instance PrettyShow (DProg a) where+>     prettyShow = flattening . ppProg++> instance PrettyShow (DGroundDef a) where+>     prettyShow = flattening . ppGroundDef++> instance PrettyShow (DExpr a) where+>     prettyShow = flattening . ppExpr++> instance PrettyShow (DSmplDef a) where+>     prettyShow = flattening . ppSmplDef++> instance PrettyShow (DDefVertInit a) where+>     prettyShow = flattening . ppDefVertInit++> instance PrettyShow (DDefVertComp a) where+>     prettyShow = flattening . ppDefVertComp++> class DAdditionalData a b | a -> b where+>     getData :: a -> b+>     setData :: b -> a -> a++> instance DAdditionalData (DProgramSpec a) a where+>     getData (DProgramSpec _ _ a) = a+>     setData b (DProgramSpec rs p _) = DProgramSpec rs p b++> instance DAdditionalData (DRecordSpec a) a where+>     getData (DRecordSpec _ _ a) = a+>     setData b (DRecordSpec c fs _) = DRecordSpec c fs b+> instance DAdditionalData (DProg a) a where+>     getData (DProg _ _ _ a) = a+>     setData b (DProg f ds e _) = DProg f ds e b++> instance DAdditionalData (DGroundDef a) a where+>     getData (DGDefVC _ a) = a+>     getData (DGDefVI _ a) = a+>     getData (DGDefGV _ a) = a+>     getData (DGDefGF _ a) = a+>     getData (DGDefSmpl _ a) = a+>     setData b (DGDefVC x _) = DGDefVC x b+>     setData b (DGDefVI x _) = DGDefVI x b+>     setData b (DGDefGV x _) = DGDefGV x b+>     setData b (DGDefGF x _) = DGDefGF x b+>     setData b (DGDefSmpl x _) = DGDefSmpl x b++> instance DAdditionalData (DDefVertComp a) a where+>     getData (DDefVertComp _ _ _ a) = a+>     setData b (DDefVertComp f ds e _) = DDefVertComp f ds e b++> instance DAdditionalData (DDefVertInit a) a where+>     getData (DDefVertInit _ _ _ a) = a+>     setData b (DDefVertInit f ds e _) = DDefVertInit f ds e b++> instance DAdditionalData (DDefGraphVar a) a where+>     getData (DDefGraphVar _ _ a) = a+>     setData b (DDefGraphVar v e _) = DDefGraphVar v e b++> instance DAdditionalData (DDefGraphFun a) a where+>     getData (DDefGraphFun _ _ _  _ a) = a+>     setData b (DDefGraphFun f v ds e _) = DDefGraphFun f v ds e b++> instance DAdditionalData (DGraphExpr a) a where+>     getData (DPregel _ _ _ _ a) = a+>     getData (DGMap _ _ a) = a+>     getData (DGZip _ _ a) = a+>     getData (DGIter _ _ _ _ a) = a+>     getData (DGVar _ a) = a+>     setData b (DPregel f0 ft x g _) = DPregel f0 ft x g b+>     setData b (DGMap f g _) = DGMap f g b+>     setData b (DGZip g1 g2 _) = DGZip g1 g2 b+>     setData b (DGIter f0 ft x g _) = DGIter f0 ft x g b+>     setData b (DGVar g _) = DGVar g b++> instance DAdditionalData (DTermination a) a where+>     getData (DTermF a) = a+>     getData (DTermI _ a) = a+>     getData (DTermU _ a) = a+>     getData (DTermV2H a) = a+>     setData b (DTermF _) = DTermF b+>     setData b (DTermI e _) = DTermI e b+>     setData b (DTermU e _) = DTermU e b+>     setData b (DTermV2H _) = DTermV2H b++> instance DAdditionalData (DSmplDef a) a where+>     getData (DDefFun _ _ _ _ a) = a+>     getData (DDefVar _ _ _ a) = a+>     getData (DDefTuple _ _ _ a) = a+>     setData b (DDefFun f vs ds e _) = DDefFun f vs ds e b+>     setData b (DDefVar v ds e _) = DDefVar v ds e b+>     setData b (DDefTuple vs ds e _) = DDefTuple vs ds e b++> instance DAdditionalData (DExpr a) a where+>     getData (DIf _ _ _ a) = a+>     getData (DTuple _ a) = a+>     getData (DFunAp _ _ a) = a+>     getData (DConsAp _ _ a) = a+>     getData (DFieldAcc _ _ a) = a+>     getData (DFieldAccE _ _ a) = a+>     getData (DAggr _ _ _ _ a) = a+>     getData (DVExp _ a) = a+>     getData (DCExp _ a) = a+>     setData b (DIf p t e _) = DIf p t e b+>     setData b (DTuple es _) = DTuple es b+>     setData b (DFunAp f es _) = DFunAp f es b+>     setData b (DConsAp c es _) = DConsAp c es b+>     setData b (DFieldAcc t fs _) = DFieldAcc t fs b+>     setData b (DFieldAccE e fs _) = DFieldAccE e fs b+>     setData b (DAggr a e g es _) = DAggr a e g es b+>     setData b (DVExp v _) = DVExp v b+>     setData b (DCExp v _) = DCExp v b++> instance DAdditionalData (DGen a) a where+>     getData (DGenI a) = a+>     getData (DGenO a) = a+>     getData (DGenG a) = a+>     getData (DGenTermG a) = a+>     setData b (DGenI _) = DGenI b+>     setData b (DGenO _) = DGenO b+>     setData b (DGenG _) = DGenG b+>     setData b (DGenTermG _) = DGenTermG b++> instance DAdditionalData (DEdge a) a where+>     getData (DEdge a) = a+>     setData b (DEdge _) = DEdge b++> instance DAdditionalData (DTableExpr a) a where+>     getData (DPrev _ a) = a+>     getData (DCurr _ a) = a+>     getData (DVal _ a) = a+>     setData b (DPrev v _) = DPrev v b+>     setData b (DCurr v _) = DCurr v b+>     setData b (DVal v _) = DVal v b+++> instance DAdditionalData (DAgg a) a where+>     getData (DAggMin a) = a+>     getData (DAggMax a) = a+>     getData (DAggSum a) = a+>     getData (DAggProd a) = a+>     getData (DAggAnd a) = a+>     getData (DAggOr a) = a+>     getData (DAggChoice x a) = a+>     getData (DTupledAgg _ a) = a+>     setData b (DAggMin _) = DAggMin b+>     setData b (DAggMax _) = DAggMax b+>     setData b (DAggSum _) = DAggSum b+>     setData b (DAggProd _) = DAggProd b+>     setData b (DAggAnd _) = DAggAnd b+>     setData b (DAggOr _) = DAggOr b+>     setData b (DAggChoice x _) = DAggChoice x b+>     setData b (DTupledAgg ags _) = DTupledAgg ags b++> instance DAdditionalData (DConstructor a) a where+>     getData (DConstructor _ a) = a+>     setData b (DConstructor c _) = DConstructor c b++> instance DAdditionalData (DFun a) a where+>     getData (DFun _ a) = a+>     getData (DBinOp _ a) = a+>     setData b (DFun f _) = DFun f b+>     setData b (DBinOp f _) = DBinOp f b++> instance DAdditionalData (DVar a) a where+>     getData (DVar _ a) = a+>     setData b (DVar v _) = DVar v b++> instance DAdditionalData (DField a) a where+>     -- getData (DFfst a) = a+>     -- getData (DFsnd a) = a+>     getData (DField _ a) = a+>     -- setData b (DFfst _) = DFfst b+>     -- setData b (DFsnd _) = DFsnd b+>     setData b (DField f _) = DField f b++> instance DAdditionalData (DConst a) a where+>     getData (DCInt _ a) = a+>     getData (DCBool _ a) = a+>     getData (DCString _ a) = a+>     getData (DCDouble _ a) = a+>     setData b (DCInt c _) = DCInt c b+>     setData b (DCBool c _) = DCBool c b+>     setData b (DCString c _) = DCString c b+>     setData b (DCDouble c _) = DCDouble c b++> instance DAdditionalData (DType a) a where+>     getData (DTInt a) = a+>     getData (DTBool a) = a+>     getData (DTString a) = a+>     getData (DTDouble a) = a+>     getData (DTTuple _ a) = a+>     getData (DTRecord _ _ a) = a+>     setData b (DTInt _) = DTInt b+>     setData b (DTBool _) = DTBool b+>     setData b (DTString _) = DTString b+>     setData b (DTDouble _) = DTDouble b+>     setData b (DTTuple ts _) = DTTuple ts b+>     setData b (DTRecord c fs _) = DTRecord c fs b++> getName :: (DNamed a) => a -> String+> getName = head . getNames++> class DNamed a where+>     getNames :: a -> [String]+>     setNames :: a -> State [String] a++> nextName :: State [String] String+> nextName = do xs <- get; put (tail xs); return (head xs)++> instance DNamed (DFun a) where+>     getNames (DFun f _) = [f]+>     getNames (DBinOp f _) = [f]+>     setNames (DFun _ a) = +>         do n <- nextName+>            return (DFun n a)+>     setNames (DBinOp _ a) = +>         do n <- nextName+>            return (DFun n a)++> instance DNamed (DField a) where+>     getNames (DField f _) = [f]+>     setNames (DField _ a) = +>         do n <- nextName+>            return (DField n a)++> instance DNamed (DVar a) where+>     getNames (DVar f _) = [f]+>     setNames (DVar _ a) = +>         do n <- nextName+>            return (DVar n a)++> instance DNamed (DConstructor a) where+>     getNames (DConstructor c _) = [c]+>     setNames (DConstructor _ a) = +>         do n <- nextName+>            return (DConstructor n a)++> instance DNamed (DRecordSpec a) where+>     getNames (DRecordSpec c fts _) = getNames c ++ concatMap getNames (map fst fts)+>     setNames (DRecordSpec c fts a) = +>         do c' <- setNames c+>            fs' <- mapM setNames (map fst fts)+>            let fts' = zipWith (\ft f -> (f, snd ft)) fts fs'+>            return (DRecordSpec c' fts' a)++> instance DNamed (DGroundDef a) where+>     getNames (DGDefVI d _) = getNames d+>     getNames (DGDefVC d _) = getNames d+>     getNames (DGDefGV d _) = getNames d+>     getNames (DGDefGF d _) = getNames d+>     getNames (DGDefSmpl d _) = getNames d+>     setNames (DGDefVI d a) = do d' <- setNames d; return (DGDefVI d' a)+>     setNames (DGDefVC d a) = do d' <- setNames d; return (DGDefVC d' a)+>     setNames (DGDefGV d a) = do d' <- setNames d; return (DGDefGV d' a)+>     setNames (DGDefGF d a) = do d' <- setNames d; return (DGDefGF d' a)+>     setNames (DGDefSmpl d a) = do d' <- setNames d; return (DGDefSmpl d' a)++> instance DNamed (DProgramSpec a) where+>     getNames (DProgramSpec _ p _) = getNames p+>     setNames (DProgramSpec rs p a) = do p' <- setNames p; return (DProgramSpec rs p' a)++> instance DNamed (DProg a) where+>     getNames (DProg f _ _ _) = getNames f+>     setNames (DProg f ds e a) = do f' <- setNames f; return (DProg f' ds e a)++> instance DNamed (DDefVertComp a) where+>     getNames (DDefVertComp f _ _ _) = getNames f+>     setNames (DDefVertComp f ds e a) = do f' <- setNames f; return (DDefVertComp f' ds e a)++> instance DNamed (DDefVertInit a) where+>     getNames (DDefVertInit f _ _ _) = getNames f+>     setNames (DDefVertInit f ds e a) = do f' <- setNames f; return (DDefVertInit f' ds e a)++> instance DNamed (DDefGraphVar a) where+>     getNames (DDefGraphVar v _ _) = getNames v+>     setNames (DDefGraphVar v e a) = do v' <- setNames v; return (DDefGraphVar v' e a)++> instance DNamed (DDefGraphFun a) where+>     getNames (DDefGraphFun f _ _ _ _) = getNames f+>     setNames (DDefGraphFun f vs ds e a) = do f' <- setNames f; return (DDefGraphFun f' vs ds e a)++> instance DNamed (DSmplDef a) where+>     getNames (DDefFun f _ _ _ _) = getNames f+>     getNames (DDefVar v _ _ _) = getNames v+>     getNames (DDefTuple vs _ _ _) = concatMap getNames vs+>     setNames (DDefFun f vs ds e a) = do f' <- setNames f; return (DDefFun f' vs ds e a)+>     setNames (DDefVar v ds e a) = do v' <- setNames v; return (DDefVar v' ds e a)+>     setNames (DDefTuple vs ds e a) = do vs' <- mapM setNames vs; return (DDefTuple vs' ds e a)++> instance DNamed (DGen a) where+>     getNames (DGenI _) = ["e", "u"]+>     getNames (DGenO _) = ["e", "u"]+>     getNames (DGenG _) = ["u"]+>     getNames (DGenTermG _) = ["u"]+>     setNames (DGenI a) = do nextName; nextName; return (DGenI a)+>     setNames (DGenO a) = do nextName; nextName; return (DGenO a)+>     setNames (DGenG a) = do nextName; return (DGenG a)+>     setNames (DGenTermG a) = do nextName; return (DGenTermG a)+++> mmapData f = map (mapData f)++> class DAdditionalData2 a b c d | a c -> b d where+>     mapData :: (b -> c) -> a -> d++> instance DAdditionalData2 (DProgramSpec a) a c (DProgramSpec c) where+>     mapData f (DProgramSpec rs p a) = DProgramSpec (mmapData f rs) (mapData f p) (f a)++> instance DAdditionalData2 (DRecordSpec a) a c (DRecordSpec c) where+>     mapData f (DRecordSpec c fs a) = DRecordSpec (mapData f c) fs' (f a)+>                                      where fs' = zip (mmapData f $ map fst fs) (mmapData f $ map snd fs)+> instance DAdditionalData2 (DProg a) a c (DProg c) where+>     mapData f (DProg f' ds e a) = DProg (mapData f f') (mmapData f ds) (mapData f e) (f a)++> instance DAdditionalData2 (DGroundDef a) a c (DGroundDef c) where+>     mapData f (DGDefVI x a) = DGDefVI (mapData f x) (f a)+>     mapData f (DGDefVC x a) = DGDefVC (mapData f x) (f a)+>     mapData f (DGDefGV x a) = DGDefGV (mapData f x) (f a)+>     mapData f (DGDefGF x a) = DGDefGF (mapData f x) (f a)+>     mapData f (DGDefSmpl x a) = DGDefSmpl (mapData f x) (f a)++> instance DAdditionalData2 (DDefVertComp a) a c (DDefVertComp c) where+>     mapData f (DDefVertComp f' ds e a) = DDefVertComp (mapData f f') (mmapData f ds) (mapData f e) (f a)++> instance DAdditionalData2 (DDefVertInit a) a c (DDefVertInit c) where+>     mapData f (DDefVertInit f' ds e a) = DDefVertInit (mapData f f') (mmapData f ds) (mapData f e) (f a)++> instance DAdditionalData2 (DDefGraphVar a) a c (DDefGraphVar c) where+>     mapData f (DDefGraphVar v e a) = DDefGraphVar (mapData f v) (mapData f e) (f a)++> instance DAdditionalData2 (DDefGraphFun a) a c (DDefGraphFun c) where+>     mapData f (DDefGraphFun f' v ds e a) = DDefGraphFun (mapData f f') (mapData f v) (mmapData f ds) (mapData f e) (f a)++> instance DAdditionalData2 (DGraphExpr a) a c (DGraphExpr c) where+>     mapData f (DPregel f0 ft x g a) = DPregel (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)+>     mapData f (DGMap f' g a) = DGMap (mapData f f') (mapData f g) (f a)+>     mapData f (DGZip g1 g2 a) = DGZip (mapData f g1) (mapData f g2) (f a)+>     mapData f (DGIter f0 ft x g a) = DGIter (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)+>     mapData f (DGVar g a) = DGVar (mapData f g) (f a)++> instance DAdditionalData2 (DTermination a) a c (DTermination c) where+>     mapData f (DTermF a) = DTermF (f a)+>     mapData f (DTermI e a) = DTermI (mapData f e) (f a)+>     mapData f (DTermU e a) = DTermU (mapData f e) (f a)+>     mapData f (DTermV2H a) = DTermV2H (f a)++> instance DAdditionalData2 (DSmplDef a) a c (DSmplDef c) where+>     mapData f (DDefFun f' vs ds e a) = DDefFun (mapData f f') (mmapData f vs) (mmapData f ds) (mapData f e) (f a)+>     mapData f (DDefVar v ds e a) = DDefVar (mapData f v) (mmapData f ds) (mapData f e) (f a)+>     mapData f (DDefTuple vs ds e a) = DDefTuple (mmapData f vs) (mmapData f ds) (mapData f e) (f a)++> instance DAdditionalData2 (DExpr a) a c (DExpr c) where+>     mapData f (DIf p t e a) = DIf (mapData f p) (mapData f t) (mapData f e) (f a)+>     mapData f (DTuple es a) = DTuple (mmapData f es) (f a)+>     mapData f (DFunAp f' es a) = DFunAp (mapData f f') (mmapData f es) (f a)+>     mapData f (DConsAp c es a) = DConsAp (mapData f c) (mmapData f es) (f a)+>     mapData f (DFieldAcc t fs a) = DFieldAcc (mapData f t) (mmapData f fs) (f a)+>     mapData f (DFieldAccE e fs a) = DFieldAccE (mapData f e) (mmapData f fs) (f a)+>     mapData f (DAggr a' e g es a) = DAggr (mapData f a') (mapData f e) (mapData f g) (mmapData f es) (f a)+>     mapData f (DVExp v a) = DVExp (mapData f v) (f a)+>     mapData f (DCExp v a) = DCExp (mapData f v) (f a)++> instance DAdditionalData2 (DGen a) a c (DGen c) where+>     mapData f (DGenI a) = DGenI (f a)+>     mapData f (DGenO a) = DGenO (f a)+>     mapData f (DGenG a) = DGenG (f a)+>     mapData f (DGenTermG a) = DGenTermG (f a)++> instance DAdditionalData2 (DEdge a) a c (DEdge c) where+>     mapData f (DEdge a) = DEdge (f a)++> instance DAdditionalData2 (DTableExpr a) a c (DTableExpr c) where+>     mapData f (DPrev v a) = DPrev (mapData f v) (f a)+>     mapData f (DCurr v a) = DCurr (mapData f v) (f a)+>     mapData f (DVal v a) = DVal (mapData f v) (f a)+++> instance DAdditionalData2 (DAgg a) a c (DAgg c) where+>     mapData f (DAggMin a) = DAggMin (f a)+>     mapData f (DAggMax a) = DAggMax (f a)+>     mapData f (DAggSum a) = DAggSum (f a)+>     mapData f (DAggProd a) = DAggProd (f a)+>     mapData f (DAggAnd a) = DAggAnd (f a)+>     mapData f (DAggOr a) = DAggOr (f a)+>     mapData f (DAggChoice x a) = DAggChoice (mapData f x) (f a)+>     mapData f (DTupledAgg ags a) = DTupledAgg (mmapData f ags) (f a)++> instance DAdditionalData2 (DConstructor a) a c (DConstructor c) where+>     mapData f (DConstructor c a) = DConstructor c (f a)++> instance DAdditionalData2 (DFun a) a c (DFun c) where+>     mapData f (DFun f' a) = DFun f' (f a)+>     mapData f (DBinOp f' a) = DBinOp f' (f a)++> instance DAdditionalData2 (DVar a) a c (DVar c) where+>     mapData f (DVar v a) = DVar v (f a)++> instance DAdditionalData2 (DField a) a c (DField c) where+>     -- mapData f (DFfst a) = DFfst (f a)+>     -- mapData f (DFsnd a) = DFsnd (f a)+>     mapData f (DField f' a) = DField f' (f a)++> instance DAdditionalData2 (DConst a) a c (DConst c) where+>     mapData f (DCInt c a) = DCInt c (f a)+>     mapData f (DCBool c a) = DCBool c (f a)+>     mapData f (DCString c a) = DCString c (f a)+>     mapData f (DCDouble c a) = DCDouble c (f a)++> instance DAdditionalData2 (DType a) a c (DType c) where+>     mapData f (DTInt a) = DTInt (f a)+>     mapData f (DTBool a) = DTBool (f a)+>     mapData f (DTString a) = DTString (f a)+>     mapData f (DTDouble a) = DTDouble (f a)+>     mapData f (DTTuple ts a) = DTTuple (mmapData f ts) (f a)+>     mapData f (DTRecord c fs a) = DTRecord (mapData f c) (mmapData f fs) (f a)+++generaing all subexpressions of the given one++> subExprs :: DExpr a -> [DExpr a]+> subExprs (x@(DIf p t e _)) = x : (subExprs p ++ subExprs t ++ subExprs e)+> subExprs (x@(DTuple es _)) = x : concatMap subExprs es+> subExprs (x@(DFunAp f es _)) = x : concatMap subExprs es+> subExprs (x@(DConsAp c es _)) = x : concatMap subExprs es+> subExprs (x@(DFieldAcc t fs a)) = map (\fs -> DFieldAcc t fs (case fs of [] -> getData t ; otherwise -> getData (last fs))) (reverse $ inits fs) ++ [DVExp v va]+>                                   where v = getTableVar t+>                                         va = getData v+> subExprs (x@(DFieldAccE e fs a)) = map (\fs -> DFieldAccE e fs (case fs of [] -> getData e ; otherwise -> getData (last fs))) (reverse $ inits fs) +> subExprs (x@(DAggr a e g es _)) = x:subExprs e ++ concatMap subExprs es+> subExprs (x@(DVExp v _)) = [x]+> subExprs (x@(DCExp v _)) = [x]+> getTableVar (DPrev v a) = v+> getTableVar (DCurr v a) = v+> getTableVar (DVal v a) = v+++Expression builders++> dd = "" -- dummy data+> +> expIf p t e = DIf p t e dd+> +> expBin bop e1 e2 = DFunAp (DBinOp bop dd) [e1, e2] dd+> +> expFieldAcc tbl v fs = DFieldAcc te (map (\f -> DField f dd) fs) dd+>   where te | tbl == "prev" = DPrev (DVar v dd) dd+>            | tbl == "curr" = DCurr (DVar v dd) dd+>            | tbl == "val"  = DVal  (DVar v dd) dd+> +> expConstructor c es = DConsAp (DConstructor c dd) es dd+> expConstructor' c es ac a = DConsAp (DConstructor c ac) es a+>+> expFun f es = DFunAp (DFun f dd) es dd+>+> expInt i = DCExp (DCInt i dd) dd+> expBool b = DCExp (DCBool b dd) dd+>+> expVar v = DVExp (DVar v dd) dd+> +> expAggr agg body gen ps = DAggr agg' body gen' ps dd+>   where agg' | agg == "minimum" = DAggMin dd+>              | agg == "maximum" = DAggMax dd+>              | agg == "sum"     = DAggSum dd+>              | agg == "prod"    = DAggProd dd+>              | agg == "and"     = DAggAnd dd+>              | agg == "or"      = DAggOr dd+>         gen' | gen == "g"       = DGenG dd+>              | gen == "tg"      = DGenTermG dd+>              | gen == "is"      = DGenI dd+>              | gen == "rs"      = DGenO dd+> +> expCheckTerm v = DCheckTerm (expVar v) dd+>+> defVar v defs e = DDefVar (DVar v dd) defs e dd+>+> defFun f vs defs e = DDefFun (DFun f dd) (map (\v -> DVar v dd) vs) defs e dd+>+> defVertComp f defs e = DDefVertComp (DFun f dd) defs e dd+>+> (^==) = expBin "=="+> (^&&) = expBin "&&"+> (^>) = expBin ">"++
+ compiler/Spec0.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-}++-- No distinguish between graph-vars/exps and simple-vars/exps++module Spec0 where+import Spec++data DProgramSpec0 a = DProgramSpec0 [DRecordSpec a] (DSmplDef0 a) a deriving (Show, Eq)++data DSmplDef0 a = DDefFun0 (DVar a) [DVar a] [DSmplDef0 a] (DExpr0 a) a+                 | DDefVar0 (DVar a) [DSmplDef0 a] (DExpr0 a) a+                 | DDefTuple0 [DVar a] [DSmplDef0 a] (DExpr0 a) a+                 | DDefVertComp0 (DVar a) [DSmplDef0 a] (DExpr0 a) a+                   deriving (Show, Eq)++data DExpr0 a = DIf0 (DExpr0 a) (DExpr0 a) (DExpr0 a) a+              | DTuple0 [DExpr0 a] a+              | DFunAp0 (DFun a) [DExpr0 a] a+              | DConsAp0 (DConstructor a) [DExpr0 a] a+              | DFieldAcc0 (DTableExpr a) [DField a] a+              | DFieldAccE0 (DEdge a) [DField a] a+              | DAggr0 (DAgg0 a) (DExpr0 a) (DGen a) [DExpr0 a] a+              | DCheckTerm0 (DExpr0 a) a -- Iwasaki: condition for termination+              | DVExp0 (DVar a) a+              | DCExp0 (DConst a) a+              | DPregel0 (DVar a) (DVar a) (DTermination0 a) (DVar a) a -- (DVar a) a+              | DGMap0 (DVar a) (DVar a) a  -- (DVar a) a+              | DGZip0 (DVar a) (DVar a) a --(DVar a) (DVar a) a+              | DGIter0 (DVar a) (DVar a) (DTermination0 a) (DVar a) a -- (DVar a) a+             deriving (Show, Eq)++data DTermination0 a = DTermF0 a+                     | DTermI0 (DExpr0 a) a+                     | DTermU0 (DExpr0 a) a+                     | DTermV2H0 a           -- for internal use+                      deriving (Show, Eq)++data DAgg0 a = DAggMin0 a+             | DAggMax0 a+             | DAggSum0 a+             | DAggProd0 a+             | DAggAnd0 a+             | DAggOr0 a+             | DAggChoice0 (DExpr0 a) a  -- random choice with default value+             | DTupledAgg0 [DAgg0 a] a   -- for internal use+              deriving (Show, Eq)+++instance DAdditionalData (DProgramSpec0 a) a where+    getData (DProgramSpec0 _ _ a) = a+    setData b (DProgramSpec0 rs p _) = DProgramSpec0 rs p b++instance DAdditionalData2 (DProgramSpec0 a) a c (DProgramSpec0 c) where+    mapData f (DProgramSpec0 rs p a) = DProgramSpec0 (mmapData f rs) (mapData f p) (f a)++instance DAdditionalData (DSmplDef0 a) a where+    getData (DDefFun0 _ _ _ _ a) = a+    getData (DDefVar0 _ _ _ a) = a+    getData (DDefTuple0 _ _ _ a) = a+    getData (DDefVertComp0 _ _ _ a) = a+    setData b (DDefFun0 f vs ds e _) = DDefFun0 f vs ds e b+    setData b (DDefVar0 v ds e _) = DDefVar0 v ds e b+    setData b (DDefTuple0 vs ds e _) = DDefTuple0 vs ds e b+    setData b (DDefVertComp0 f ds e _) = DDefVertComp0 f ds e b++instance DAdditionalData2 (DSmplDef0 a) a c (DSmplDef0 c) where+    mapData f (DDefFun0 f' vs ds e a) = DDefFun0 (mapData f f') (mmapData f vs) (mmapData f ds) (mapData f e) (f a)+    mapData f (DDefVar0 v ds e a) = DDefVar0 (mapData f v) (mmapData f ds) (mapData f e) (f a)+    mapData f (DDefTuple0 vs ds e a) = DDefTuple0 (mmapData f vs) (mmapData f ds) (mapData f e) (f a)+    mapData f (DDefVertComp0 f' ds e a) = DDefVertComp0 (mapData f f') (mmapData f ds) (mapData f e) (f a)++instance DAdditionalData (DExpr0 a) a where+    getData (DIf0 _ _ _ a) = a+    getData (DTuple0 _ a) = a+    getData (DFunAp0 _ _ a) = a+    getData (DConsAp0 _ _ a) = a+    getData (DFieldAcc0 _ _ a) = a+    getData (DFieldAccE0 _ _ a) = a+    getData (DAggr0 _ _ _ _ a) = a+    getData (DVExp0 _ a) = a+    getData (DCExp0 _ a) = a+    getData (DPregel0 _ _ _ _ a) = a+    getData (DGMap0 _ _ a) = a+    getData (DGZip0 _ _ a) = a+    getData (DGIter0 _ _ _ _ a) = a+    setData b (DIf0 p t e _) = DIf0 p t e b+    setData b (DTuple0 es _) = DTuple0 es b+    setData b (DFunAp0 f es _) = DFunAp0 f es b+    setData b (DConsAp0 c es _) = DConsAp0 c es b+    setData b (DFieldAcc0 t fs _) = DFieldAcc0 t fs b+    setData b (DFieldAccE0 e fs _) = DFieldAccE0 e fs b+    setData b (DAggr0 a e g es _) = DAggr0 a e g es b+    setData b (DVExp0 v _) = DVExp0 v b+    setData b (DCExp0 v _) = DCExp0 v b+    setData b (DPregel0 f0 ft x g _) = DPregel0 f0 ft x g b+    setData b (DGMap0 f g _) = DGMap0 f g b+    setData b (DGZip0 g1 g2 _) = DGZip0 g1 g2 b+    setData b (DGIter0 f0 ft x g _) = DGIter0 f0 ft x g b++instance DAdditionalData2 (DExpr0 a) a c (DExpr0 c) where+    mapData f (DIf0 p t e a) = DIf0 (mapData f p) (mapData f t) (mapData f e) (f a)+    mapData f (DTuple0 es a) = DTuple0 (mmapData f es) (f a)+    mapData f (DFunAp0 f' es a) = DFunAp0 (mapData f f') (mmapData f es) (f a)+    mapData f (DConsAp0 c es a) = DConsAp0 (mapData f c) (mmapData f es) (f a)+    mapData f (DFieldAcc0 t fs a) = DFieldAcc0 (mapData f t) (mmapData f fs) (f a)+    mapData f (DFieldAccE0 e fs a) = DFieldAccE0 (mapData f e) (mmapData f fs) (f a)+    mapData f (DAggr0 a' e g es a) = DAggr0 (mapData f a') (mapData f e) (mapData f g) (mmapData f es) (f a)+    mapData f (DVExp0 v a) = DVExp0 (mapData f v) (f a)+    mapData f (DCExp0 v a) = DCExp0 (mapData f v) (f a)+    mapData f (DPregel0 f0 ft x g a) = DPregel0 (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)+    mapData f (DGMap0 f' g a) = DGMap0 (mapData f f') (mapData f g) (f a)+    mapData f (DGZip0 g1 g2 a) = DGZip0 (mapData f g1) (mapData f g2) (f a)+    mapData f (DGIter0 f0 ft x g a) = DGIter0 (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)++instance DAdditionalData (DTermination0 a) a where+    getData (DTermF0 a) = a+    getData (DTermI0 _ a) = a+    getData (DTermU0 _ a) = a+    getData (DTermV2H0 a) = a+    setData b (DTermF0 _) = DTermF0 b+    setData b (DTermI0 e _) = DTermI0 e b+    setData b (DTermU0 e _) = DTermU0 e b+    setData b (DTermV2H0 _) = DTermV2H0 b++instance DAdditionalData2 (DTermination0 a) a c (DTermination0 c) where+    mapData f (DTermF0 a) = DTermF0 (f a)+    mapData f (DTermI0 e a) = DTermI0 (mapData f e) (f a)+    mapData f (DTermU0 e a) = DTermU0 (mapData f e) (f a)+    mapData f (DTermV2H0 a) = DTermV2H0 (f a)++instance DAdditionalData (DAgg0 a) a where+    getData (DAggMin0 a) = a+    getData (DAggMax0 a) = a+    getData (DAggSum0 a) = a+    getData (DAggProd0 a) = a+    getData (DAggAnd0 a) = a+    getData (DAggOr0 a) = a+    getData (DAggChoice0 x a) = a+    getData (DTupledAgg0 _ a) = a+    setData b (DAggMin0 _) = DAggMin0 b+    setData b (DAggMax0 _) = DAggMax0 b+    setData b (DAggSum0 _) = DAggSum0 b+    setData b (DAggProd0 _) = DAggProd0 b+    setData b (DAggAnd0 _) = DAggAnd0 b+    setData b (DAggOr0 _) = DAggOr0 b+    setData b (DAggChoice0 x _) = DAggChoice0 x b+    setData b (DTupledAgg0 ags _) = DTupledAgg0 ags b++instance DAdditionalData2 (DAgg0 a) a c (DAgg0 c) where+    mapData f (DAggMin0 a) = DAggMin0 (f a)+    mapData f (DAggMax0 a) = DAggMax0 (f a)+    mapData f (DAggSum0 a) = DAggSum0 (f a)+    mapData f (DAggProd0 a) = DAggProd0 (f a)+    mapData f (DAggAnd0 a) = DAggAnd0 (f a)+    mapData f (DAggOr0 a) = DAggOr0 (f a)+    mapData f (DAggChoice0 x a) = DAggChoice0 (mapData f x) (f a)+    mapData f (DTupledAgg0 ags a) = DTupledAgg0 (mmapData f ags) (f a)++ppSmplDef0 :: DSmplDef0 a -> [String]+ppSmplDef0 (DDefFun0 f vs ds e _) =+  if length ds == 0+  then header ++ indent (ppExpr0 e)+  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))+  where header = [ ppVar f ++ " " ++ ppList " " (map ppVar vs) ++ " = " ]+ppSmplDef0 (DDefVar0 v ds e _) = +  if length ds == 0+  then header ++ indent (ppExpr0 e)+  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))+  where header = [ ppVar v ++ " = "]+ppSmplDef0 (DDefTuple0 vs ds e _) = +  if length ds == 0+  then header ++ indent (ppExpr0 e)+  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))+  where header = ["(" ++ ppList ", " (map ppVar vs) ++ ") = "]+ppSmplDef0 (DDefVertComp0 f ds e _) =+  if length ds == 0 then indentWith (ppVar f ++ " v prev curr = ") (ppExpr0 e)+  else [ppVar f ++" v prev curr = "] ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))++ppExpr0 :: DExpr0 a-> [String]+ppExpr0 (DIf0 c t e _) = indentWith "if " (ppExpr0 c) +++                         indentWith "then " (ppExpr0 t) +++                         indentWith "else " (ppExpr0 e)+ppExpr0 (DTuple0 es _) = indentWith "(" (concat $ insList "," ")" $ map ppExpr0 es)+ppExpr0 (DFunAp0 (DBinOp o _) (e1:e2:[]) _) = [flatE0 e1 ++ " " ++ o ++ " " ++ flatE0 e2]+ppExpr0 (DFunAp0 f es _) = [ppList " " (ppFun f: map flatE0 es)]+ppExpr0 (DConsAp0 c es _) = [ppList " " (ppConstructor c: map flatE0 es)]+ppExpr0 (DFieldAcc0 e fs _) = [ ppTableExpr e ++ (concat $ map ((".^"++).ppField) fs) ]+ppExpr0 (DFieldAccE0 e fs _) = [ ppEdge e ++ (concat $ map ((".^"++).ppField) fs) ]+ppExpr0 (DAggr0 a e g es _) =+  [ppAgg0 a ++ " [ " ++ flatE20 e ++  " | " ++ ppGen g ++ ps ++ " ] "]+  where ps = if length es == 0 then ""+             else "," ++ ppList "," (map flatE0 es)+ppExpr0 (DVExp0 v _) = [ppVar v]+ppExpr0 (DCExp0 c _) = [ppConst c]+ppExpr0 (DPregel0 f0 ft t g _) =+  [ppList " " (["fregel", ppVar f0, ppVar ft, ppTermination0 t] ++ [ppVar g])]+ppExpr0 (DGMap0 f g _) =+  [ppList " " (["gmap", ppVar f] ++ [ppVar g])]+ppExpr0 (DGZip0 g1 g2 _) =+  [ppList " " (["gzip"] ++ [ppVar g1] ++ [ppVar g2])]+ppExpr0 (DGIter0 f0 ft t g _) =+  [ppList " " (["giter", ppVar f0, ppVar ft, ppTermination0 t] ++ [ppVar g])]++ppTermination0 :: DTermination0 a -> String+ppTermination0 (DTermF0 _)= "Fix"+ppTermination0 (DTermI0 e _) = "(Iter (" ++ ppList " " (ppExpr0 e) ++ "))"+ppTermination0 (DTermU0 e _) = "(Until (\\g->" ++ ppList " " (ppExpr0 e) ++ "))"+ppTermination0 (DTermV2H0 _) = "V2H"++ppAgg0 (DAggMin0 _)  = "minimum"+ppAgg0 (DAggMax0 _)  = "maximum"+ppAgg0 (DAggSum0 _)  = "sum"+ppAgg0 (DAggProd0 _) = "prod"+ppAgg0 (DAggAnd0 _)  = "and"+ppAgg0 (DAggOr0 _)   = "or"+ppAgg0 (DAggChoice0 x _) = "random " ++ flatE0 x++flatE0 :: DExpr0 a -> String+flatE0 = enclose . ppList " " . ppExpr0++flatE20 :: DExpr0 a -> String+flatE20 = ppList " " . ppExpr0++ppAST0 :: DProgramSpec0 a -> String+ppAST0 = unlines . ppProgramSpec0++ppProgramSpec0 :: DProgramSpec0 a -> [String]+ppProgramSpec0 (DProgramSpec0 rs p _) =+  (concatMap ppRecordSpec rs) ++ ppSmplDef0 p++
+ compiler/TypeChecker.hs view
@@ -0,0 +1,894 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++Type-checking based on unification (2nd step)++Limitation: ++  - No type constraints (i.e., typeclasses)+    So,  (+) :: Num a => a -> a -> a is actually handled as (+) :: a -> a -> a .+++Hmm... type of prev/curr is (forall b r . (forall a. Vertex a b -> r)), +and this needs higher rank types. The current implementation handles these+ two specially in a dirty way.+++-}++module TypeChecker where++import Spec+import Analysis (dependency')+import ASTData++import Control.Monad.State+import Control.Monad+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++-------------------- unification ------------------------++{-++http://www.cs.cornell.edu/courses/cs3110/2011sp/lectures/lec26-type-inference/type-inference.htm++-}++{- invariant for substitutions: -}+{- no id on a lhs occurs in any term earlier in the list -}+type Substitution = [(Id, DTypeTerm)]++{- check if a variable occurs in a term -}+occurs :: Id -> DTypeTerm -> Bool+occurs x (DTypeVar y) = x == y+occurs x (DTypeTerm _ s) = any (occurs x) s++{- substitute term s for all occurrences of variable x in term t -}+subst :: (Id, DTypeTerm) -> DTypeTerm -> DTypeTerm+subst (x, s) (t@(DTypeVar y)) = if x == y then s else t+subst (x, s) (DTypeTerm f u) = DTypeTerm f (map (subst (x, s)) u)++{- apply a substitution right to left -}+apply :: Substitution -> DTypeTerm -> DTypeTerm+apply s t = foldr subst t s++{- unify one pair -}+unify_one :: DTypeTerm -> DTypeTerm -> Either String Substitution+unify_one s t =+  case (s, t) of+    (DTypeVar x, DTypeVar y) -> return (if x == y then [] else if x < y then [(y, s)] else [(x, t)]) -- this comparison of x and y is to ansure that a new (bigger) variable is replaced with an old (smaller) one+    (DTypeTerm f sc, DTypeTerm g tc) ->+      if f == g && length sc == length tc+      then do res <- unify' (zip sc tc); return res+      else Left ("not unifiable: head symbol conflict; " ++ show s ++" != " ++ show t )+    (DTypeVar x, (DTypeTerm _ _)) ->+      if occurs x t+      then Left ("not unifiable: circularity; " ++ show s ++ " in " ++ show t)+      else return [(x, t)]+    ((DTypeTerm _ _), DTypeVar x) ->+      if occurs x s+      then Left ("not unifiable: circularity; " ++ show t ++ " in " ++ show s)+      else return [(x, s)]++{- unify a list of pairs -}+unify' :: [(DTypeTerm, DTypeTerm)] -> Either String Substitution+unify' [] = return []+unify' ((x, y) : t) = +    do t2 <- unify' t+       t1 <- unify_one (apply t2 x) (apply t2 y)+       return (t1 ++ t2)++unify :: [(DTypeTerm, DTypeTerm)] -> Substitution+unify xs = case unify' xs of+             Right s -> s+             Left str -> error (str ++ "\nConstraints: \n" ++ (unlines $ map (\(a,b) -> prettyShow a++" == " ++ prettyShow b) xs))++unify'' :: [(DTypeTerm, DTypeTerm)] -> Either String Substitution+unify'' xs = case unify' xs of+               Right s -> Right s+               Left str -> Left (str ++ "\nConstraints: \n" ++ (unlines $ map (\(a,b) -> prettyShow a++" == " ++ prettyShow b) xs))+                           +-------------------------- type checker --------------------++type TypeConstraint = (DTypeTerm, DTypeTerm)+type VarTypeBind' = (DVarName, (DTypeInfo, Bool))+type DEnvTC = (([VarTypeBind'], [Int], [String]), [TypeConstraint], DUnique)++class TypeCheckable a b | a -> b where+    typeCheck :: a -> State DEnvTC b -- produces a new type name, assumulates type constraints, ...++setRefreshable :: VarTypeBind -> VarTypeBind'+setRefreshable (v, t) = (v, (t, True))++setUnRefreshable :: VarTypeBind -> VarTypeBind'+setUnRefreshable (v, t) = (v, (t, False))++isRefreshable :: VarTypeBind' -> Bool+isRefreshable (v, (t, b)) = b++-- access functions to the environment++addConstraint :: TypeConstraint -> State DEnvTC ()+addConstraint c = +  do (env, cs, i) <- get +     put (env, (c:cs), i)++getConstraints' :: DEnvTC -> [TypeConstraint]+getConstraints' (env, cs, i) = cs++getConstraints :: State DEnvTC [TypeConstraint]+getConstraints =+    do (env, cs, i) <- get+       put (env, [], i)+       return cs++peepConstraints :: State DEnvTC [TypeConstraint]+peepConstraints =+    do (env, cs, i) <- get+       return cs++getNewTypeName :: DVarName -> State DEnvTC DTypeInfo+getNewTypeName os = +    do (env, cs, i) <- get +       let n = "t"++((showHex i ""))+       put (env, cs, i+1)+       return (DTypeVar n)+       +getVarTypeBinds :: State DEnvTC [VarTypeBind']+getVarTypeBinds = +    do ((bds, ks, rs), cs, i) <- get +       return bds++updateVarTypeBinds :: Substitution -> State DEnvTC ()+updateVarTypeBinds s = +    do ((bds,ks,rs), cs, i) <- get +       let bds' = map (\(x@(n,(t,b))) -> if not b then (n, (apply s t, b)) else x) bds+           rs' = rigidTypeVars bds'+       put ((bds',ks,rs'), cs, i)++addTypeBinds :: [VarTypeBind] -> State DEnvTC ()+addTypeBinds bd =+    do ((bds, ks, rs), cs, i) <- get+       let bds' = map setUnRefreshable bd++bds+           rs' = rigidTypeVars bds'+       put ((bds', length bd:ks, rs'), cs, i)++addTypeBindsRefreshable :: [VarTypeBind] -> State DEnvTC ()+addTypeBindsRefreshable bd =+    do ((bds, ks, rs), cs, i) <- get+       put (((map setRefreshable bd)++bds, length bd:ks, rs), cs, i)++popVarTypeBinds :: State DEnvTC [VarTypeBind]+popVarTypeBinds =+    do x <- get+       let ((bds, k:ks, rs), cs, i) = x+           bds' = drop k bds+           rs' = rigidTypeVars bds'+       put ((bds', ks, rs'), cs, i)+       return (map (\(n, (t, b)) -> (n, t)) (take k bds))++getRigidTypeVars :: State DEnvTC [String]+getRigidTypeVars =+    do ((_, _, rs), _, _) <- get+       return rs++rigidTypeVars :: [VarTypeBind'] -> [String]+rigidTypeVars = nub . sort . concatMap (\(n,(t,b)) -> if not b then collectTypeVars t else [])+++lookupTypes :: [String] -> State DEnvTC [DTypeInfo]+lookupTypes ns =+    do bds <- getVarTypeBinds +       return (map (\n -> maybe (error ("not found: "++n)) (\(t, b) -> t) $ lookup n bds) ns)++-- adds variables with their fresh type names, returns the type names+addNames :: [DVarName] -> State DEnvTC ([DTypeInfo])+addNames ns = +    do nts <- mapM getNewTypeName ns+       let binds' = zip ns nts+       addTypeBinds binds'+       return nts++addNames' :: [DVarName] -> [DTypeInfo] -> State DEnvTC ()+addNames' ns nts = +    do let binds' = zip ns nts+       addTypeBinds binds'++--++initEnv' = (map setRefreshable initEnv, [], []{- everything is refreshable -})++typing0 :: (TypeCheckable a1 a, Show a) => a1 -> (a, DEnvTC)+typing0 p = runState (typeCheck p) (initEnv', [], 0)++typing'' p = let (p', env) = typing0 p +           in (p', unify (getConstraints' env))++typing' p = let (p', env) = typing0 p +          in (p', (getConstraints' env))++typing :: Show a => DProgramSpec a -> DProgramSpec (DTypeInfo, a)+typing p = let (p', env) = typing0 p in p'+++doTyping' :: forall (t :: * -> *) b x. +            (DAdditionalData2 (t (DTypeInfo, b)) (DTypeInfo, b) (DTypeInfo, b) (t (DTypeInfo, b)), +             DAdditionalData (t (DTypeInfo, b)) (DTypeInfo, b),+             Show x, PrettyShow x+            ) +            => [DTypeInfo] -> [t (DTypeInfo, b)] -> x -> State DEnvTC (([DTypeInfo], [t (DTypeInfo, b)] ), Substitution)+doTyping' ts es x = +    do cs <- getConstraints+       let s = unify'' cs+       case s of +         Right s -> do let ts' = map (apply s) ts+                           es' = map (mapData (\(t, a::b) -> (apply s t, a))) es+                       updateVarTypeBinds s+                       return ((ts', es'), s)+         Left str -> do bds <- getVarTypeBinds +                        error (str ++ "\nin typing " ++ show x ++ "\n\nTerm: "++prettyShow x ++ "\nBindings: \n" ++ (unlines $ map (\(a,(t,b)) -> a ++ " :: " ++ prettyShow t ++ " , ("++show b++")") bds))+++-- utility for getting type name +getType' :: forall (t :: * -> *) b . (DAdditionalData (t (DTypeInfo, b)) (DTypeInfo, b)) => (t (DTypeTerm, b)) -> DTypeTerm+getType' = fst . getData++setType :: forall (t :: * -> *) b . (DAdditionalData (t (DTypeInfo, b)) (DTypeInfo, b)) => DTypeTerm -> (t (DTypeTerm, b)) -> (t (DTypeTerm, b))+setType t p = setData (t, snd $ getData p) p++instance Show a => TypeCheckable (DProgramSpec a) (DProgramSpec (DTypeInfo, a)) where+    typeCheck (DProgramSpec rs p a) = +        do rs' <- {- trace (show rs) -} (mapM typeCheck rs)  -- no mutual dependency among records.+           p' <- typeCheck p+           return (DProgramSpec rs' p' (getType' p', a))++instance Show a => TypeCheckable (DRecordSpec a) (DRecordSpec (DTypeInfo, a)) where+    typeCheck (DRecordSpec c fts a) =+        do dst <- mapM typeCheck (map snd fts)+           let nc = head $ getNames c+               tc = typeSolid nc+               fts' = zipWith (\t f -> (mapData (\a -> (getType' t, a)) f, t)) dst (map fst fts)+               c' = mapData (\a -> (tc, a)) c+           -- add the constructor and fields to the env.+           addTypeBindsRefreshable ((nc, typeFunction (map (getType'.fst) fts'++[tc])):map (\ft -> (head $ getNames $ fst ft, typeFunction [tc, getType' $ fst ft])) fts')+           return (DRecordSpec c' fts' (tc, a))++{- this is for type annotations (in record definitions) -}+instance Show a => TypeCheckable (DType a) (DType (DTypeTerm, a)) where+    typeCheck (DTInt a) = return (DTInt (typeDTInt, a))+    typeCheck (DTBool a) = return (DTBool (typeDTBool, a))+    typeCheck (DTString a) = return (DTString (typeDTString, a))+    typeCheck (DTDouble a) = return (DTDouble (typeDTDouble, a))+    typeCheck (DTTuple ts a) = +        do ts' <- mapM typeCheck ts+           let ds = map getType' ts'+           return (DTTuple ts' (typeTuple ds, a))+    typeCheck (DTRecord c ts a) = +        do c' <- typeCheck c+           ts' <- mapM typeCheck ts+           let ds = map getType' ts'+           return (DTRecord c' ts' (typeRecord (getName c') ds, a))++typingTypeExpression x = rec x+  where+    rec (DTInt a) = (typeDTInt)+    rec (DTBool a) = (typeDTBool)+    rec (DTString a) = (typeDTString)+    rec (DTDouble a) = (typeDTDouble)+    rec (DTTuple ts a) = +        let ds = map rec ts+        in (typeTuple ds)+    rec (DTRecord c ts a) = +        let ts' = map rec ts+        in typeRecord (getName c) ts'+++instance Show a => TypeCheckable (DConst a) (DConst (DTypeTerm, a)) where+    typeCheck (DCInt c a) = return (DCInt c (typeDTInt, a))+    typeCheck (DCBool c a) = return (DCBool c (typeDTBool, a))+    typeCheck (DCString c a) = return (DCString c (typeDTString, a))+    typeCheck (DCDouble c a) = return (DCDouble c (typeDTDouble, a))++getNamesWithType' (DGDefVC d a) = [(head $ getNames d, getType' d)]+getNamesWithType' (DGDefVI d a) = [(head $ getNames d, getType' d)]+getNamesWithType' (DGDefSmpl d a) = getNamesWithType d+getNamesWithType' (DGDefGV d a) = [(head $ getNames d, getType' d)]+getNamesWithType' (DGDefGF d a) = [(head $ getNames d, getType' d)]++getNamesWithType'' (DDefGraphVar v e (t,a)) = [(head $ getNames v, t)]++instance Show a => TypeCheckable (DProg a) (DProg (DTypeInfo, a)) where+    typeCheck (x@(DProg f defs e a)) = +        do tv <- getNewTypeName "" -- vertex type of g+           te <- getNewTypeName "" -- edge type of g+           let tg = typeGraph [tv, te]+           addTypeBinds [("g", tg)] -- the input graph+           -- now, typing the let bindings+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType' def'); return def') defs+           -- and the body+           e' <- typeCheck e+           tf <- getNewTypeName ""+           xx <- lookupTypes ["g"]+           let [tg'] = xx+           addConstraint (tf, typeFunction ([tg', getType' e']))+           xx <- doTyping' [tf] [e'] x+           let (([tf'], [e'']), s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           popVarTypeBinds  -- of g           +           let f' = mapData (\a -> (tf', a)) f+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DProg f' defs'' e'' (tf', a))++instance Show a => TypeCheckable (DGroundDef a) (DGroundDef (DTypeInfo, a)) where+    typeCheck (DGDefVC d a) = do d' <- typeCheck d+                                 return (DGDefVC d' (getType' d', a))+    typeCheck (DGDefVI d a) = do d' <- typeCheck d+                                 return (DGDefVI d' (getType' d', a))+    typeCheck (DGDefSmpl d a) = do d' <- typeCheck d+                                   return (DGDefSmpl d' (getType' d', a))+    typeCheck (DGDefGV d a) = do d' <- typeCheck d+                                 return (DGDefGV d' (getType' d', a))+    typeCheck (DGDefGF d a) = do d' <- typeCheck d+                                 return (DGDefGF d' (getType' d', a))++instance Show a => TypeCheckable (DDefVertComp a) (DDefVertComp (DTypeInfo, a)) where+    typeCheck (x@(DDefVertComp f defs e a)) = +        do tvv <- getNewTypeName "" -- vertex type of v+           tve <- getNewTypeName "" -- edge type of v+           tuv <- getNewTypeName "" -- vertex type of prev/curr+           tres <- getNewTypeName "" -- resulting type of the function+           let ttbl = typeFunction [typeVertex [tuv, tve], tres]+               tv = typeVertex [tvv, tve]+           addTypeBinds [("v", tv)]+           addResultType tres+           addTypeBindsRefreshable [("prev", ttbl), ("curr", ttbl)]+           -- now, typing the let bindings and the body+           -- assumption: no mutual dependency, topological sorted+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType def'); return def') defs+           e' <- typeCheck e+           cs' <- peepConstraints+           tf <- getNewTypeName ""+           tres' <- getResultType+           addConstraint (tres', getType' e')+           xx <- lookupTypes ["v", "prev"]  -- types of v etc have been updated possibly+           let [tv', ttbl'] = xx+           addConstraint (tf, typeFunction ([tv', ttbl', ttbl', getType' e']))+           cs <- peepConstraints+           xx <- doTyping' [tf] [e'] x+           let (([tf'], [e'']), s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           bds <- getVarTypeBinds+           popVarTypeBinds  -- of prev and curr+           popVarTypeBinds  -- of the result type+           popVarTypeBinds  -- of v           +           let f' = mapData (\a -> (tf', a)) f+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           --trace ("e''="++show e'' ++ "\ne'="++show e' ++ "\nbds ="++show bds ++ "\ncs ="++show cs ++ "\ntres' ="++show tres' ++ "\ntf' ="++show tf' ++ "\ntf ="++show tf ++ "\nttbl' ="++show ttbl') $ +           --trace ("\ntv'="++show tv'++ "\ntf' ="++show tf' ++ "\ntf ="++show tf ++ "\ncs ="++show cs++ "\ncs' ="++show cs'++ "\ne' ="++show e' ) $ +           return (DDefVertComp f' defs'' e'' (tf', a))++instance Show a => TypeCheckable (DDefVertInit a) (DDefVertInit (DTypeInfo, a)) where+    typeCheck (x@(DDefVertInit f defs e a)) = +        do tvv <- getNewTypeName "" -- vertex type of v+           tve <- getNewTypeName "" -- edge type of v+           let tv = typeVertex [tvv, tve]+           addTypeBinds [("v", tv)]+           -- now, typing the let bindings and the body+           -- assumption: no mutual dependency, topological sorted+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType def'); return def') defs+           e' <- typeCheck e+           tf <- getNewTypeName ""+           xx <- lookupTypes ["v"]  -- types of v etc have been updated possibly+           let [tv'] = xx+           addConstraint (tf, typeFunction ([tv', getType' e']))+           xx <- doTyping' [tf] [e'] x+           let (([tf'], [e'']), s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           popVarTypeBinds  -- of v+           let f' = mapData (\a -> (tf', a)) f+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DDefVertInit f' defs'' e'' (tf', a))++instance Show a => TypeCheckable (DDefGraphFun a) (DDefGraphFun (DTypeInfo, a)) where+    typeCheck (x@(DDefGraphFun f v defs e a)) = +        do tv <- getNewTypeName "" -- vertex type of g+           te <- getNewTypeName "" -- edge type of g+           let tg = typeGraph [tv, te]+               nv = head $ getNames v+           addTypeBinds [(nv, tg)] -- the input graph+           -- now, typing the let bindings+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType'' def'); return def') defs+           -- and the body+           e' <- typeCheck e+           tf <- getNewTypeName ""+           xx <- lookupTypes [nv]  -- types of v etc have been updated possibly+           let [tg'] = xx+           addConstraint (tf, typeFunction ([tg', getType' e']))+           xx <- doTyping' [tf, tg'] [e'] x+           let (([tf', tg''], [e'']), s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           popVarTypeBinds  -- of v           +           let f' = mapData (\a -> (tf', a)) f+               v' = mapData (\a -> (tg'', a)) v+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DDefGraphFun f' v' defs'' e'' (tf', a))++instance Show a => TypeCheckable (DDefGraphVar a) (DDefGraphVar (DTypeInfo, a)) where+    typeCheck (x@(DDefGraphVar v e a)) = +        do tv <- getNewTypeName "" -- vertex type of g+           te <- getNewTypeName "" -- edge type of g+           let tg = typeGraph [tv, te]+               nv = head $ getNames v+           e' <- typeCheck e+           addConstraint(tg, getType' e')+           xx <- doTyping' [tg] [e'] x+           let (([tg''], [e'']), s) = xx+               v' = mapData (\a -> (tg'', a)) v+           return (DDefGraphVar v' e'' (tg'', a))++getNamesWithType (DDefFun f vs defs e (tf, a)) = [(head $ getNames f, tf)]+getNamesWithType (DDefVar v defs e (tv, a)) = [(head $ getNames v, tv)]+getNamesWithType (DDefTuple vs defs e (tt, a)) = zip (map (head . getNames) vs) (getTupleTypes tt)++assume_just (Just a) = a+instance Show a => TypeCheckable (DSmplDef a) (DSmplDef (DTypeInfo, a)) where+    typeCheck (x@(DDefFun f vs defs e a)) = +        do let vns = concatMap getNames vs+           nts <- mapM getNewTypeName vns +           addNames' vns nts -- add the argument variables first, and get thier type names+           -- assumption: no mutual dependency, topological sorted+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType def'); return def') defs+           e' <- typeCheck e+           tf <- getNewTypeName ""+           nts' <- mapM checkDefined vns+           addConstraint (tf, typeFunction (nts'++[getType' e']))+           xx <- doTyping' (tf:nts') [e'] x+           let ((tf':nts'', [e'']),s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           bds <- popVarTypeBinds+           let f' = mapData (\a -> (tf', a)) f+               vs' = map (\v -> mapData (\a -> (assume_just (lookup (getName v) (zip vns nts'')), a)) v) vs --map (\(v, vt) -> mapData (\a -> (vt, a)) v) (zip vs (map snd bds))+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DDefFun f' vs' defs'' e'' (tf', a))+    typeCheck (x@(DDefVar v defs e a)) = +        do -- assumption: no mutual dependency, topological sorted+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType def'); return def') defs+           e' <- typeCheck e+           tv <- getNewTypeName ""+           addConstraint (tv, getType' e')+           xx <- doTyping' [tv] [e'] x+           let (([tv'], [e'']),s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           let v' = mapData (\a -> (tv', a)) v+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DDefVar v' defs'' e'' (tv', a))+    typeCheck (x@(DDefTuple vs defs e a)) = -- buggy: type info. is not propagated to the tupled variables +        do let vns = concatMap getNames vs+           nts <- mapM getNewTypeName vns +           addNames' vns nts -- add the argument variables first, and get thier type names+           -- assumption: no mutual dependency, topological sorted+           defs' <- mapM (\def -> do def' <- typeCheck def; addTypeBindsRefreshable (getNamesWithType def'); return def') defs+           e' <- typeCheck e+           nts' <- mapM checkDefined vns+           tt <- getNewTypeName ""+           addConstraint (typeTuple nts', getType' e')+           xx <- doTyping' nts' [e'] x+           let ((nts'', [e'']),s) = xx+           mapM (\x -> do popVarTypeBinds) defs+           bds <- popVarTypeBinds+           let vs' = map (\v -> mapData (\a -> (assume_just (lookup (getName v) (zip vns nts'')), a)) v) vs --map (\(v, vt) -> mapData (\a -> (vt, a)) v) (zip vs (map snd bds))+               defs'' = map (mapData (\(t, a::a) -> (apply s t, a))) defs'+           return (DDefTuple vs' defs'' e'' (typeTuple nts'', a))++-- the type associated is the type of the target graph.+instance Show a => TypeCheckable (DTermination a) (DTermination (DTypeInfo, a)) where+    typeCheck (x@(DTermF a)) = +        do te <- getNewTypeName ""+           tv <- getNewTypeName ""+           return (DTermF ((typeGraph [tv, te]), a)) +    typeCheck (x@(DTermI e a)) = +        do e' <- typeCheck e+           addConstraint (getType' e', typeDTInt)+           xx <- doTyping' [] [e'] x+           let (([], [e'']), s) = xx+           te <- getNewTypeName ""+           tv <- getNewTypeName ""+           return (DTermI e'' (typeGraph [tv, te], a)) +    typeCheck (x@(DTermU e a)) = +        do te <- getNewTypeName ""+           tv <- getNewTypeName ""+           -- this type must be the same as the graph in the context (the result of giter or fregel)+           -- this check will be done in the checking of giter or fregel+           --- Hmm... no typechecking of g in the generator expression now (to remedy another problem)+           --- agg [ exp | u <- gof v ]  looks good for vertex functions, but not goot for Until.+           let tg = typeGraph [tv, te]+           addTypeBinds [("g", tg)]+           addResultType tv+           e' <- typeCheck e+           addConstraint (getType' e', typeDTBool)+           xx <- doTyping' [] [e'] x+           let ((_, [e'']),s) = xx+           popVarTypeBinds -- result+           popVarTypeBinds -- g+           let tg' = {- trace (show s) $ -} apply s tg+           return ({- trace (show tg') -} (DTermU e'' (tg', a))) ++instance Show a => TypeCheckable (DGraphExpr a) (DGraphExpr (DTypeInfo, a)) where+    typeCheck (DPregel f0 ft x g a) = +        do f0' <- typeCheck f0+           ft' <- typeCheck ft+           x' <- typeCheck x+           g' <- typeCheck g+           tself <- getNewTypeName ""+           te <- getNewTypeName ""  -- type of edges+           tgv <- getNewTypeName "" -- type of vertices of the input+           txv <- getNewTypeName "" -- type of vertices of something+           trv <- getNewTypeName "" -- type of vertices of the result+           addConstraint (getType' g', typeGraph [tgv, te]) -- g is a graph+           addConstraint (getType' f0', typeFunction [typeVertex [tgv, te], trv]) -- initialization function+           let ttbl = typeFunction [typeVertex [txv, te], trv] -- type of tables+           addConstraint (getType' ft', typeFunction [typeVertex [tgv, te], ttbl, ttbl, trv]) -- vertex compute+           addConstraint (tself, getType' x') -- the termination condition is on the result graph+           addConstraint (tself, typeGraph [trv, te]) -- the result is a graph+           return (DPregel f0' ft' x' g' (tself, a))+    typeCheck (DGMap f g a) = +        do f' <- typeCheck f+           g' <- typeCheck g+           tself <- getNewTypeName ""+           te <- getNewTypeName ""  -- type of edges+           tgv <- getNewTypeName "" -- type of vertices of the input+           trv <- getNewTypeName "" -- type of vertices of the result+           addConstraint (getType' g', typeGraph[tgv, te]) -- g is a graph+           addConstraint (tself, typeGraph[trv, te]) -- the result is a graph+           addConstraint (getType' f', typeFunction [typeVertex [tgv, te], trv]) --the function type+           return (DGMap f' g' (tself, a))+    typeCheck (DGZip g1 g2 a) = +        do g1' <- typeCheck g1+           g2' <- typeCheck g2+           tself <- getNewTypeName ""+           te <- getNewTypeName ""  -- type of edges+           tv1 <- getNewTypeName "" -- type of vertices of g1+           tv2 <- getNewTypeName "" -- type of vertices of g2+           addConstraint (getType' g1', typeGraph[tv1, te]) -- g1 is a graph+           addConstraint (getType' g2', typeGraph[tv2, te]) -- g2 is a graph+           addConstraint (tself, typeGraph[typePair[tv1,tv2], te]) -- the result is a graph of pairs+           return (DGZip g1' g2' (tself, a))+    typeCheck (DGIter f0 ft x g a) = +        do f0' <- typeCheck f0+           ft' <- typeCheck ft+           x' <- typeCheck x+           g' <- typeCheck g+           tself <- getNewTypeName ""+           te <- getNewTypeName ""  -- type of edges+           tgv <- getNewTypeName "" -- type of vertices of the input+           trv <- getNewTypeName "" -- type of vertices of the result+           addConstraint (getType' g', typeGraph [tgv, te]) -- g is a graph+           addConstraint (getType' f0', typeFunction [typeVertex [tgv, te], trv]) -- initialization function+           addConstraint (getType' ft', typeFunction [typeGraph [trv, te], typeGraph [trv, te]]) -- graph function+           addConstraint (tself, getType' x') -- the termination condition is on the result graph+           addConstraint (tself, typeGraph [trv, te]) -- the result is a graph+           return (DGIter f0' ft' x' g' (tself, a))+    typeCheck (DGVar v a) = +        do v' <- typeCheck v+           return (DGVar v' (getType' v', a))++++typeCheckApplication+    :: forall (t :: * -> *) (u :: * -> *) b . +      (DAdditionalData (t (DTypeInfo, b)) (DTypeInfo, b),+      DAdditionalData (u (DTypeInfo, b)) (DTypeInfo, b),+      TypeCheckable (t b) (t (DTypeInfo, b)),+      TypeCheckable (u b) (u (DTypeInfo, b))) =>+     t b+     -> [u b]+     -> State DEnvTC+          ((t (DTypeInfo, b)), [u (DTypeInfo, b)], DTypeInfo)+          +typeCheckApplication f es = +  do f' <- typeCheck f+     es' <- mapM typeCheck es+     let tf = getType' f'+         tes = map getType' es'+     tself <- getNewTypeName ""  -- type of this expression+     addConstraint (tf, typeFunction (tes++[tself]))+     return (f', es', tself)+     +instance Show a => TypeCheckable (DExpr a) (DExpr (DTypeInfo, a)) where+    typeCheck (DIf p t e a) = +        do p' <- typeCheck p+           t' <- typeCheck t+           e' <- typeCheck e+           let tp = getType' p'+               tt = getType' t'+               te = getType' e'+           tself <- getNewTypeName ""  -- type of this expression+           addConstraint (tp, typeDTBool) -- predicate must be of Bool+           addConstraint (tt, te) -- then- and else-clauses must be the same+           addConstraint (tself, tt) -- the type of this expression is also the same+           return (DIf p' t' e' (tself, a))+    typeCheck (DTuple es a) =+        do es' <- mapM typeCheck es +           tself <- getNewTypeName ""  -- type of this expression+           addConstraint (tself, typeTuple (map getType' es'))+           return (DTuple es' (tself, a))+    typeCheck (DFunAp f es a) =+        do (f', es', tself) <- typeCheckApplication f es+           return (DFunAp f' es' (tself, a))+    typeCheck (DConsAp c es a) =+        do (c', es', tself) <- typeCheckApplication c es+           return (DConsAp c' es' (tself, a))+    typeCheck (DFieldAcc t fs a) =+        do t' <- typeCheck t+           fs' <- mapM typeCheck fs+           let tt = getType' t'+               tfs = map getType' fs'+           -- chain of filed accesses (function applications)+           (tself, nts) <- foldM (\(t, nts) tf -> do nt <- getNewTypeName ""; addConstraint (tf, typeFunction [t, nt]); return (nt, nt:nts)) (tt, []) (tfs) +           -- a type associated to a field is the type of the subexpression until the field+           let fs'' = zipWith (\f nt -> let (_, a) = getData f in setData (nt, a) f) fs' (nts)+           return (DFieldAcc t' fs'' (tself, a))+    typeCheck (DFieldAccE e fs a) =+        do e' <- typeCheck e+           fs' <- mapM typeCheck fs+           let te = getType' e'+               tfs = map getType' fs'+           -- chain of filed accesses (function applications)+           (tself, nts) <- foldM (\(t, nts) tf -> do nt <- getNewTypeName ""; addConstraint (tf, typeFunction [t, nt]); return (nt, nt:nts)) (te, []) (tfs) +           -- a type associated to a field is the type of the subexpression until the field+           let fs'' = zipWith (\f nt -> let (_, a) = getData f in setData (nt, a) f) fs' (nts)+           return (DFieldAccE e' fs'' (tself, a))+    typeCheck (DAggr a' e g es a) =+        do g' <- typeCheck g  -- this adds new entries to the type env.+           e' <- typeCheck e+           a'' <- typeCheck a'+           es' <- mapM typeCheck es+           tself <- getNewTypeName ""+           mapM (\x -> addConstraint (typeDTBool, getType' x)) es' -- a predicate must be a bool exp.+           addConstraint (getType' a'', getType' e') -- the body and the aggregator are of the same type+           addConstraint (getType' a'', tself)+           popVarTypeBinds -- remove the entries+           return (DAggr a'' e' g' es' (tself, a)) +    typeCheck (DVExp v a) =+        do v' <- typeCheck v+           return (DVExp v' (getType' v', a))+    typeCheck (DCExp c a) = +        do c' <- typeCheck c +           return (DCExp c' (getType' c', a))++-- the type associated is the type of u+instance Show a => TypeCheckable (DGen a) (DGen (DTypeInfo, a)) where+    typeCheck (DGenI a) = +        do tv <- checkDefined "v"+           xx <- addNames ["u", "e"]+           let [tu, te] = xx+           tuv <- getNewTypeName ""+           tvv <- getNewTypeName ""+           addConstraint (tu, tv) -- u and v has the same type+           addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           addConstraint (tv, typeVertex [tvv, te]) -- u and v have the same edge type+           return (DGenI (typeTuple [tuv,te], a))+           -- tres <- getResultType -- this is the resulting type of the function being defined+           -- addConstraint (tuv, tres) -- the vertex type of u is the same as the resuting type of the function+           -- addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           -- addConstraint (tv, typeVertex [tvv, te]) -- u and v have the same edge type+           -- return (DGenI (tres, a))+    typeCheck (DGenO a) = +        do tv <- checkDefined "v"+           xx <- addNames ["u", "e"]+           let [tu, te] = xx+           tuv <- getNewTypeName ""+           tvv <- getNewTypeName ""+           addConstraint (tu, tv) -- u and v has the same type+           addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           addConstraint (tv, typeVertex [tvv, te]) -- u and v have the same edge type+           return (DGenO (typeTuple [tuv, te], a))+           -- tres <- getResultType -- this is the resulting type of the function being defined+           -- addConstraint (tuv, tres) -- the vertex type of u is the same as the resuting type of the function+           -- addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           -- addConstraint (tv, typeVertex [tvv, te]) -- u and v have the same edge type+           -- return (DGenO (tres, a))+    typeCheck (DGenG a) = +        do --tg <- checkDefined "g"+           xx <- addNames ["u"]+           let [tu] = xx+           tuv <- getNewTypeName ""+           --tgv <- getNewTypeName ""+           te <- getNewTypeName ""+           --addConstraint (tuv, tgv) -- u and v has the same type+           addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           --addConstraint (tg, typeGraph  [tgv, te]) -- g is the graph of the same type+           return (DGenG (tuv, a))+           -- tres <- getResultType -- this is the resulting type of the function being defined+           -- addConstraint (tuv, tres) -- the vertex type of u is the same as the resuting type of the function+           -- addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           -- addConstraint (tg, typeGraph  [tgv, te]) -- g is the graph of the same type+           -- return (DGenG (tres, a))+    typeCheck (DGenTermG a) = +        do --tg <- checkDefined "g"+           xx <- addNames ["u"]+           let [tu] = xx+           tuv <- getNewTypeName ""+           --tgv <- getNewTypeName ""+           te <- getNewTypeName ""+           --addConstraint (tuv, tgv) -- u and v has the same type+           addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           --addConstraint (tg, typeGraph  [tgv, te]) -- g is the graph of the same type+           return (DGenTermG (tuv, a))+           -- tres <- getResultType -- this is the resulting type of the function being defined+           -- addConstraint (tuv, tres) -- the vertex type of u is the same as the resuting type of the function+           -- addConstraint (tu, typeVertex [tuv, te]) -- the type of u is Vertex .. ..+           -- addConstraint (tg, typeGraph  [tgv, te]) -- g is the graph of the same type+           -- return (DGenTermG (tres, a))++-- the type associated is the type of elements of the argument list and the result+instance Show a => TypeCheckable (DAgg a) (DAgg (DTypeInfo, a)) where+    typeCheck (DAggMin a) = +        do t <- getNewTypeName ""+           return (DAggMin (t, a))    -- forall a. [a] -> a  (+ Ord a)+    typeCheck (DAggMax a) = +        do t <- getNewTypeName ""+           return (DAggMax (t, a))    -- forall a. [a] -> a  (+ Ord a)+    typeCheck (DAggSum a) = +        do t <- getNewTypeName ""+           return (DAggSum (t, a))    -- forall a. [a] -> a  (+ Num a)+    typeCheck (DAggProd a) = +        do t <- getNewTypeName ""+           return (DAggProd (t, a))    -- forall a. [a] -> a  (+ Num a)+    typeCheck (DAggAnd a) = +        do return (DAggAnd (typeDTBool, a))  -- [Bool] -> Bool+    typeCheck (DAggOr a) = +        do return (DAggOr (typeDTBool, a))  -- [Bool] -> Bool+    typeCheck (DAggChoice x a) =+        if isNotConstant x+        then error "the default value of random aggregaor must be a constant."+        else do x' <- typeCheck x+                return (DAggChoice x' (getType' x', a))    -- let a be type of x, random x :: [a] -> a+    typeCheck (DTupledAgg as a) = +        do as' <- mapM typeCheck as+           let ts = map getType' as'+               t = typeTuple ts+           return (DTupledAgg as' (t, a))++isNotConstant (DCExp _ _) = False+isNotConstant _ = True+                  +instance Show a => TypeCheckable (DEdge a) (DEdge (DTypeInfo, a)) where+    typeCheck (DEdge a) = +        do d <- checkDefined "e"+           return (DEdge (d, a))++instance Show a => TypeCheckable (DTableExpr a) (DTableExpr (DTypeInfo, a)) where+    typeCheck (DPrev v a) = +        do x <- typeCheckApplication (DFun "prev" a) [v]+           let (_, [v'], tself) = x+           return (DPrev v' (tself, a))+    typeCheck (DCurr v a) = +        do x <- typeCheckApplication (DFun "curr" a) [v]+           let (_, [v'], tself) = x+           return (DCurr v' (tself, a))+    typeCheck (DVal v a) = +        do x <- typeCheckApplication (DFun "val" a) [v]+           let (_, [v'], tself) = x+           return (DVal v' (tself, a))++-- the type of the function being defined+getResultType :: State DEnvTC DTypeInfo+getResultType = +  do tres <- checkDefined resultTypeVarName+     return tres++addResultType :: DTypeInfo -> State DEnvTC ()+addResultType t = +  do addTypeBinds [(resultTypeVarName, t)]++-- dirty work around... +isTable n = n == "curr" || n == "prev"++tableRefresh (x@(DTypeTerm a [t1, t2])) = +    do tv <- getNewTypeName ""+       let (DTypeTerm _ [_, te]) = t1+           y = (DTypeTerm a [typeVertex [tv,te], t2])+       --trace ("table refresh: " ++ show x ++ " => " ++ show y) $ +       return y++checkDefined :: DVarName -> State DEnvTC DTypeInfo+checkDefined n = +  do binds <- getVarTypeBinds+     env <- get+     case (lookup n binds) of+       Just (d, r) ->  if isTable n then tableRefresh d else (if r then do d' <- refresh d; rs <- getRigidTypeVars;  (return d') else return d)+       Nothing -> error ("\nUndefined in typechecking:: no " ++ n ++ " in " ++ show env)++-- do not use these typeChecks in field/fun/var/constructor definitions+instance Show a => TypeCheckable (DField a) (DField (DTypeInfo, a)) where+    typeCheck (DField f a) = +        do d <- checkDefined f+           return (DField f (d, a))+--    typeCheck (DFfst a) =   +--        do d <- checkDefined "_fst"+--           return (DFfst (d, a))+--    typeCheck (DFsnd a) = +--        do d <- checkDefined "_snd"+--           return (DFsnd (d, a))+++removeSorted _ [] = []+removeSorted [] vs = vs+removeSorted (x@(r:rs)) (y@(v:vs)) = +    if r == v then removeSorted rs vs+    else if r < v then removeSorted rs y+         else (v:removeSorted x vs)++refresh d =+  do let vs = nub $ sort $ collectTypeVars d+     rs <- getRigidTypeVars+     let vs'' = removeSorted rs vs+     vs' <- mapM getNewTypeName vs''+     return (replaceVars (zip vs vs') d)++collectTypeVars :: DTypeTerm -> [String]+collectTypeVars (DTypeTerm x ts) = concatMap collectTypeVars ts+collectTypeVars (DTypeVar a) = [a]++replaceVars :: [(String, DTypeTerm)] -> DTypeTerm -> DTypeTerm+replaceVars tbl (DTypeTerm x ts) = DTypeTerm x (map (replaceVars tbl) ts)+replaceVars tbl (x@(DTypeVar a)) = case lookup a tbl of+                                     (Just a') -> a'+                                     Nothing -> x++instance Show a => TypeCheckable (DFun a) (DFun (DTypeInfo, a)) where+    typeCheck (DFun f a) = +        do d <- checkDefined f+           return (DFun f (d, a))+    typeCheck (DBinOp f a) = +        do d <- checkDefined f+           return (DBinOp f (d, a))++instance Show a => TypeCheckable (DVar a) (DVar (DTypeInfo, a)) where+    typeCheck (DVar v a) = +        do d <- checkDefined v+           return (DVar v (d, a))++instance Show a => TypeCheckable (DConstructor a) (DConstructor (DTypeInfo, a)) where+    typeCheck (DConstructor c a) = +        do d <- checkDefined c+           return (DConstructor c (d, a))+++-- checking expression e has type t under the environment bs+-- returns a pair of the typed expression and substitution+typing2 :: Show a => [VarTypeBind] -> DExpr a -> DTypeInfo -> DUnique -> ((DExpr (DTypeInfo, a), Substitution), DUnique)+typing2 bs e t uid = +    let (r, env') = runState (check e) env+        env = ((map setRefreshable bs, [], []), [], uid)+        check x = +            do x' <- typeCheck x+               xx <- doTyping' [] [x'] x+               let ((_, [x'']),s) = xx+               return (x'', s)+        (_,_,uid') = env'+    in (r, uid')++typing2' bs e t uid = let ((r,s), uid') = typing2 bs e t uid in ((mapData (\(t, _::a) -> DASTData t []) r, s), uid')+++-- building an environment for typing the body of a program (whose input graph is "g")+-- vertex type tv and edge type te must be concrete types+buildProgEnv tv te bs = bs'+  where bs' = [("g", typeGraph [tv, te])] ++ bs++-- building an environment for typing the body of a vertex-compute function, adding v, prev, curr and the result type+-- vertex type tvv and edge type tve must be concrete types+-- tuv is the type of vertices given to the tables+-- TDOO: add rigid type vars?+buildVertCompEnv tvv tve tuv tres bs = bs'+  where+    ttbl = typeFunction [typeVertex [tuv, tve], tres]+    tv = typeVertex [tvv, tve]+    bs' = [(resultTypeVarName, tres),("v", tv), ("prev", ttbl), ("curr", ttbl)]++bs +
+ compiler/TypeInstantiation.hs view
@@ -0,0 +1,457 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++Instantiating VertComp/VertInit/GraphFun for each use of them (7th step)++Assumption: +  - no function definition (other than the above)+  - let-bindings are located at the top level (of the above functions)++-}++module TypeInstantiation where++import Spec+import ASTData+import TypeChecker++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++type DTypeInstances = (DGroundDef DASTData, [(DTypeInfo, DGroundDef DASTData)])+type DTypeInstanceBinding = ([DVarName], DTypeInstances)+type DTypeInstanceBindings = [DTypeInstanceBinding]++-- uniq id, stack, stack head indices+type DEnvTI = (DUnique, DTypeInstanceBindings, [Int])++class TypeInstantiable a  where+    typeInstantiation :: a -> State DEnvTI a  -- functions are replaced with their instances+    typeInstantiation x = return x            -- default++-- entry point+runTypeInstantiation :: forall (t :: * -> *) a . TypeInstantiable (t DASTData) => (t DASTData) -> DUnique -> (t DASTData, DUnique)+runTypeInstantiation p uid = let (p', (uid', _, _)) = runState (typeInstantiation p) (uid, [], [])+                             in (p', uid')+-- TODO: built-in functions?++addNewBind :: DVarName -> DGroundDef DASTData -> State DEnvTI ()+addNewBind n def = do (i, bds, ks) <- get+                      let bds' = rec bds+                      put (i, bds', ks)+  where rec [] = []+        rec ((ns, (org, ins)):xs) = case elemIndex n ns of+                                      Just _ -> (ns, (org, (typeOf (getData def), def):ins)):xs+                                      Nothing -> (ns, (org, ins)):rec xs+        +getNewName :: String -> State (DEnvTI) DVarName+getNewName s = +    do (i, bds, ks) <- get +       let (n, i') = genNewName i (getBaseName s)+       put (i', bds, ks)+       return n++getBinds :: State DEnvTI DTypeInstanceBindings+getBinds = do (i, bds, ks) <- get+              return bds++addBindsByDefs :: [DGroundDef DASTData] -> State DEnvTI ()+addBindsByDefs defs = do addBinds (map (\def -> (getNames def, (def, []))) defs)++addBindsByDefsS :: [DSmplDef DASTData] -> State DEnvTI ()+addBindsByDefsS defs = addBindsByDefs (map (\def -> DGDefSmpl def (getData def)) defs)++addBindsByDefsV :: [DDefGraphVar DASTData] -> State DEnvTI ()+addBindsByDefsV defs = addBindsByDefs (map (\def -> DGDefGV def (getData def)) defs)++addBinds :: DTypeInstanceBindings -> State DEnvTI ()+addBinds bds = do (i, bds', ks) <- get+                  put (i, bds++bds', length bds:ks)+++lookupBind :: DVarName -> State DEnvTI (Maybe (DTypeInstances, Int))+lookupBind n = do bds <- getBinds+                  return (rec bds)+    where rec [] = Nothing+          rec ((ns, ins):xs) = case elemIndex n ns of +                                 Just i -> (Just (ins, if length ns == 1 then -1 else i))+                                 Nothing -> rec xs          ++popBinds :: State DEnvTI DTypeInstanceBindings+popBinds = do xx <- get+              let (i, bds, k:ks) = xx+              put (i, drop k bds, ks)+              return (take k bds)++isSmplDef (DGDefSmpl def a) = True+isSmplDef _ = False++isVertFunDef (DGDefVI def a) = True+isVertFunDef (DGDefVC def a) = True+isVertFunDef _ = False++isGraphFunVarDef (DGDefGV def a) = True+isGraphFunVarDef (DGDefGF def a) = True+isGraphFunVarDef _ = False++instance TypeInstantiable (DProgramSpec DASTData) where+    typeInstantiation (DProgramSpec rs p a) = +        do p' <- typeInstantiation p+           return (DProgramSpec rs p' a)++instance TypeInstantiable (DProg DASTData) where+    typeInstantiation (DProg f defs e a) = +        do -- add the defs. to the env+           addBindsByDefs defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = concatMap (\(_, (_, ds)) -> map snd ds) defs'+           return (DProg f defs'' e' a)++instance TypeInstantiable (DGraphExpr DASTData) where+    typeInstantiation (DPregel f0 ft x g a) = +        do f0' <- typeInstantiation f0+           ft' <- typeInstantiation ft+           x' <- typeInstantiation x+           g' <- typeInstantiation g+           return (DPregel f0' ft' x' g' a)+    typeInstantiation (DGMap f g a) = +        do f' <- typeInstantiation f+           g' <- typeInstantiation g+           return (DGMap f' g' a)+    typeInstantiation (DGZip g1 g2 a) = +        do g1' <- typeInstantiation g1+           g2' <- typeInstantiation g2+           return (DGZip g1' g2' a)+    typeInstantiation (DGIter f0 ft x g a) = +        do f0' <- typeInstantiation f0+           ft' <- typeInstantiation ft+           x' <- typeInstantiation x+           g' <- typeInstantiation g+           return (DGIter f0' ft' x' g' a)+    typeInstantiation (DGVar v a) = +        do v' <- typeInstantiation v +           return (DGVar v' a)++------------------ giving new names when instantiating+class NameRefreshable a where+    refreshNames :: a -> State DEnvTI a++instance NameRefreshable (DGroundDef DASTData) where+    refreshNames (DGDefVC d a) = do d' <- refreshNames d+                                    return (DGDefVC d' a)+    refreshNames (DGDefVI d a) = do d' <- refreshNames d+                                    return (DGDefVI d' a)+    refreshNames (DGDefSmpl d a) = do d' <- refreshNames d+                                      return (DGDefSmpl d' a)+    refreshNames (DGDefGV d a) =+        do d' <- refreshNames d+           return (DGDefGV d' a)+    refreshNames (DGDefGF d a) = do d' <- refreshNames d+                                    return (DGDefGF d' a)++replaceNames :: [(DVarName, DVarName)] -> DExpr DASTData -> DExpr DASTData+replaceNames subsv e = rec e+  where+    rec (DIf p t e a) = +        let p' = rec p+            t' = rec t+            e' = rec e+        in (DIf p' t' e' a)+    rec (DTuple es a) =+        let es' = map rec es +        in (DTuple es' a)+    rec (DFunAp f es a) =+        let es' = map rec es+        in (DFunAp f es' a)+    rec (DConsAp c es a) =+        let es' = map rec es+        in (DConsAp c es' a)+    rec (x@(DFieldAcc t fs a)) = x+    rec (x@(DFieldAccE e fs a)) = x+    rec (DAggr a' e g es a) =+        let e'  = rec e+            es' = map rec es+        in (DAggr a' e' g es' a)+    rec (x@(DVExp (DVar v av) a)) = +        case lookup v subsv of+          Just v' -> (DVExp (DVar v' av) a)+          Nothing -> x+    rec (x@(DCExp c a)) = x+++instance NameRefreshable (DFun DASTData) where+    refreshNames (DFun f a) =+        do f' <- getNewName f+           return (DFun f' a)+    refreshNames (DBinOp f a) =+        do f' <- getNewName f+           return (DBinOp f' a)++instance NameRefreshable (DVar DASTData) where+    refreshNames (DVar v a) =+        do v' <- getNewName v+           return (DVar v' a)++instance NameRefreshable (DDefVertComp DASTData) where+    refreshNames (DDefVertComp f defs e a) = +        do f' <- refreshNames f+           return (DDefVertComp f' defs e a)++instance NameRefreshable (DDefVertInit DASTData) where+    refreshNames (DDefVertInit f defs e a) = +        do f' <- refreshNames f+           return (DDefVertInit f' defs e a)++instance NameRefreshable (DDefGraphVar DASTData) where+    refreshNames (DDefGraphVar v e a) = +        do v' <- refreshNames v+           return (DDefGraphVar v' e a)++replaceNamesF subse (DFun f a) =+    case lookup f subse of+      Nothing -> (DFun f a)+      Just f' -> (DFun f' a)++replaceNamesV subse (DVar v a) =+    case lookup v subse of+      Nothing -> (DVar v a)+      Just v' -> (DVar v' a)++replaceNamesG subse (DPregel f0 ft x g a) = +    let f0' = replaceNamesF subse f0+        ft' = replaceNamesF subse ft+        x' = x+        g' = replaceNamesG subse g+    in (DPregel f0' ft' x' g' a)+replaceNamesG subse (DGMap f g a) = +    let f' = replaceNamesF subse f+        g' = replaceNamesG subse g+    in (DGMap f' g' a)+replaceNamesG subse (DGZip g1 g2 a) = +    let g1' = replaceNamesG subse g1+        g2' = replaceNamesG subse g2+    in (DGZip g1' g2' a)+replaceNamesG subse (DGIter f0 ft x g a) = +    let f0' = replaceNamesF subse f0+        ft' = replaceNamesF subse ft+        x' = x+        g' = replaceNamesG subse g+    in  (DGIter f0' ft' x' g' a)+replaceNamesG subse (DGVar v a) = +    let v' = replaceNamesV subse v+    in (DGVar v' a)++replaceNamesGV subse (DDefGraphVar v e a) = +    let e' = (replaceNamesG subse e)+    in (DDefGraphVar v e' a)++instance NameRefreshable (DDefGraphFun DASTData) where+    refreshNames (DDefGraphFun f v defs e a) = +        do f' <- refreshNames f+           v' <- refreshNames v+           defs' <- mapM refreshNames defs +           let subse = [(getName f, getName f'), (getName v, getName v')] ++ zipWith (\o n -> (getName o, getName n)) defs defs'+               e' = replaceNamesG subse e+               defs'' = map (replaceNamesGV subse) defs'+           return (DDefGraphFun f' v' defs'' e' a)++instance NameRefreshable (DSmplDef DASTData) where+    refreshNames (DDefVar v [] e a) = +        do v' <- refreshNames v+           let subse = [(getName v, getName v')]+               e' = replaceNames subse e+           return (DDefVar v [] e' a)+    refreshNames (DDefTuple vs [] e a) = +        do vs' <- mapM refreshNames vs+           let subse = zip (map getName vs) (map getName vs')+               e' = replaceNames subse e+           return (DDefTuple vs' [] e' a)+    refreshNames x = error $ "something wrong in refreshNames : x = " ++ show x++----------------------------------------------------------------++instance TypeInstantiable (DGroundDef DASTData) where+    typeInstantiation (DGDefVC d a) = do d' <- typeInstantiation d+                                         return (DGDefVC d' a)+    typeInstantiation (DGDefVI d a) = do d' <- typeInstantiation d+                                         return (DGDefVI d' a)+    typeInstantiation (DGDefSmpl d a) = do d' <- typeInstantiation d+                                           return (DGDefSmpl d' a)+    typeInstantiation (DGDefGV d a) = do d' <- typeInstantiation d+                                         return (DGDefGV d' a)+    typeInstantiation (DGDefGF d a) = do d' <- typeInstantiation d+                                         return (DGDefGF d' a)++makeDefs defs = concatMap (\(_, (_, ds)) -> map (\(DGDefSmpl def _) -> def) (map snd ds)) defs+makeDefsGV defs = concatMap (\(_, (_, ds)) -> map (\(DGDefGV def _) -> def) (map snd ds)) defs++instance TypeInstantiable (DDefVertComp DASTData) where+    typeInstantiation (DDefVertComp f defs e a) = +        do addBindsByDefsS defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefs defs'+           return (DDefVertComp f defs'' e' a)++instance TypeInstantiable (DDefVertInit DASTData) where+    typeInstantiation (DDefVertInit f defs e a) = +        do addBindsByDefsS defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefs defs'+           return (DDefVertInit f defs'' e' a)++instance TypeInstantiable (DDefGraphVar DASTData) where+    typeInstantiation (DDefGraphVar v e a) = +        do e' <- typeInstantiation e+           return (DDefGraphVar v e' a)++instance TypeInstantiable (DDefGraphFun DASTData) where+    typeInstantiation (DDefGraphFun f v defs e a) = +        do addBindsByDefsV defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefsGV defs'+           return (DDefGraphFun f v defs'' e' a)++instance TypeInstantiable (DSmplDef DASTData) where+    typeInstantiation (DDefFun f vs defs e a) = +        do addBindsByDefsS defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefs defs'+           return (DDefFun f vs defs'' e' a)+    typeInstantiation (DDefVar v defs e a) = +        do addBindsByDefsS defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefs defs'+           return (DDefVar v defs'' e' a)+    typeInstantiation (DDefTuple vs defs e a) = +        do addBindsByDefsS defs+           e' <- typeInstantiation e+           defs' <- popBinds+           let defs'' = makeDefs defs'+           return (DDefTuple vs defs'' e' a)++instance TypeInstantiable (DTermination DASTData) where+    typeInstantiation (DTermF a) = return (DTermF a)+    typeInstantiation (DTermI e a) = +        do e' <- typeInstantiation e+           return (DTermI e' a)+    typeInstantiation (DTermU e a) = +        do e' <- typeInstantiation e+           return (DTermU e' a)+++instance TypeInstantiable (DExpr DASTData) where+    typeInstantiation (DIf p t e a) = +        do p' <- typeInstantiation p+           t' <- typeInstantiation t+           e' <- typeInstantiation e+           return (DIf p' t' e' a)+    typeInstantiation (DTuple es a) =+        do es' <- mapM typeInstantiation es +           return (DTuple es' a)+    typeInstantiation (DFunAp f es a) =+        do f' <- typeInstantiation f+           es' <- mapM typeInstantiation es+           return (DFunAp f' es' a)+    typeInstantiation (DConsAp c es a) =+        do c' <- typeInstantiation c+           es' <- mapM typeInstantiation es+           return (DConsAp c' es' a)+    typeInstantiation (DFieldAcc t fs a) =+        do t' <- typeInstantiation t+           fs' <- mapM typeInstantiation fs+           return (DFieldAcc t' fs' a)+    typeInstantiation (DFieldAccE e fs a) =+        do e' <- typeInstantiation e+           fs' <- mapM typeInstantiation fs+           return (DFieldAccE e' fs' a)+    typeInstantiation (DAggr a' e g es a) =+        do a'' <- typeInstantiation a'+           g' <- typeInstantiation g+           e' <- typeInstantiation e+           es' <- mapM typeInstantiation es+           return (DAggr a'' e' g' es' a)+    typeInstantiation (DVExp v a) =+        do v' <- typeInstantiation v+           return (DVExp v' a)+    typeInstantiation (DCExp c a) = +        do c' <- typeInstantiation c +           return (DCExp c' a)++unifyUpdate def t = +    do s <- unify' [(typeOf (getData def), t)]+       return (mapData (\a -> a { typeOf = apply s (typeOf a)}) def)++instance TypeInstantiable (DFun DASTData) where+    typeInstantiation (DBinOp f a) = instantiation DBinOp f a+    typeInstantiation (DFun f a) = instantiation DFun f a++instance TypeInstantiable (DVar DASTData) where+    typeInstantiation (DVar v a) = instantiation DVar v a++instantiation+  :: (DVarName -> DASTData -> b)+     -> DVarName+     -> DASTData+     -> State DEnvTI b+instantiation build v a =+        do r <- lookupBind v+           case r of +             Nothing -> return (build v a)  -- temporary things?+             Just ((def, ins), pos) -> +                 case def of +                   (DGDefGF _ _) -> do def' <- refreshNames def        -- always duplicate it+                                       let defe'' = unifyUpdate def' (typeOf a)+                                       case defe'' of+                                         Right def'' ->+                                             do def''' <- typeInstantiation def'' -- instantiate it+                                                addNewBind v def'''              -- add it to the env+                                                return (build (getNames def''' !! (max pos 0)) a)  -- use it+                                         Left str -> error (str ++ "\nerror during unifying " ++ show def' ++ " and " ++ show (typeOf a) ++ "\nv="++show v ++ "\na="++show a)+                   otherwise -> +                       case lookupAt pos (typeOf a) ins of+                         Just def' -> return (build (getNames def' !! (max pos 0)) a) -- already instantiated+                         Nothing -> if typeAt pos (typeOf (getData def)) == (typeOf a) +                                     then do def'' <- typeInstantiation def+                                             addNewBind v def''  -- use the original one+                                             return (build (getNames def'' !! (max pos 0)) a)+                                     else do def' <- refreshNames def        -- gives new names+                                             let defe'' = unifyUpdate def' (typeOf a)+                                             case defe'' of+                                               Right def'' ->+                                                   do def''' <- typeInstantiation def'' -- instantiate it+                                                      addNewBind v def'''              -- add it to the env+                                                      return (build (getNames def''' !! (max pos 0)) a)  -- use it+                                               Left str -> error (str ++ "\nerror during unifying2 " ++ show def' ++ " and " ++ show (typeOf a) ++ "\nv="++show v ++ "\na="++show a ++ "\nins="++show ins ++ "\npos="++show pos )++typeAt (-1) t = t+typeAt pos (DTypeTerm "(,)" ts) = (ts!!pos)++lookupBy' :: Eq b => (a -> b) -> b -> [(a, x)] -> Maybe x+lookupBy' _ _ [] = Nothing+lookupBy' f key ((a,x):xs) = if f a == key then Just x else lookupBy' f key xs++lookupAt :: Int -> DTypeInfo -> [(DTypeInfo, x)] -> Maybe x+lookupAt pos t ins | pos == -1 = lookup t ins+                   | otherwise = lookupBy' (typeAt pos) t ins   -- tuple case+++++instance TypeInstantiable (DAgg DASTData)+instance TypeInstantiable (DGen DASTData)+instance TypeInstantiable (DEdge DASTData)+instance TypeInstantiable (DTableExpr DASTData)+instance TypeInstantiable (DField DASTData)+instance TypeInstantiable (DConstructor DASTData)+instance TypeInstantiable (DConst DASTData) +
+ compiler/VCOutputNormalization.hs view
@@ -0,0 +1,103 @@+{-# Language TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies,RankNTypes,FlexibleContexts,KindSignatures,ScopedTypeVariables #-}++{-++Given a vertex-compute function, this makes its output expression to be of the form RecordConstructor e1 e2 ... ek (9th step)++Assumption: ++  - typed.+  - inlined.++-}++module VCOutputNormalization where++import Spec+++import Control.Monad.State+import Data.Maybe+import Data.List+import Numeric (showHex)+import Debug.Trace++import ASTData+import TypeChecker(typing, unify, apply, buildVertCompEnv, buildProgEnv, typeCheck, typingTypeExpression)++type DONState = DUnique+++normalizeVertCompRecordOutputExp' :: [DRecordSpec DASTData] -> DDefVertComp DASTData -> DUnique -> (DDefVertComp DASTData, DUnique)+normalizeVertCompRecordOutputExp' rs x uid+ = runState act uid+   where act = do x' <- normVCOutput' (rs++[nullRecordSpec]) x+                  return x'++normVCOutput' rs (DDefVertComp f defs e a)+ = do let rt = (getTypeName (getType e))+          r = maybe (error ("unknown record type: " ++ rt)) id $ lookupBy (getName) rt rs+      (defs', e') <- normVCOutputExp r e+      return (DDefVertComp f (defs++defs') e' a)++normalizeVertCompRecordOutputExp :: DProgramSpec DASTData -> DUnique -> (DProgramSpec DASTData, DUnique)+normalizeVertCompRecordOutputExp (DProgramSpec rs (DProg f defs e a) a') uid+ = (DProgramSpec rs (DProg f defs' e a) a', uid')+   where (defs', uid') = runState act uid +         act = do defs' <- mapM (normVCOutput (rs++[nullRecordSpec])) defs+                  return defs'+normVCOutput :: [DRecordSpec DASTData] -> DGroundDef DASTData -> State DONState  (DGroundDef DASTData)+normVCOutput rs (DGDefVC (DDefVertComp f defs e a) a')+ = do let rt = (getTypeName (getType e))+          r = maybe (error ("unknown record type: " ++ rt)) id $ lookupBy (getName) rt rs+      (defs', e') <- normVCOutputExp r e+      return (DGDefVC (DDefVertComp f (defs++defs') e' a) a')+normVCOutput rs (DGDefVI (DDefVertInit f defs e a) a')+ = do let rt = (getTypeName (getType e))+          r = maybe (error ("unknown record type: " ++ rt)) id $ lookupBy (getName) rt rs+      (defs', e') <- normVCOutputExp r e+      return (DGDefVI (DDefVertInit f (defs++defs') e' a) a')+normVCOutput rs x = do return x+++--make the final expression to be a construcgtor application+normVCOutputExp :: DRecordSpec DASTData -> DExpr DASTData -> State DONState ([DSmplDef DASTData], DExpr DASTData)+normVCOutputExp r (e@(DConsAp c es a)) = do splitToDefs e+normVCOutputExp (r@(DRecordSpec c fts a)) e = +    do let es = splitByFields r e+       splitToDefs (DConsAp c es (getData e))++getNewName :: String -> State (DONState) DVarName+getNewName s = +    do (i) <- get +       let (n, i') = genNewName i s+       put (i')+       return n++splitToDefs :: DExpr DASTData -> State DONState ([DSmplDef DASTData], DExpr DASTData)+splitToDefs (DConsAp c es a) = +         -- if a code generator requries that no operand of the constructor application can be a constant expression, then remove this branch.+    do vs <- mapM (\e -> case e of DVExp _ _ -> return Nothing; DCExp _ _ -> return Nothing; otherwise -> (do n <- (getNewName "var"); return (Just n))) es+       let ves = (zip vs es)+           defss = map (\(v,e) -> maybe [] (\n -> [DDefVar (DVar n (getData e)) [] e (getData e)]) v) ves+       return  (concat defss, DConsAp c (map (\(x, e) -> case x of [] -> e; [DDefVar v _ _ a] -> DVExp v a) (zip defss es)) a)+       ++splitByFields :: DRecordSpec DASTData -> DExpr DASTData -> [DExpr DASTData]+splitByFields (DRecordSpec c fts a) e = map (\i -> extractFieldExp e (fts!!i) i) [0..(length fts - 1)]++extractFieldExp :: DExpr DASTData -> (DField DASTData, DType DASTData) -> Int -> DExpr DASTData+extractFieldExp e (f, t) i = rec e -- this must be the i-th component of the e+  where t' = typingTypeExpression t+        rec (DIf e1 e2 e3 a) = let e2' = (rec e2) +                                   e3' = (rec e3)+                               in DIf e1 e2' e3' (a {typeOf = getType e2'} )+        rec (DTuple es a) = error "something wrong!"+        rec (DFunAp f es a) = error "something wrong!"+        rec (DConsAp c es a) = es !! i    -- this must be correct+        rec (DFieldAcc te fs a) = DFieldAcc te (fs++[setType t' f]) (a {typeOf = t'})+        rec (DFieldAccE ee fs a) = DFieldAccE ee (fs++[setType t' f]) (a {typeOf = t'})+        rec (DAggr agg e g ps a) = error "something wrong!"+        rec (DVExp v a) = error "not supported yet"+        rec (DCExp c a) = error "something wrong!"+
+ fregel.cabal view
@@ -0,0 +1,115 @@+cabal-version:      3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'fregel' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:               fregel++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version:            1.2.0++-- A short (one-line) description of the package.+synopsis: A functional DSL for vertex-centric large-scale graph processing++-- A longer description of the package.+description:+  Fregel (Functional Pregel) is a functional domain-specific language for developing programs of vertex-centric (i.e., Pregel) style of big graph processing, in which the computation at every vertex is abstracted as a higher-order function. Fregel has clear functional semantics and supports declarative description of vertex computation. ++  The current Fregel processor is a translator (compiler) from Fregel code into Giraph code in Java / Pregel+ code in C++.++  Technical details can be found in the JFP paper (DOI: https://doi.org/10.1017/S0956796821000277 ). ++  Note that some optimization options need Z3, an SMT solver, to be installed in your system.++-- URL for the project homepage or repository.+homepage:           https://ipl.cs.uec.ac.jp/~iwasaki/Fregel++-- The license under which the package is released.+license:            MIT++-- The file containing the license text.+license-file:       LICENSE++-- The package author(s).+author:             Hideya Iwasaki, Kento Emoto, Akimasa Morihata, Kiminori Matsuzaki, Zhenjiang Hu++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         emoto@csn.kyutech.ac.jp, iwasaki@cs.meiji.ac.jp ++-- A copyright notice.+-- copyright:+category:           Language+build-type:         Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:    CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+    ghc-options: -Wall++executable fregel+    -- Import common warning flags.+    import:           warnings++    -- .hs or .lhs file containing the Main module.+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    other-modules:+        ASTData+        , ASTTrans+        , AggregatorExtraction+        , Analysis+        , Convert0+        , DependencySimple+        , GenSMT+        , IR+        , IRtoPregel+        , Inlining+        , Lexer+        , Normalization+        , NtoIR+        , Parser+        , Spec+        , Spec0+        , TypeChecker+        , TypeInstantiation+        , VCOutputNormalization+++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:+        base >=4.14.0.0 && < 4.19.0.0+        , array ^>=0.5.4.0+        , groom ^>=0.1.2.1+        , process ^>=1.6.16.0+        , mtl ^>=2.2.2++    -- Directories containing source files.+    hs-source-dirs:   compiler++    -- needs happy and alex+    build-tool-depends:         happy:happy, alex:alex++    -- Base language which the package is written in.+    default-language: Haskell2010
+ haskell/Fregel.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleContexts,
+             RankNTypes,
+             ScopedTypeVariables,
+             NoMonomorphismRestriction,
+             RelaxedPolyRec,
+             NoMonoLocalBinds #-}
+
+module Fregel where
+
+import Data.Maybe
+
+type Vid = Int
+data Vertex a b = V Vid a [Edge a b] [Edge a b] (Graph a b)
+type Edge a b = (b, Vertex a b)
+type Graph a b = [Vertex a b]
+data Termination a = Fix | Iter Int | Until (a -> Bool)
+
+{- Vertex equivalence: its values and neighbors' ids only.-}
+instance (Eq a) => Eq (Vertex a b) where
+  (==) (V i1 a1 is1 rs1 g1) (V i2 a2 is2 rs2 g2) =
+     i1 == i2 && a1 == a2 &&
+     (map (vid . snd) is1) == (map (vid . snd) is2) && (map (vid . snd) rs1) == (map (vid . snd) rs2)
+
+instance (Show a, Show b) => Show (Vertex a b) where
+  show (V vid a is rs g) =
+    "V " ++ show vid ++ " " ++ show a ++
+    " [" ++ showEdges is ++ "] [" ++ showEdges rs ++ "]"
+    where showEdges [] = ""
+          showEdges [e] = showE e
+          showEdges (e:es) = showE e ++ ", " ++ showEdges es
+          showE (b, V k _ _ _ _) = "(" ++ show b ++ ",v" ++ show k ++ ")"
+
+getVertexId :: Vertex a b -> Vid
+getVertexId (V vid _ _ _ _) = vid
+
+getVertexValue :: Vertex a b -> a
+getVertexValue (V _ a _ _ _) = a
+
+getGraph :: Vertex a b -> Graph a b
+getGraph (V _ _ _ _ g) = g
+
+makeGraph :: (a -> r -> c) -> Graph a b -> [r] -> Graph c b
+makeGraph vf vs rs = newvs
+  where newvs = zipWith cf vs rs
+        vps = zip (map getVertexId vs) newvs
+        convE (b,v) = (b, fromJust (lookup (getVertexId v) vps))
+        cf (V vid a is rs g) r = V vid (vf a r) (map convE is) (map convE rs) newvs
+
+graphy :: Graph a b -> [r] -> Graph r b
+graphy g = makeGraph (\a r -> r) g
+
+-- short-hands
+val = getVertexValue
+vid = getVertexId
+is (V _ _ es _ _) = es
+rs (V _ _ _ es _) = es
+gof = getGraph
+
+-- field access notation
+(.^) :: forall a c . a -> (a->c) -> c
+(.^) a f = f a
+infixl .^
+
+(!=) :: forall a . Eq a => a -> a -> Bool
+(!=) a b = not (a == b)
+infixl !=
+
+termination :: Eq a => Termination a -> [a] -> a
+termination Fix xs =
+  fst . head . dropWhile (\(a,b) -> (a /= b)) $ zip xs (tail xs)
+termination (Iter n) xs = head (drop n xs)
+termination (Until p) xs = head $ dropWhile (not.p) xs
+
+-- fregel computation with two tables of the previous values and current values
+fregel :: (Eq r) =>
+          (Vertex a b -> r) ->
+          (Vertex a b -> (Vertex a' b -> r) -> (Vertex a' b -> r) -> r) ->
+          Termination (Graph r b) ->
+          Graph a b ->
+          Graph r b
+fregel h f t g = 
+  let rs0 = map h g
+      step rs = let rs' = map (\v -> f v prev curr) g
+                    prev u = rs !! ((getVertexId u)-1)
+                    curr u = rs' !! ((getVertexId u)-1)
+                in rs'
+      rss = iterate step rs0
+  in termination t (map (graphy g) rss)
+
+-- iterative fregel!
+giter :: (Eq r) =>
+         (Vertex a b -> r) -> (Graph r b -> Graph r b) ->
+         Termination (Graph r b) -> Graph a b -> Graph r b
+giter h f t g = 
+  let g0 = makeGraph (\a r -> r) g (map h g)
+      gss = iterate f g0
+  in termination t gss
+
+-- gmap is a special case of fregel; only initialization (one superstep?)
+gmap :: (Eq r) => (Vertex a b -> r) -> Graph a b -> Graph r b
+gmap f g = fregel f ft Fix g
+           where ft v prev curr = prev v
+
+-- gzip; two graphs have to be of the same shape
+data Pair a b = Pair {_fst :: a, _snd :: b} deriving (Show, Eq)
+gzip :: Graph a1 b -> Graph a2 b -> Graph (Pair a1 a2) b
+gzip g1 g2 = makeGraph (\a r -> Pair a r) g1 (map getVertexValue g2)
+
+ haskell/Graphs.hs view
@@ -0,0 +1,128 @@+module Graphs where
+
+import Fregel
+
+-- make a graph
+
+type VertexData a = (Vid, a)
+type EdgeData b = (Vid, Vid, b)
+
+mG :: [VertexData a] -> [EdgeData b] -> Bool -> Graph a b
+mG vds eds True = toGraph vds (eds ++ flipEdgeList eds)
+mG vds eds False = toGraph vds eds
+
+flipEdgeList :: [EdgeData b] -> [EdgeData b]
+flipEdgeList eds = [(d,s,b) | (s,d,b) <- eds]
+
+toGraph :: [VertexData a] -> [EdgeData b] -> Graph a b
+toGraph vds eds = gs
+  where gs = [V vid a (inEdges vid) (outEdges vid) gs | (vid,a) <- vds]
+        inEdges vid = [(b, gs !! (s-1)) | (s,d,b) <- eds, d == vid]
+        outEdges vid = [(b, gs !! (d-1)) | (s,d,b) <- eds, s == vid]
+
+valG :: Graph a b -> [(Vid, a)]
+valG = map (\(V vid a _ _ _) -> (vid, a))
+
+{-------------------------- Sample graphs ------------------------------}
+
+{-
+graph1:
+
+     B <- A <-+
+     |        |
+     +------> C ----> D <-+
+              |       |   |
+              +-> E <-+   |
+                  |       |
+                  +-> F --+
+-}
+
+graph1 :: Graph String Int
+graph1 = let va = V 1 "A" [(1, vc)] [(1, vb)] g
+             vb = V 2 "B" [(1, va)] [(1, vc)] g
+             vc = V 3 "C" [(1, vb)] [(1, va), (1, vd), (1, ve)] g
+             vd = V 4 "D" [(1, vc), (1, vf)] [(1, ve)] g
+             ve = V 5 "E" [(1, vc), (1, vd)] [(1, vf)] g
+             vf = V 6 "F" [(1, ve)] [(1, vd)] g
+             g = [va, vb, vc, vd, ve, vf]
+         in g
+
+{-
+graph1n:
+       -1    3
+     B <- A <-+ 
+     |        |  3       3
+     +------> C ----> D <-+
+      -1      |       |   |
+              +-> E <-+   |
+              1   |   -3  |
+                 1+-> F --+
+
+the Dijkstra algorithm (from A) fails: 
+  it says cost(A,F) = 0 but this should be -1
+-}
+
+-- with negative edge
+graph1n :: Graph String Int
+graph1n = let va = V 1 "A" [(3, vc)] [(-1, vb)] g
+              vb = V 2 "B" [(-1, va)] [(-1, vc)] g
+              vc = V 3 "C" [(-1, vb)] [(3, va), (3, vd), (1, ve)] g
+              vd = V 4 "D" [(3, vc), (3, vf)] [(-3, ve)] g
+              ve = V 5 "E" [(1, vc), (-3, vd)] [(1, vf)] g
+              vf = V 6 "F" [(1, ve)] [(3, vd)] g
+              g = [va, vb, vc, vd, ve, vf] 
+          in g
+
+graph2 :: Graph Int Int
+graph2 = mG [(1, 100), (2, 600), (3, 200), (4, 400), (5, 500), (6, 300)]
+            [(1,2,1),(2,3,1),(3,1,1),(3,4,1),(3,5,1),(4,5,1),(5,6,1),(6,4,1)]
+            True
+
+graph3 :: Graph String Int
+graph3 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F")]
+            [(1,2,6),(1,3,4),(1,4,1),(2,1,6),(2,6,3),(3,2,1),(3,5,5),
+             (4,3,2),(4,5,3),(5,6,6)]
+            False
+
+{-
+graph4 (undirected (bi-directional)):
+
+     A -- C -- B   
+          |            
+          |   +--- E ------+ 
+          |   |    |       | 
+          +-- D -- F -- H  |
+              |    |       |
+              +--- G ------+
+
+   D,E,F,G forms a 4-clique  ->  the densest subgraph.
+
+-}
+
+graph4 :: Graph String Int
+graph4 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F"),(7,"G"),(8,"H")]
+            [(1,3,1),(2,3,1),(3,4,1),(4,5,1),(4,6,1),
+             (4,7,1),(5,6,1),(5,7,1),(6,7,1),(6,8,1)]
+            True
+
+graph4' :: Graph Int Int
+graph4' = mG [(1,10),(2,11),(3,12),(4,13),(5,14),(6,15),(7,16),(8,17)]
+             [(1,3,1),(2,3,1),(3,4,1),(4,5,1),(4,6,1),
+              (4,7,1),(5,6,1),(5,7,1),(6,7,1),(6,8,1)]
+             True
+{-
+graph5:
+
+    A <-> B            E <-> F            I <-> J 
+          |            |     |            |
+          +-> C <-> D <-     +-> G <-> H <-
+
+
+-}
+
+graph5 :: Graph String Int
+graph5 = mG [(1,"A"),(2,"B"),(3,"C"),(4,"D"),(5,"E"),(6,"F"),(7,"G"),(8,"H"),
+             (9,"I"),(10,"J")]
+            [(1,2,1),(2,1,1),(2,3,1),(3,4,1),(4,3,1),(5,4,1),(5,6,1),(6,5,1),
+             (6,7,1),(7,8,1),(8,7,1),(9,8,1),(9,10,1),(10,9,1)]
+            False
+ haskell/ds.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++import Fregel+import Graphs++#include "../sample-programs/ds.fgl"
+ haskell/maxv.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++import Fregel+import Graphs++#include "../sample-programs/maxv.fgl"
+ haskell/re.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++import Fregel+import Graphs++#include "../sample-programs/re.fgl"
+ haskell/sssp.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++import Fregel+import Graphs++#include "../sample-programs/sssp.fgl"
+ haskell/sssp2.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}++import Fregel+import Graphs+import Prelude hiding (minimum)++-- we need the identity element (bigger than anything) for minimum, but...+minimum [] = 1000000+minimum xs = foldr1 min xs++#include "../sample-programs/sssp2.fgl"
+ sample-programs/bi-graph.txt view
@@ -0,0 +1,4 @@+[1,1,[[2,1]]]+[2,1,[[1,1],[3,1]]]+[3,1,[[2,1],[4,1]]]+[4,1,[[3,1]]]
+ sample-programs/bimatch.fgl view
@@ -0,0 +1,34 @@+data SVal = SVal { match :: Int} deriving (Eq, Show)++bipartitematching g = +  let init v = SVal(-1);+      ss0 v = SVal(if (vid v`mod`2 == 0 && val v.^match == -1)+                   then random (-1) [ vid u | (e,u) <- is v, val u .^ match == -1 ]+                   else val v.^match);+      ss1 v = SVal(if (vid v`mod`2 == 1 && val v.^match == -1) +                   then random (-1) [ vid u | (e,u) <- is v, val u .^ match == vid v ]+                   else val v.^match);+      ss2 v = SVal(if (vid v`mod`2 == 0 && val v.^match /= -1) +                   then random (-1) [ vid u | (e,u) <- is v, val u .^ match == vid v ] +                   else val v.^match); +      step g = let g1 = gmap ss0 g;+                   g2 = gmap ss1 g1;+                   g3 = gmap ss2 g2+               in g3+  in giter init step Fix g+++{-+data BM = BM { match :: Int } deriving (Eq, Show)+bimatch g = +  let init v = BM (-1);+      ss0 v = BM (if (vid v`mod`2 == 0 && val v.^match == -1) then random (-1) [ vid u | (e,u) <- is v, val u.^match == -1 ] else val v.^match);+      ss1 v = BM (if (vid v`mod`2 == 1 && val v.^match == -1) then random (-1) [ vid u | (e,u)<-is v, val u.^match == vid v ] else val v.^match);+      ss2 v = BM (if (vid v`mod`2 == 0 && val v.^match /= -1) then random (-1) [ vid u | (e,u)<-is v, val u.^match == vid v ] else val v.^match);+      step g = let g1 = gmap ss0 g;+                   g2 = gmap ss1 g1;+                   g3 = gmap ss2 g2+               in g3+  in giter init step Fix g++ -}
+ sample-programs/ds.fgl view
@@ -0,0 +1,158 @@+{- densest subgraph (global/in-neightbor/out-neighbor aggregations)
+   (NOTE: this is corrected version.) -}
+
+data DsRecord =
+  DsRecord { ins :: Bool, inst :: Bool, ft :: Double, deg :: Double }
+  deriving (Eq, Show)
+
+ds g =
+  let epsilon = 0.01                                                      ;
+      ds_0 v = DsRecord True True 0.0 0.0                                 ;
+      ds_t v prev curr =
+        let deg' = sum [ 1.0 | (e,u) <- is v, prev u.^ins ]               ;
+            nDeg = sum [ curr u.^deg | u <- g, prev u.^ins ]              ;
+            nS = sum [ 1.0 | u <- g, prev u.^ins ]                        ;
+            f = 2.0 * (1.0 + epsilon) * (nDeg / 2.0 / nS)                 ;
+            ina = deg' <= f                                               ;
+            ins' = prev v.^ins && not ina                                 ;
+            inst' = if f >= prev v.^ft then prev v.^ins else prev v.^inst ;
+            ft' = f `max` (prev v.^ft)
+        in DsRecord ins' inst' ft' deg'
+  in fregel ds_0 ds_t (Until (\g -> and [ not (val u.^ins) | u <- g])) g 
+
+{-
+ds' g =
+  let epsilon = 0.01                                                      ;
+      ds_0 v = DsRecord True True 0.0 0.0                                 ;
+      ds_t v prev curr =
+        let deg' = sum [ 1.0 | (e,u) <- is v, prev u.^ins ]               ;
+            nDeg = sum [ curr u.^deg | u <- gof v, prev u.^ins ]          ;
+            nS = sum [ 1.0 | u <- gof v, prev u.^ins ]                    ;
+            f = 2.0 * (1.0 + epsilon) * (nDeg / 2.0 / nS)                 ;
+            ina = deg' <= f                                               ;
+            ins' = prev v.^ins && not ina                                 ;
+            inst' = if f >= prev v.^ft then prev v.^ins else prev v.^inst ;
+            ft' = f `max` (prev v.^ft)
+        in DsRecord ins' inst' ft' deg'
+  in fregel ds_0 ds_t (Until (\g -> and [ not (val u.^ins) | u <- g])) g 
+-}
+
+ds01 g =
+  let epsilon = 0.1                                                       ;
+      ds_0 v = DsRecord True True 0.0 0.0                                 ;
+      ds_t v prev curr =
+        let deg' = sum [ 1.0 | (e,u) <- is v, prev u.^ins ]               ;
+            nDeg = sum [ curr u.^deg | u <- g, prev u.^ins ]              ;
+            nS = sum [ 1.0 | u <- g, prev u.^ins ]                        ;
+            f = 2.0 * (1.0 + epsilon) * (nDeg / 2.0 / nS)                 ;
+            ina = deg' <= f                                               ;
+            ins' = prev v.^ins && not ina                                 ;
+            inst' = if f >= prev v.^ft then prev v.^ins else prev v.^inst ;
+            ft' = f `max` (prev v.^ft)
+        in DsRecord ins' inst' ft' deg'
+  in fregel ds_0 ds_t (Until (\g -> and [ not (val u.^ins) | u <- g])) g 
+
+{-
+
+*Main> ds graph4
+[V 0 DsRecord {ins = False, inst = False, ft = 3.0300000000000002, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 1 DsRecord {ins = False, inst = False, ft = 3.0300000000000002, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 2 DsRecord {ins = False, inst = False, ft = 3.0300000000000002, deg = 1.0} [(1,v0), (1,v1), (1,v3)] [(1,v3), (1,v0), (1,v1)],
+ V 3 DsRecord {ins = False, inst = True, ft = 3.0300000000000002, deg = 3.0} [(1,v2), (1,v4), (1,v5), (1,v6)] [(1,v4), (1,v5), (1,v6), (1,v2)],
+ V 4 DsRecord {ins = False, inst = True, ft = 3.0300000000000002, deg = 3.0} [(1,v3), (1,v5), (1,v6)] [(1,v5), (1,v6), (1,v3)],
+ V 5 DsRecord {ins = False, inst = True, ft = 3.0300000000000002, deg = 3.0} [(1,v3), (1,v4), (1,v6), (1,v7)] [(1,v6), (1,v7), (1,v3), (1,v4)],
+ V 6 DsRecord {ins = False, inst = True, ft = 3.0300000000000002, deg = 3.0} [(1,v3), (1,v4), (1,v5)] [(1,v3), (1,v4), (1,v5)],
+ V 7 DsRecord {ins = False, inst = False, ft = 3.0300000000000002, deg = 1.0} [(1,v5)] [(1,v5)]]
+
+*Main> ds01 graph4
+[V 0 DsRecord {ins = False, inst = False, ft = 3.08, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 1 DsRecord {ins = False, inst = False, ft = 3.08, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 2 DsRecord {ins = False, inst = True, ft = 3.08, deg = 1.0} [(1,v0), (1,v1), (1,v3)] [(1,v3), (1,v0), (1,v1)],
+ V 3 DsRecord {ins = False, inst = True, ft = 3.08, deg = 0.0} [(1,v2), (1,v4), (1,v5), (1,v6)] [(1,v4), (1,v5), (1,v6), (1,v2)],
+ V 4 DsRecord {ins = False, inst = True, ft = 3.08, deg = 1.0} [(1,v3), (1,v5), (1,v6)] [(1,v5), (1,v6), (1,v3)],
+ V 5 DsRecord {ins = False, inst = True, ft = 3.08, deg = 1.0} [(1,v3), (1,v4), (1,v6), (1,v7)] [(1,v6), (1,v7), (1,v3), (1,v4)],
+ V 6 DsRecord {ins = False, inst = True, ft = 3.08, deg = 1.0} [(1,v3), (1,v4), (1,v5)] [(1,v3), (1,v4), (1,v5)],
+ V 7 DsRecord {ins = False, inst = False, ft = 3.08, deg = 0.0} [(1,v5)] [(1,v5)]]
+
+-}
+{- something wrong with NDSLtoPregel::
+  Main: NDSLtoPregel.hs:644:1-67: Non-exhaustive patterns in function hasAccessToCurr
+
+{- another densest subgraph on the basis of the greedy algorithm
+   presented in the ``denser than the densest'' paper. -}
+
+ds_dtd1 g =
+  let alpha = 1.0 / 3.0                                                   ;
+      ds_0 v = DsRecord True True (-9999.0) 0.0                           ;
+      ds_t v prev curr =
+        let deg' = sum [ 1.0 | (e,u) <- is v, prev u.^ins ]               ;
+            nDeg = sum [ curr u.^deg | u <- g, prev u.^ins ]              ;
+            (minDeg, minDegId) =
+               minimum [ (curr u.^deg, vid u) | u <- g, prev u.^ins ]     ;
+            nS = sum [ 1.0 | u <- g, prev u.^ins ]                        ;
+            f = nDeg / 2.0 - alpha * nS * (nS - 1.0) / 2.0                ;
+            ina = (vid v == minDegId)                                     ;
+            ins' = prev v.^ins && not ina                                 ;
+            inst' = if f >= prev v.^ft then prev v.^ins else prev v.^inst ;
+            ft' = f `max` (prev v.^ft)
+        in DsRecord ins' inst' ft' deg'
+  in fregel ds_0 ds_t (Until (\g -> and [ not (val u.^ins) | u <- g])) g 
+
+{-
+
+*Main> ds_dtd1 graph4
+[V 0 DsRecord {ins = False, inst = False, ft = 4.0, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 1 DsRecord {ins = False, inst = False, ft = 4.0, deg = 0.0} [(1,v2)] [(1,v2)],
+ V 2 DsRecord {ins = False, inst = False, ft = 4.0, deg = 0.0} [(1,v0), (1,v1), (1,v3)] [(1,v3), (1,v0), (1,v1)],
+ V 3 DsRecord {ins = False, inst = True, ft = 4.0, deg = 1.0} [(1,v2), (1,v4), (1,v5), (1,v6)] [(1,v4), (1,v5), (1,v6), (1,v2)],
+ V 4 DsRecord {ins = False, inst = True, ft = 4.0, deg = 1.0} [(1,v3), (1,v5), (1,v6)] [(1,v5), (1,v6), (1,v3)],
+ V 5 DsRecord {ins = False, inst = True, ft = 4.0, deg = 1.0} [(1,v3), (1,v4), (1,v6), (1,v7)] [(1,v6), (1,v7), (1,v3), (1,v4)],
+ V 6 DsRecord {ins = False, inst = True, ft = 4.0, deg = 0.0} [(1,v3), (1,v4), (1,v5)] [(1,v3), (1,v4), (1,v5)],
+ V 7 DsRecord {ins = False, inst = False, ft = 4.0, deg = 0.0} [(1,v5)] [(1,v5)]]
+
+
+{- Another densest subgraph on the basis of the local-search algorithm
+   presented in the ``denser than the densest'' paper.
+   This program is an ``increasing'' pattern, which means that, from a
+   singleton set of vertices, it repeatedly adds such a vertex that most
+   contributes to increasing the value of f(S). -}
+-}
+data DsDtdRecord =
+  DsDtdRecord { b :: Bool, inr :: Bool, ns :: Double, ndeg :: Double,
+                fs :: Double, alldeg :: Double, delta :: Double }
+  deriving (Eq, Show)
+
+ds_dtd2 g =
+  let alpha = 1.0 / 3.0                                                   ;
+      seed = 3                                                            ;
+      ds_0 v = DsDtdRecord True (vid v == seed) 1.0 0.0 (-9999.0) 0.0 0.0 ;
+      ds_t v prev curr =
+        let delta' = sum [ 1.0 | (e,u) <- is v, prev u.^inr ]             ;
+            alldeg' = sum [ 1.0 | (e,u) <- is v ]                         ;
+            (maxDelta, maxAllDeg, maxDeltaId) =
+               maximum [ (curr u.^delta, curr u.^alldeg, vid u) |
+                         u <- g, prev u.^inr == False ]                   ;
+            ns' = prev v.^ns + 1.0                                        ;
+            ndeg' = prev v.^ndeg + maxDelta                               ;
+            f = ndeg' - alpha * ns' * (ns' - 1.0) / 2.0                   ;
+            b' = f >= prev v.^fs                                          ;
+            inr' = if b' then prev v.^inr || vid v == maxDeltaId
+                         else prev v.^inr                                 ;
+            fs' = f `max` (prev v.^fs)
+        in DsDtdRecord b' inr' ns' ndeg' fs' alldeg' delta'
+  in fregel ds_0 ds_t (Until (\g -> not (or [ val u.^b | u <- g]))) g
+
+{-
+
+*Main> ds_dtd2 graph4
+[V 0 DsDtdRecord {b = False, inr = False, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 1.0, delta = 0.0} [(1,v2)] [(1,v2)],
+ V 1 DsDtdRecord {b = False, inr = False, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 1.0, delta = 0.0} [(1,v2)] [(1,v2)],
+ V 2 DsDtdRecord {b = False, inr = False, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 3.0, delta = 1.0} [(1,v0), (1,v1), (1,v3)] [(1,v3), (1,v0), (1,v1)],
+ V 3 DsDtdRecord {b = False, inr = True, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 4.0, delta = 3.0} [(1,v2), (1,v4), (1,v5), (1,v6)] [(1,v4), (1,v5), (1,v6), (1,v2)],
+ V 4 DsDtdRecord {b = False, inr = True, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 3.0, delta = 3.0} [(1,v3), (1,v5), (1,v6)] [(1,v5), (1,v6), (1,v3)],
+ V 5 DsDtdRecord {b = False, inr = True, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 4.0, delta = 3.0} [(1,v3), (1,v4), (1,v6), (1,v7)] [(1,v6), (1,v7), (1,v3), (1,v4)],
+ V 6 DsDtdRecord {b = False, inr = True, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 3.0, delta = 3.0} [(1,v3), (1,v4), (1,v5)] [(1,v3), (1,v4), (1,v5)],
+ V 7 DsDtdRecord {b = False, inr = False, ns = 5.0, ndeg = 7.0, fs = 4.0, alldeg = 1.0, delta = 1.0} [(1,v5)] [(1,v5)]]
+
+-}
+-}
+ sample-programs/gmaxv.fgl view
@@ -0,0 +1,7 @@+{- maximum value problem -}++data MVal = MVal { mval :: Int } deriving (Eq, Show)++gmaxv g =+  let step v = let newval = maximum [ val u | u <- g ] in MVal newval+  in gmap step g
+ sample-programs/graph4-pp.txt view
@@ -0,0 +1,8 @@+1	1 1 3 1+2	1 1 3 1+3	1 3 4 1 1 1 2 1+4	1 4 5 1 6 1 7 1 3 1+5	1 3 6 1 4 1 7 1+6	1 4 7 1 8 1 4 1 5 1+7	1 3 6 1 5 1 4 1+8	1 1 6 1
+ sample-programs/graph4.txt view
@@ -0,0 +1,8 @@+[1,1,[[3,1]]]+[2,1,[[3,1]]]+[3,1,[[4,1],[1,1],[2,1]]]+[4,1,[[5,1],[6,1],[7,1],[3,1]]]+[5,1,[[6,1],[4,1],[7,1]]]+[6,1,[[7,1],[8,1],[4,1],[5,1]]]+[7,1,[[6,1],[5,1],[4,1]]]+[8,1,[[6,1]]]
+ sample-programs/maxv.fgl view
@@ -0,0 +1,11 @@+{- maximum value problem -}++data MVal = MVal { mval :: Int } deriving (Eq, Show)++maxv g =+  let init v = MVal (val v)                                       ;+      step v prev curr =+        let newmval = prev v .^ mval `max`+                      maximum [ prev u .^ mval | (e, u) <- is v ] +        in MVal newmval+  in fregel init step Fix g
+ sample-programs/re.fgl view
@@ -0,0 +1,22 @@+{- reachability problems -}++data RVal = RVal { rch :: Bool } deriving (Eq, Show)++reAll g =+  let init v = RVal (vid v == 1) ;+      step v prev curr =+        let newrch = prev v .^ rch || or [ prev u .^ rch | (e,u) <- is v ]+        in RVal newrch+  in fregel init step Fix g++re3 g =+  let init v = RVal (vid v == 1) ;+      step v prev curr =+        let newrch = prev v .^ rch || or [ prev u .^ rch | (e,u) <- is v ]+        in RVal newrch+  in fregel init+            step+            (Until (\g -> sum [ 1 | u <- g, val u .^ rch ] > 3))+            g++
+ sample-programs/scc.fgl view
@@ -0,0 +1,22 @@+data MA = MA { minv :: Int, active :: Bool } deriving (Eq, Show) +data C = C { color :: Int } deriving (Eq, Show)+scc g =+  let f_init v = if val v .^ color < 0 then MA (vid v) True else MA (val v.^color) False               ;+      f_fw v prev curr = +        let c' = (prev v .^ minv) `min` minimum [ prev u.^minv | (e, u) <- is v, prev u .^ active ]+        in if prev v.^ active then MA c' (prev v.^active) else prev v                                 ;+      f_bw v prev curr = +        let c' = (prev v .^ minv) `min` minimum [ prev u.^minv | (e, u) <- rs v, prev u .^ active ]+        in if prev v .^ active then MA c' (prev v.^active) else prev v                                 ;+      fix_color v = if val v.^_fst.^minv == val v.^_snd.^minv then C (val v.^_fst.^minv) else C (-1) ;+      f0 v = val v ;+      sccInner g = +        let +            ga = gmap f_init g               ;  +            gf = fregel f0 f_fw Fix ga ;+            gb = fregel f0 f_bw Fix ga ;+            gfb = gzip gf gb                 ;+            g' = gmap fix_color gfb          +        in g'                                ;+      sccInner0 v = C (-1)+  in giter sccInner0 sccInner Fix g
+ sample-programs/sssp.fgl view
@@ -0,0 +1,11 @@+{- single-source shortest path problem -}++data SVal = SVal { dist :: Int } deriving (Eq, Show)++sssp g =+  let init v = SVal (if vid v == 1 then 0 else 100000)                ;+      step v prev curr =+        let newdist = prev v .^ dist `min`+                      minimum [ prev u .^ dist + e | (e, u) <- is v ] +        in SVal newdist+  in fregel init step Fix g
+ sample-programs/sssp2.fgl view
@@ -0,0 +1,7 @@+data SSSP = SSSP { dist :: Int, modified :: Bool} deriving (Eq, Show)+sssp2 g = +  let step v prev curr = let d = prev v .^ dist `min` minimum [ prev u .^ dist + e | (e, u) <- is v, prev u .^ modified] ;+                             m = prev v .^ dist != d+                         in SSSP d m  ;+      init v = SSSP (if vid v == 1 then 0 else 1000000) (vid v == 1) +  in fregel init step Fix g