Added clean with itasks configuration for linux x64

clean-classic-itasks_linux-x64/Gast/ESMSpec.dcl

+definition module ESMSpec
+
+import StdClass, StdMaybe
+import gast //gen
+
+::	Traces		   s i o :== [[SeenTrans s i o]]
+::	ESM            s i o =   { s_0 :: s					// the initial state
+							 , d_F :: Spec s i o		// the state transition function (\delta_F)
+							 , out :: s i -> [[o]]		// outputs to be used if spec does not give them
+							 , pred:: (SeenTrans s i o)->[[String]] // consitency issues
+							 }
+::	KnownAutomaton s i o =   {trans :: [SeenTrans s i o]
+							 ,issues:: [(SeenTrans s i o,[String])]
+							 }
+::	SeenTrans      s i o :== (s,i,[o],s)
+
+tupToSpec :: (state input -> [([output],state)]) -> Spec state input output // conversion for old specificaions
+
+class render a :: !a -> String		// show a concise text representation for rendering purposes
+
+enumerate		:: [a] | ggen{|*|} a
+
+possibleInputs	:: (ESM s i o) [s] -> [i] | gEq{|*|} s & ggen{|*|}, gEq{|*|} i
+nextStates		:: (ESM s i o) i ![s] -> [s] | gEq{|*|} s
+addStep			:: (ESM s i o) [s] i !(Traces s i o) -> Traces s i o | gEq{|*|} s
+narrowTraces	:: (Traces s i o) [s] -> Traces s i o | gEq{|*|} s
+
+nodesOf			:: !(KnownAutomaton s i o) -> [s] | gEq{|*|} s
+edgesFrom		:: s !(KnownAutomaton s i o) -> [SeenTrans s i o] | gEq{|*|} s
+edgesTo			:: s !(KnownAutomaton s i o) -> [SeenTrans s i o] | gEq{|*|} s
+
+startStates		:: ![SeenTrans s i o] -> [s] | gEq{|*|} s
+targetStates	:: ![SeenTrans s i o] -> [s] | gEq{|*|} s
+
+addTransitions :: !Int (ESM s i o) [s] [i] !(KnownAutomaton s i o) -> KnownAutomaton s i o | gEq{|*|}, render s & render, ggen{|*|}, gEq{|*|} i & gEq{|*|} o
+
+nrOf			:: !(KnownAutomaton s i o) s -> Int | gEq{|*|}, render s
+
+gisMember  :: a ![a] -> Bool | gEq{|*|} a
+gremoveDup :: !.[a] -> .[a] | gEq{|*|} a
+gelemIndex :: a ![a] -> Maybe Int | gEq{|*|} a

clean-classic-itasks_linux-x64/Gast/ESMSpec.icl

+implementation module ESMSpec
+
+import StdBool, StdFunc, StdList, StdListExtensions, StdMaybe, StdMisc, StdString, StdTuple
+import GenPrint, GenEq
+import gast
+
+tupToSpec :: (state input -> [([output],state)]) -> Spec state input output // conversion for old specificaions
+tupToSpec fun = \s i = [Pt o t \\ (o,t) <- fun s i]
+
+enumerate :: [a] | ggen{|*|} a
+enumerate = generateAll aStream
+
+possibleInputs :: (ESM s i o) [s] -> [i] | gEq{|*|} s & ggen{|*|}, gEq{|*|} i
+possibleInputs esm states = gremoveDup (take 100 [i \\ s<-states, i<-enumerate | not (isEmpty (esm.d_F s i))])
+
+nextStates :: (ESM s i o) i ![s] -> [s] | gEq{|*|} s
+nextStates esm i states
+	= gremoveDup	[ t
+				\\	s <- states
+				,	target <- esm.d_F s i
+				,	t <- case target of
+							Pt outs u = [u];
+							Ft f = [u \\ o<-esm.out s i, u<-f o]
+				]
+
+narrowTraces :: (Traces s i o) [s] -> Traces s i o | gEq{|*|} s
+narrowTraces trace states = fst (pruneTraces trace states)
+
+pruneTraces :: (Traces s i o) [s] -> (Traces s i o,[s]) | gEq{|*|} s
+pruneTraces [] states = ([],states)
+pruneTraces [trans:rest] states
+	# (rest ,states) = pruneTraces rest states
+	# trans = [tr\\tr=:(s,i,o,t)<-trans|gisMember t states]
+	= ([trans:rest],startStates trans)
+
+addStep :: (ESM s i o) [s] i !(Traces s i o) -> Traces s i o | gEq{|*|} s
+addStep esm states i trace
+	= 	narrowTraces trace states ++
+		[[	(s,i,o,t)
+		 \\ s <- states
+		 ,	target <- esm.d_F s i
+		 , (o,t) <- case target of
+						Pt outs u = [(outs,u)];
+						Ft f = [ (o,u) \\ o<-esm.out s i, u<-f o]
+		]]
+
+nodesOf :: !(KnownAutomaton s i o) -> [s] | gEq{|*|} s
+//nodesOf automaton				= gremoveDup (flatten [[startnode,endnode] \\ (startnode,_,_,endnode) <- automaton.trans])
+nodesOf automaton				= gremoveDup ([s \\ (s,_,_,t) <- automaton.trans]++[t \\ (s,_,_,t) <- automaton.trans])
+
+edgesFrom :: s !(KnownAutomaton s i o) -> [SeenTrans s i o] | gEq{|*|} s
+edgesFrom startnode automaton	= [edge \\ edge=:(s,i,o,t) <- automaton.trans | s===startnode]
+
+edgesTo :: s !(KnownAutomaton s i o) -> [SeenTrans s i o] | gEq{|*|} s
+edgesTo endnode automaton		= [edge \\ edge=:(s,i,o,t) <- automaton.trans | t===endnode]
+
+startStates :: ![SeenTrans s i o] -> [s] | gEq{|*|} s
+startStates transitions			= gremoveDup [ s \\ (s,i,o,t) <- transitions ]
+
+targetStates :: ![SeenTrans s i o] -> [s] | gEq{|*|} s
+targetStates transitions		= gremoveDup [ t \\ (s,i,o,t) <- transitions ]
+
+addTransitions :: !Int (ESM s i o) [s] [i] !(KnownAutomaton s i o) -> KnownAutomaton s i o | gEq{|*|}, render s & render, ggen{|*|}, gEq{|*|} i & gEq{|*|} o
+addTransitions n esm startstates is automaton
+	| n>0 && not (isEmpty startstates)
+		# newSeenTrans
+			=	[	(s,i,o,t)
+				\\	s <- startstates
+				,	i <- map snd (sortBy (\(a,_) (b,_).a<b) (map (\i.(render i,i)) is)) // is // sort inputs
+				,	target <- esm.d_F s i
+				,	(o,t) <- case target of
+								Pt outs u = [(outs,u)];
+								Ft f = [ (o,u) \\ o<-esm.out s i, u<-f o]
+				]
+		# newStates	= targetStates newSeenTrans
+		# newTrans	= [t \\ t <- newSeenTrans | not (gisMember t automaton.trans)]
+		# newIssues	= [(t,e) \\ t<-newTrans, e <- esm.pred t | not (isEmpty e)]
+		= addTransitions (n-1) esm newStates (possibleInputs esm newStates) {trans=mix automaton.trans newTrans, issues=newIssues++automaton.issues}
+	| otherwise		= automaton
+
+mix :: [SeenTrans s i o] [SeenTrans s i o] -> [SeenTrans s i o] | render s & render i
+mix known new = foldl (insertBy less) known new
+
+insertBy :: (a a->Bool) [a] a -> [a]
+insertBy le [] e = [e]
+insertBy le l=:[a:x] e
+	| le e a
+		= [e:l]
+		= [a:insertBy le x e]
+
+less :: (SeenTrans s i o) (SeenTrans s i o) -> Bool | render s & render i
+less (s1,i1,o1,t1) (s2,i2,o2,t2)
+	# rs1 = render s1
+	# rs2 = render s2
+	# ro1 = render i1
+	# ro2 = render i2
+	# rt1 = render t1
+	# rt2 = render t2
+	= rs1<rs2 || (rs1==rs2 && (ro1<ro2 || (ro1==ro2 && rt1<=rt2)))
+
+nrOf :: !(KnownAutomaton s i o) s -> Int | gEq{|*|}, render s
+nrOf automaton s
+	= case gelemIndex s (nodesOf automaton) of
+		Just i					= i
+		nothing					= abort ("nrOf applied to unknown state: "+++render s+++"\n")
+
+gisMember :: a ![a] -> Bool | gEq{|*|} a
+gisMember x [hd:tl] = hd===x || gisMember x tl
+gisMember _ _       = False
+
+gremoveDup :: !.[a] -> .[a] | gEq{|*|} a
+gremoveDup [x:xs] = [x:gremoveDup (filter ((=!=) x) xs)]
+gremoveDup _      = []
+
+gelemIndex :: a ![a] -> Maybe Int | gEq{|*|} a
+gelemIndex x l = scan 0 x l
+where
+	scan i x [a:r]
+		| x===a	= Just i
+				= scan (i+1) x r
+	scan i x _ = Nothing
+

clean-classic-itasks_linux-x64/Gast/Graphviz.dcl

+// Péter Diviánszky, 2007
+// Code extended and adapted by Peter Achten, 2007
+
+definition module Graphviz
+
+//from   StdOverloaded import class ==, class toString
+from   StdOverloaded import class toString
+import StdMaybe
+import ESMSpec
+import GenEq
+
+// A digraph contains a title and a list of node definitions
+:: Digraph 
+    = Digraph String [GraphAttribute] [NodeDef] (Maybe SelectedItem)
+:: SelectedItem
+	= Node Int
+
+digraphTitle		:: !Digraph -> String
+digraphAtts			:: !Digraph -> [GraphAttribute]
+digraphNodes		:: !Digraph -> [NodeDef]
+digraphSelectedItem	:: !Digraph -> Maybe SelectedItem
+
+// A node definition contains a unique identifier (an integer), a list of node attributes and a list of edge definitions.
+// An edge definition contains an identifier (the id of the end node and edge attributes).
+:: NodeDef 
+    = NodeDef !Int ![NodeState] ![NodeAttribute] [EdgeDef]
+:: EdgeDef
+    :== (!Int,![EdgeAttribute])
+:: NodeState
+	= NStAllEdgesFound !Bool		// all edges of this node are known
+
+// Convert digraph into list of strings.
+// The strings are lines of the graphviz representation of the graph.
+printDigraph :: !Digraph -> [String]
+
+:: GraphAttribute
+	= GAtt_Damping        Real
+	| GAtt_K              Real
+	| GAtt_URL            String
+	| GAtt_bb             Rect
+	| GAtt_bgcolor        Color
+	| GAtt_center         Bool
+	| GAtt_charset        String
+	| GAtt_clusterrank    ClusterMode
+	| GAtt_colorscheme    String
+	| GAtt_comment        String
+	| GAtt_compound       Bool
+	| GAtt_concentrate    Bool
+	| GAtt_defaultdist    Real
+	| GAtt_dim            Int
+//	| GAtt_diredgeconstraints ... PA: ignored, neato only
+	| GAtt_dpi            Real
+	| GAtt_epsilon        Real
+	| GAtt_esep           Real
+	| GAtt_fontcolor      Color
+	| GAtt_fontname       String
+	| GAtt_fontnames      String
+	| GAtt_fontpath       String
+	| GAtt_fontsize       Real
+	| GAtt_label          String
+	| GAtt_labeljust      String
+	| GAtt_labelloc       String
+	| GAtt_landscape      Bool
+	| GAtt_layers         LayerList
+	| GAtt_layersep       String
+	| GAtt_levelsgap      Real
+	| GAtt_lp             DotPoint
+	| GAtt_margin         Margin
+	| GAtt_maxiter        Int
+	| GAtt_mclimit        Real
+	| GAtt_mindist        Real
+	| GAtt_mode           String
+	| GAtt_model          String
+	| GAtt_mosek          Bool
+	| GAtt_nodesep        Real
+	| GAtt_nojustify      Bool
+	| GAtt_normalize      Bool
+	| GAtt_nslimit        Real
+	| GAtt_nslimit1       Real
+	| GAtt_ordering       String
+	| GAtt_orientation    String
+	| GAtt_outputorder    OutputMode
+	| GAtt_pad            Pad
+	| GAtt_page           Pointf
+	| GAtt_pagedir        PageDir
+	| GAtt_quantum        Real
+	| GAtt_rank           RankType
+	| GAtt_rankdir        RankDir
+	| GAtt_ranksep        Real
+	| GAtt_ratio          Ratio
+	| GAtt_remincross     Bool
+	| GAtt_resolution     Real
+	| GAtt_root           String
+	| GAtt_rotate         Int
+	| GAtt_searchsize     Int
+	| GAtt_showboxes      Int
+	| GAtt_size           Sizef //Pointf		// PA++
+//	| GAtt_splines        PA: skipped for the time being
+	| GAtt_start          StartType
+	| GAtt_stylesheet     String
+	| GAtt_target         String
+	| GAtt_truecolor      Bool
+	| GAtt_viewport       ViewPort
+	| GAtt_voro_margin    Real
+:: NodeAttribute
+    = NAtt_URL            String
+    | NAtt_color          Color
+    | NAtt_colorscheme    String
+    | NAtt_comment        String
+    | NAtt_distortion     Real
+    | NAtt_fillcolor      Color
+    | NAtt_fixedsize      Bool
+    | NAtt_fontcolor      Color
+    | NAtt_fontname       String
+    | NAtt_fontsize       Real
+    | NAtt_group          String
+    | NAtt_height         Real
+    | NAtt_label          String
+    | NAtt_layer          LayerRange
+    | NAtt_margin         Margin
+    | NAtt_nojustify      Bool
+    | NAtt_orientation    Real
+    | NAtt_peripheries    Int
+    | NAtt_pin            Bool
+//  | NAtt_pos ...        PA: ignored for the time being
+    | NAtt_rects          Rect
+    | NAtt_regular        Bool
+    | NAtt_samplepoints   Int
+    | NAtt_shape          NodeShape
+    | NAtt_shapefile      String
+    | NAtt_showboxes      Int
+    | NAtt_sides          Int
+    | NAtt_skew           Real
+    | NAtt_style          NodeStyle
+    | NAtt_target         String
+    | NAtt_tooltip        String
+    | NAtt_width          Real
+    | NAtt_z              Real
+:: EdgeAttribute
+    = EAtt_URL            String
+    | EAtt_arrowhead      ArrowType
+    | EAtt_arrowsize      Real
+    | EAtt_arrowtail      ArrowType
+    | EAtt_color          Color
+    | EAtt_colorscheme    String
+    | EAtt_comment        String
+    | EAtt_constraint     Bool
+    | EAtt_decorate       Bool
+    | EAtt_dir            DirType
+    | EAtt_edgeURL        String
+    | EAtt_edgehref       String
+    | EAtt_edgetarget     String
+    | EAtt_edgetooltip    String
+    | EAtt_fontcolor      Color
+    | EAtt_fontname       String
+    | EAtt_fontsize       Real
+    | EAtt_headURL        String
+    | EAtt_headclip       Bool
+    | EAtt_headhref       String
+    | EAtt_headlabel      String
+    | EAtt_headport       PortPos
+    | EAtt_headtarget     String
+    | EAtt_headtooltip    String
+    | EAtt_href           String
+    | EAtt_label          String
+    | EAtt_labelURL       String
+    | EAtt_labelangle     Real
+    | EAtt_labeldistance  Real
+    | EAtt_labelfloat     Bool
+    | EAtt_labelfontcolor Color
+    | EAtt_labelfontname  String
+    | EAtt_labelfontsize  Real
+    | EAtt_labelhref      String
+    | EAtt_labeltarget    String
+    | EAtt_labeltooltip   String
+    | EAtt_layer          LayerRange
+    | EAtt_len            Real
+    | EAtt_lhead          String
+    | EAtt_lp             DotPoint
+    | EAtt_ltail          String
+    | EAtt_minlen         Int
+    | EAtt_nojustify      Bool
+//  | EAtt_pos			PA: ignored for the time being
+	| EAtt_samehead       String
+	| EAtt_sametail       String
+	| EAtt_showboxes      Int
+	| EAtt_style          EdgeStyle
+	| EAtt_tailURL        String
+	| EAtt_tailclip       Bool
+	| EAtt_tailhref       String
+	| EAtt_taillabel      String
+	| EAtt_tailport       PortPos
+	| EAtt_tailtarget     String
+	| EAtt_tailtooltip    String
+	| EAtt_target         String
+	| EAtt_tooltip        String
+	| EAtt_weight         Real
+:: ClusterMode
+	= CM_local | CM_global | CM_none
+:: CompassPoint
+	= CP_n | CP_ne | CP_e | CP_se | CP_s | CP_sw | CP_w | CP_nw
+:: DotPoint
+	= DotPoint Real Real Bool
+:: LayerId
+    = LayerAll
+    | LayerNr   Int
+    | LayerName String
+:: LayerList
+	= LayerList [String]
+:: LayerRange
+    = LayerRange LayerId [LayerId]
+:: Margin
+    = SingleMargin Real
+    | DoubleMargin Real Real
+:: OutputMode
+	= OM_breadthfirst | OM_nodesfirst | OM_edgesfirst
+:: Pad
+	= SinglePad Real
+	| DoublePad Real Real
+:: PageDir
+	= PD_BL | PD_BR | PD_TL | PD_TR | PD_RB | PD_RT | PD_LB | PD_LT
+:: Pointf
+	= Pointf Real Real
+:: PortPos				// PA: for now only compass points are supported
+	:== CompassPoint
+:: RankDir
+	= RD_TB | RD_LR | RD_BT | RD_RL
+:: RankType
+	= RT_same | RT_min | RT_source | RT_max | RT_sink
+:: Ratio
+	= AspectRatio Real
+	| R_fill
+	| R_compress
+	| R_expand
+	| R_auto
+:: Rect
+    = {llx :: Int,lly :: Int, urx :: Int, ury :: Int}
+:: Sizef		// PA++
+	= Sizef Real Real Bool
+:: StartStyle
+	= SS_regular | SS_self | SS_random
+:: StartType
+	= { startStyle :: Maybe StartStyle
+	  , startSeed  :: Maybe Int
+	  }
+:: ViewPort
+	= { vp_W       :: Real
+	  , vp_H       :: Real
+	  , vp_Z       :: Maybe Real
+	  , vp_xy      :: Maybe Pointf
+	  }
+
+pointNode           :: [NodeAttribute] // attributes of a point-shaped node
+hiddenNode          :: [NodeAttribute] // attributes of a hidden node
+
+
+:: NodeShape 
+    = NShape_box
+    | NShape_circle 
+    | NShape_diamond
+    | NShape_doublecircle
+    | NShape_doubleoctagon
+    | NShape_egg
+    | NShape_ellipse 
+    | NShape_hexagon
+    | NShape_house
+    | NShape_invtriangle
+    | NShape_invtrapezium
+    | NShape_invhouse
+    | NShape_octagon
+    | NShape_Mdiamond
+    | NShape_Msquare
+    | NShape_Mcircle
+    | NShape_parallelogram 
+    | NShape_pentagon
+    | NShape_plainText
+    | NShape_polygon
+    | NShape_point 
+    | NShape_rect
+    | NShape_rectangle
+    | NShape_septagon
+    | NShape_trapezium
+    | NShape_triangle
+    | NShape_tripleoctagon
+    | NShape_none
+instance toString NodeShape
+instance ==       NodeShape
+derive gEq NodeShape // PK++
+
+::  NodeStyle
+    = NStyle_filled
+    | NStyle_invis
+    | NStyle_diagonals
+    | NStyle_rounded
+    | NStyle_dashed
+    | NStyle_dotted
+    | NStyle_solid
+    | NStyle_bold
+instance toString NodeStyle
+instance ==       NodeStyle
+derive gEq NodeStyle // PK++
+
+:: EdgeStyle 
+    = EStyle_solid 
+    | EStyle_bold
+    | EStyle_dashed
+    | EStyle_dotted
+    | EStyle_invis
+instance toString EdgeStyle
+instance ==       EdgeStyle
+derive gEq EdgeStyle // PK++
+
+:: Color 
+    = RGB   Int  Int  Int
+    | HSV   Real Real Real
+    | Color String          // X11 1.2 color names; see rgb.txt
+
+C_black   :== Color "black"
+C_white   :== Color "white"
+C_gray    :== Color "gray"
+C_red     :== Color "red"
+C_green   :== Color "green"
+C_blue    :== Color "blue"
+C_yellow  :== Color "yellow"
+
+instance toString Color
+instance ==       Color
+derive gEq Color // PK++
+
+:: ArrowType =
+    { closest       :: Arrow
+    , furthest      :: Maybe Arrow
+    }
+:: Arrow =
+    { open          :: Bool
+    , side          :: Maybe Side
+    , shape         :: ArrowShape
+    }
+:: Side
+    = Side_l
+    | Side_r
+:: ArrowShape
+    = AShape_box
+    | AShape_crow
+    | AShape_diamond
+    | AShape_dot
+    | AShape_inv
+    | AShape_none
+    | AShape_normal
+    | AShape_tee
+    | AShape_vee
+instance toString ArrowType
+instance ==       ArrowType
+derive gEq ArrowType // PK++
+
+
+// direction of the edge
+:: DirType
+    = DT_forward 
+    | DT_back 
+    | DT_both 
+    | DT_none
+instance toString DirType
+instance ==       DirType
+derive gEq DirType // PK++
+
+layersep :== ":\t"
+
+mkDigraph :: String (KnownAutomaton s i o,s,[s],[s],[SeenTrans s i o],[SeenTrans s i o]) -> Digraph | render, gEq{|*|} s 
+																									& render, gEq{|*|} i 
+																									& render, gEq{|*|} o

clean-classic-itasks_linux-x64/Gast/Graphviz.icl

+// Péter Diviánszky, 2007
+// Code extended and adapted for using generics by Peter Achten, 2007
+
+implementation module Graphviz
+
+import StdArray, StdOverloaded, StdList, StdOrdList, StdTuple, StdString, StdBool, StdMisc
+import StdMaybe, StdListExtensions
+import GenLib
+import ESMSpec
+
+derive gEq    EdgeStyle, NodeStyle, DirType, NodeShape, Side, ArrowShape, Maybe, ArrowType, Arrow, Color
+derive gPrint EdgeStyle, NodeStyle, DirType, NodeShape, Side, ArrowShape, Maybe, CompassPoint, StartStyle,
+              ClusterMode, OutputMode, PageDir, RankDir, RankType
+derive printNameValuePair GraphAttribute, NodeAttribute, EdgeAttribute
+
+//	Almost regular toString instances:
+instance toString EdgeStyle      where toString es  =  /*quote*/ (skipXXX_InConstructorName (printToString es))
+instance toString NodeStyle      where toString ns  = quote (skipXXX_InConstructorName (printToString ns))