organized!

gen0_virtuous_cycle/app/Main.hs

 module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+   putStrLn "mAiN1!"

gen0_virtuous_cycle/app/TC0.hs

+module TC0 where
+
+main = do putStrLn "This should work"
+{-
+import PSLex
+
+import Control.Exception --  TODO: better Error Handling, not just crashing, with messages, you know...
+import Control.Monad
+--import Control.Monad.State
+import Control.Applicative
+import Data.Maybe
+
+-- $> 1 + 4
+
+lookUpDef :: String -> MachineMyState (Maybe [ExpType])
+lookUpDef name = StateAlt $ \(w,s,p) -> Just $ (lookup name w, (w,s,p))
+
+-- missing according to https://www.adobe.com/jp/print/postscript/pdfs/PLRM.pdf : p.34
+-- fontID, real, gMyState, packedarray, TODO
+data BaseType -- << store constaints, such as <4, %2 = 0, length of String, etc
+  = StringType (Maybe String)
+  | FloatType (Maybe Float)
+  | IntType (Maybe Int)
+  | BoolType | T | F
+  | NameType (Maybe String)
+  | Mark | FooBar -- ] <- this is a function, but i don't know how to type it yet TODO
+  | Array -- of Stuff TODO
+  | Dict  -- of Stuff TODO
+  | File
+  | Save
+  | Operator -- {1 2 add} bind 2 get /add load eq % true (if “add” has not been redefined) p.33 "Thinking in PostScript"
+  | V Int -- Type Variable, not technically part of the PS Language...?
+  | B -- Bottom of Stack
+  | Null
+    deriving (Show,Eq)
+le T BoolType = True
+le F BoolType = True
+le (IntType (Just _)) (IntType Nothing) = True
+le (FloatType (Just _)) (FloatType Nothing) = True
+le (StringType (Just _)) (StringType Nothing) = True
+le a b = a == b
+
+
+data ExpType -- GOAL: no "unsigned" Types
+  = I --Identity, == ^0
+  | E String--Error no Error handling -> no E^-1
+  | BaseType :^ Int --exp
+  | ExpType :+ ExpType --not used yet
+  | Code [ExpType] Int -- Problem, code can be negative, like in forall. This would be nice to merge with :^ :(
+  | WordType (Maybe String)
+  | SideEffect (MachineMyState ())
+    deriving (Show, Eq)
+
+token2Type :: Token -> ExpType
+token2Type (Block tokens) = Code (token2Type <$> tokens) 1
+token2Type OpenArray = Mark :^ 1
+token2Type CloseArray = E "closing Arrays not yet implemented :( TODO"
+token2Type (PSInt i) = (IntType (Just i)):^1
+token2Type (PSFloat f) = FloatType (Just f):^1
+token2Type (Comment _) = I
+token2Type (PSString s) = StringType (Just s) :^1
+token2Type (Name n) = NameType (Just n) :^1
+token2Type (Unknown u) = WordType (Just u) -- :^1
+token2Type x           = error $ "unknown thing: " ++ (show x)
+-- | otherwise = error "havent implemented dict, IDEA: just init dictionarry, don't hardcode buildins? dictionarry
+
+-- TODO: all Vars are the same, fix with some kind of monad later...
+-- Offsetting? Start with 0, then allways add the current offsett?
+
+-- I was annoyed that :^-1 wasn't parsed correctly
+(^-) :: BaseType -> Int  -> ExpType
+(^-) b n = b :^ (-n)
+
+(^+) :: BaseType -> Int  -> ExpType
+(^+) b n = b :^ n
+
+-- Just make this a QC test, plz!!!!!
+--   not Checked     This is Checked
+--no Block[] be4, only Block[] after
+parseBlocks :: [Token] -> [Token]
+parseBlocks t = let (parsed, unparsed) = f False [] t in
+                if (unparsed == []) then (assert (not (OpenBlock `elem` parsed || (CloseBlock `elem` parsed))) parsed) else error "unbalanced! closed but not opend!"
+        where
+  f :: Bool -> [Token] -> [Token] -> ([Token],[Token])
+  f True parsed [] = error "unbalanced: code block doesn't close"
+  f False parsed [] = (parsed, [])
+  f _ parsed (CloseBlock:rest) = (parsed,rest)
+  f inOpenBlock parsed (OpenBlock:ts) = let  (current, next) = f True [] ts     in  
+                                 f inOpenBlock (parsed ++ [Block current]) next
+  f inOpenBlock parsed (t:tokens) = f inOpenBlock (parsed ++ [t])  tokens
+
+
+diagram = do
+  s <- readFile "output.ps"
+  let program = token2Type <$> parseBlocks (alexScanTokens s)
+  pure program
+
+mainloop :: (Maybe (String, (Words,[ExpType],[ExpType]) )) -> IO ()
+mainloop input =
+  --let n = max 1 (read ('0':l)) :: Int)
+  -- next_state <- (nTimes 1 ((>>) step) step (words,stack,program))
+  case input of
+    Just (info, state@(w,s,p)) -> do
+                          putStrLn info
+                          putStrLn $ "defs: " ++ (show $ take 3 w)
+                          putStrLn $ show (reverse s) ++ "||" ++ (take 100 $ show p)
+                          l <- getLine
+                          mainloop $ step state
+    Nothing -> do putStrLn "no next State"
+
+main = do
+  s <- readFile "../output.ps"
+  let program = token2Type <$> parseBlocks (alexScanTokens s)
+  mainloop (Just ("Starting Eval",(buildins,[],program)))
+
+  --l <- getLine
+  --let n = (read l) :: Int
+  --putStrLn $ show $ typecheck $ token2Type <$> (take 15 $ alexScanTokens s)
+
+
+-- utils
+nTimes :: Int -> (a -> a) -> (a -> a)
+nTimes 0 _ = id
+nTimes n f = f . nTimes (n-1) f
+
+
+type Words = [(String, [ExpType])]
+type MachineMyState a = StateAlt (Words,[ExpType],[ExpType]) a
+
+-- type MachineMyStatePlus a = Maybe ()
+{-
+pushProgram :: [ExpType] -> MachineMyState ()
+pushProgram code = MyState $ \(w,s,program) -> ((), (w,s, code ++ program))
+
+pushStack :: [ExpType] -> MachineMyState ()
+pushStack elems = MyState $ \(w,s,program) -> ((), (w,elems ++s,  program))
+
+popProgramm :: MachineMyState ExpType
+popProgramm = MyState $ \(w,s,p:program) -> (p, (w,s,program))
+
+nextProgram = MyState $ \(w,s,p:program) -> (p, (w,s,p:program))
+-}
+
+step = runState (show <$> identity
+             <|> show <$> definition
+             <|> show <$> err
+             <|> show <$> pushBaseType
+             <|> show <$> popBaseType
+             <|> show <$> action
+             <|> show <$> code
+ )
+
+put x = Just ((),x)
+
+identity :: MachineMyState ()
+identity = StateAlt f where
+  f (w,I:s,p) = put (w,s,p)
+  f (w,s,I:p) = put (w,s,p)
+  f (w,_:^0:s,p) = put (w,s,p)
+  f (w,s,_:^0:p) = put (w,s,p)
+  f _         = Nothing
+
+err :: MachineMyState (Maybe String)
+err = StateAlt f where
+  f (w, ((E msg):s), p) = Just $ (  (Just msg),    (w,    (E msg):s  , p))
+  f (w, s, ((E msg):p)) = Just $ (  (Just msg),    (w, s, (E msg):p     ))
+  f _ = Nothing
+
+--defs auf dem Stack macht nicht wirklich Sinn -> wird nicht gecheckt
+definition :: MachineMyState ()
+definition = StateAlt f where
+  f (w,s,(WordType (Just x)) :p) = case (lookup x w) of
+                                        Nothing -> put (w,s,(E ("unknown word: " ++ x)):p)
+                                        Just d  -> put (w,s, d ++ p)
+  f _ = Nothing
+
+pushBaseType :: MachineMyState ()
+pushBaseType = StateAlt f where
+  f (w,s, (b:^n):p)
+   | n > 0 = put (w,(b:^n):s,p)
+  f _ = Nothing
+
+popBaseType :: MachineMyState ()
+popBaseType = StateAlt f where
+  f (w,[],(b:^n):p)
+   | n < 0 = put (w,[b:^n],p)
+  f (w,(top:^m:stack),(b:^n):p)
+   | n < 0 && m > 0  = put (w,stack,b:^(n+m):p) --Here lies the Problem TODO correct simplification, which doesn't forget info about Ints and Bools
+   | n < 0 && m < 0  = put (w,top:^(m+n):stack,p) --TODO correct simplification, i.E require 1 -> only eat if 1 on the stack
+  f _ = Nothing
+
+code :: MachineMyState ()
+code = StateAlt f where
+  f (w,s,(Code x n):p) = put (w,(Code x n):s,p)
+  f _ = Nothing
+
+action :: MachineMyState ()
+action = StateAlt f where
+  f (w,s, (SideEffect g):p) = runState g (w,s,p)
+  f _ = Nothing
+
+-- do i really need the () return? do i ever extract infos from State?
+def_action :: MachineMyState ()
+def_action = StateAlt f where
+  --definition only workds, with Singleton on TOP TODO!!; cut away / at beginning
+  f (w,x:((NameType (Just name)):^1 :s),p) = case x of
+                                             Code c 1 -> put ((tail name,c):w,x:((NameType (Just name)):^1 :s),p) -- code blocks will be autoimatically executed, if the defined name is called
+                                             _        -> put ((tail name,[x]):w,x:((NameType (Just name)):^1 :s),p)
+  f _ = Nothing
+buildins :: Words
+buildins = [
+   ("save", [Save :^ 1])
+ , ("dict", [(IntType Nothing) ^-1, Dict :^1])
+ , ("def",  [SideEffect def_action, V 0 ^-1, (NameType Nothing) ^-1 ]) -- << ExpTye Sideeffect: put some kind of monadic action here. in the step function, it is no longer known, that the function def was called (instead of pop.pop) CONTINUE
+ , ("begin",[Dict ^-1]) -- << TODO: DictStack
+ ]
+
+data StateAlt s a = StateAlt (s -> Maybe (a,s))
+instance Functor (StateAlt s) where
+  fmap f (StateAlt st) = StateAlt $ \s -> case (st s) of 
+                                               Nothing -> Nothing
+                                               (Just (a,s')) -> Just (f a,s')
+instance Applicative (StateAlt s) where
+  pure x = StateAlt $ \s -> Just (x,s)
+  (<*>) (StateAlt f) (StateAlt a) = StateAlt $ \s -> case f s of                               -- << Not very clean code
+                                                     Nothing -> Nothing
+                                                     (Just (f_val,s')) -> case (a s') of
+                                                                          Nothing -> Nothing
+                                                                          (Just (a_val,s'')) -> Just (f_val a_val, s'')
+instance Monad (StateAlt s) where
+ (>>=) (StateAlt a) a2b = StateAlt $ \s -> case (a s) of
+                                           Nothing -> Nothing
+                                           Just (a_val,s') -> let (StateAlt b_f) = (a2b a_val) in
+                                                                   b_f s'
+instance Alternative (StateAlt s) where
+  (<|>) (StateAlt x) (StateAlt y) = StateAlt $ \s-> (x s) <|> (y s)
+  empty = StateAlt $ \s -> Nothing
+instance Show (StateAlt s a) where
+  show _ = "some Sideffect"
+instance Eq (StateAlt s a) where
+ (==) _ _ = undefined -- TRAP!
+
+runState (StateAlt s) x = s x
+data MyState s a = MyState (s -> (a,s))
+instance Functor (MyState s) where
+  fmap f (MyState st) = MyState $ \s -> let (a,s') = (st s) in (f a, s')
+instance Applicative (MyState s) where
+  pure x = MyState $ \s -> (x,s)
+--(<*>) :: MyState s (a -> b) -> MyState s a -> MyState s b
+  (<*>) (MyState f) (MyState a) = MyState $ \s -> let (a_val, s') = (a s)
+                                                      (f_a_b, s'') = (f s')
+                                                   in (f_a_b a_val, s)
+instance Monad (MyState s) where
+  (>>=) (MyState a) a_s_of_b = MyState $ \s -> let (a_val, s') = (a s)
+                                                   (MyState b_MyState) = (a_s_of_b a_val)
+                                               in  (b_MyState s')
+
+-}

gen0_virtuous_cycle/app/output.ps

-%!PS-Adobe-3.0
-%%Creator: graphviz version 2.49.3 (0)
-%%Title: G
-%%Pages: (atend)
-%%BoundingBox: (atend)
-%%EndComments
-save
-%%BeginProlog
-/DotDict 200 dict def
-DotDict begin
-
-/setupLatin1 {
-mark
-/EncodingVector 256 array def
- EncodingVector 0
-
-ISOLatin1Encoding 0 255 getinterval putinterval
-EncodingVector 45 /hyphen put
-
-% Set up ISO Latin 1 character encoding
-/starnetISO {
-        dup dup findfont dup length dict begin
-        { 1 index /FID ne { def }{ pop pop } ifelse
-        } forall
-        /Encoding EncodingVector def
-        currentdict end definefont
-} def
-/Times-Roman starnetISO def
-/Times-Italic starnetISO def
-/Times-Bold starnetISO def
-/Times-BoldItalic starnetISO def
-/Helvetica starnetISO def
-/Helvetica-Oblique starnetISO def
-/Helvetica-Bold starnetISO def
-/Helvetica-BoldOblique starnetISO def
-/Courier starnetISO def
-/Courier-Oblique starnetISO def
-/Courier-Bold starnetISO def
-/Courier-BoldOblique starnetISO def
-cleartomark
-} bind def
-
-%%BeginResource: procset graphviz 0 0
-/coord-font-family /Times-Roman def
-/default-font-family /Times-Roman def
-/coordfont coord-font-family findfont 8 scalefont def
-
-/InvScaleFactor 1.0 def
-/set_scale {
-       dup 1 exch div /InvScaleFactor exch def
-       scale
-} bind def
-
-% styles
-/solid { [] 0 setdash } bind def
-/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
-/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
-/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
-/bold { 2 setlinewidth } bind def
-/filled { } bind def
-/unfilled { } bind def
-/rounded { } bind def
-/diagonals { } bind def
-/tapered { } bind def
-
-% hooks for setting color 
-/nodecolor { sethsbcolor } bind def
-/edgecolor { sethsbcolor } bind def
-/graphcolor { sethsbcolor } bind def
-/nopcolor {pop pop pop} bind def
-
-/beginpage {	% i j npages
-	/npages exch def
-	/j exch def
-	/i exch def
-	/str 10 string def
-	npages 1 gt {
-		gsave
-			coordfont setfont
-			0 0 moveto
-			(\() show i str cvs show (,) show j str cvs show (\)) show
-		grestore
-	} if
-} bind def
-
-/set_font {
-	findfont exch
-	scalefont setfont
-} def
-
-% draw text fitted to its expected width
-/alignedtext {			% width text
-	/text exch def
-	/width exch def
-	gsave
-		width 0 gt {
-			[] 0 setdash
-			text stringwidth pop width exch sub text length div 0 text ashow
-		} if
-	grestore
-} def
-
-/boxprim {				% xcorner ycorner xsize ysize
-		4 2 roll
-		moveto
-		2 copy
-		exch 0 rlineto
-		0 exch rlineto
-		pop neg 0 rlineto
-		closepath
-} bind def
-
-/ellipse_path {
-	/ry exch def
-	/rx exch def
-	/y exch def
-	/x exch def
-	matrix currentmatrix
-	newpath
-	x y translate
-	rx ry scale
-	0 0 1 0 360 arc
-	setmatrix
-} bind def
-
-/endpage { showpage } bind def
-/showpage { } def
-
-/layercolorseq
-	[	% layer color sequence - darkest to lightest
-		[0 0 0]
-		[.2 .8 .8]
-		[.4 .8 .8]
-		[.6 .8 .8]
-		[.8 .8 .8]
-	]
-def
-
-/layerlen layercolorseq length def
-
-/setlayer {/maxlayer exch def /curlayer exch def
-	layercolorseq curlayer 1 sub layerlen mod get
-	aload pop sethsbcolor
-	/nodecolor {nopcolor} def
-	/edgecolor {nopcolor} def
-	/graphcolor {nopcolor} def
-} bind def
-
-/onlayer { curlayer ne {invis} if } def
-
-/onlayers {
-	/myupper exch def
-	/mylower exch def
-	curlayer mylower lt
-	curlayer myupper gt
-	or
-	{invis} if
-} def
-
-/curlayer 0 def
-
-%%EndResource
-%%EndProlog
-%%BeginSetup
-14 default-font-family set_font
-% /arrowlength 10 def
-% /arrowwidth 5 def
-
-% make sure pdfmark is harmless for PS-interpreters other than Distiller
-/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
-% make '<<' and '>>' safe on PS Level 1 devices
-/languagelevel where {pop languagelevel}{1} ifelse
-2 lt {
-    userdict (<<) cvn ([) cvn load put
-    userdict (>>) cvn ([) cvn load put
-} if
-
-%%EndSetup
-setupLatin1
-%%Page: 1 1
-%%PageBoundingBox: 36 36 395 224
-%%PageOrientation: Portrait
-0 0 1 beginpage
-gsave
-36 36 359 188 boxprim clip newpath
-1 1 set_scale 0 rotate 40 40 translate
-% extend type checker
-gsave
-1 setlinewidth
-0 0 0 nodecolor
-203.7388 162 104.7816 18 ellipse_path stroke
-0 0 0 nodecolor
-14 /Times-Roman set_font
-131.2388 158.3 moveto 145 (extend type checker) alignedtext
-grestore
-% write about type checker
-gsave
-1 setlinewidth
-0 0 0 nodecolor
-126.7388 90 126.978 18 ellipse_path stroke
-0 0 0 nodecolor
-14 /Times-Roman set_font
-37.2388 86.3 moveto 179 (write about type checker) alignedtext
-grestore
-% extend type checker->write about type checker
-gsave
-1 setlinewidth
-0 0 0 edgecolor
-newpath 185.0992 144.055 moveto
-175.429 135.2639 163.4569 124.3801 152.8778 114.7627 curveto
-stroke
-0 0 0 edgecolor
-newpath 155.2273 112.1686 moveto
-145.4735 108.0316 lineto
-150.5186 117.3482 lineto
-closepath fill
-1 setlinewidth
-solid
-0 0 0 edgecolor
-newpath 155.2273 112.1686 moveto
-145.4735 108.0316 lineto
-150.5186 117.3482 lineto
-closepath stroke
-grestore
-% require new typesetting code
-gsave
-1 setlinewidth
-0 0 0 nodecolor
-203.7388 18 147.5738 18 ellipse_path stroke
-0 0 0 nodecolor
-14 /Times-Roman set_font
-98.2388 14.3 moveto 211 (require new typesetting code) alignedtext
-grestore
-% write about type checker->require new typesetting code
-gsave
-1 setlinewidth
-0 0 0 edgecolor
-newpath 145.3783 72.055 moveto
-155.0485 63.2639 167.0206 52.3801 177.5998 42.7627 curveto
-stroke
-0 0 0 edgecolor
-newpath 179.9589 45.3482 moveto
-185.004 36.0316 lineto
-175.2502 40.1686 lineto
-closepath fill
-1 setlinewidth
-solid
-0 0 0 edgecolor
-newpath 179.9589 45.3482 moveto
-185.004 36.0316 lineto
-175.2502 40.1686 lineto
-closepath stroke
-grestore
-% require new typesetting code->extend type checker
-gsave
-1 setlinewidth
-0 0 0 edgecolor
-newpath 231.2293 35.8946 moveto
-243.2902 44.9519 256.1778 57.2868 262.7388 72 curveto
-269.255 86.6129 269.255 93.3871 262.7388 108 curveto
-257.5254 119.6912 248.3174 129.8807 238.7037 138.1174 curveto
-stroke
-0 0 0 edgecolor
-newpath 236.2502 135.5972 moveto
-230.6116 144.567 lineto
-240.6131 141.0712 lineto
-closepath fill
-1 setlinewidth
-solid
-0 0 0 edgecolor
-newpath 236.2502 135.5972 moveto
-230.6116 144.567 lineto
-240.6131 141.0712 lineto
-closepath stroke
-grestore
-endpage
-showpage
-grestore
-%%PageTrailer
-%%EndPage: 1
-%%Trailer
-%%Pages: 1
-%%BoundingBox: 36 36 395 224
-end
-restore
-%%EOF

gen0_virtuous_cycle/app/output.svg

-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
- "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
-<!-- Generated by graphviz version 2.49.3 (0)
- -->
-<!-- Title: G Pages: 1 -->
-<svg width="359pt" height="188pt"
- viewBox="0.00 0.00 359.28 188.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
-<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 184)">
-<title>G</title>
-<polygon fill="white" stroke="transparent" points="-4,4 -4,-184 355.28,-184 355.28,4 -4,4"/>
-<!-- extend type checker -->
-<g id="node1" class="node">
-<title>extend type checker</title>
-<ellipse fill="none" stroke="black" cx="203.74" cy="-162" rx="104.78" ry="18"/>
-<text text-anchor="middle" x="203.74" y="-158.3" font-family="Times,serif" font-size="14.00">extend type checker</text>
-</g>
-<!-- write about type checker -->
-<g id="node2" class="node">
-<title>write about type checker</title>
-<ellipse fill="none" stroke="black" cx="126.74" cy="-90" rx="126.98" ry="18"/>
-<text text-anchor="middle" x="126.74" y="-86.3" font-family="Times,serif" font-size="14.00">write about type checker</text>
-</g>
-<!-- extend type checker&#45;&gt;write about type checker -->
-<g id="edge1" class="edge">
-<title>extend type checker&#45;&gt;write about type checker</title>
-<path fill="none" stroke="black" d="M185.1,-144.05C175.43,-135.26 163.46,-124.38 152.88,-114.76"/>
-<polygon fill="black" stroke="black" points="155.23,-112.17 145.47,-108.03 150.52,-117.35 155.23,-112.17"/>
-</g>
-<!-- require new typesetting code -->
-<g id="node3" class="node">
-<title>require new typesetting code</title>
-<ellipse fill="none" stroke="black" cx="203.74" cy="-18" rx="147.57" ry="18"/>
-<text text-anchor="middle" x="203.74" y="-14.3" font-family="Times,serif" font-size="14.00">require new typesetting code</text>
-</g>
-<!-- write about type checker&#45;&gt;require new typesetting code -->
-<g id="edge2" class="edge">
-<title>write about type checker&#45;&gt;require new typesetting code</title>
-<path fill="none" stroke="black" d="M145.38,-72.05C155.05,-63.26 167.02,-52.38 177.6,-42.76"/>
-<polygon fill="black" stroke="black" points="179.96,-45.35 185,-36.03 175.25,-40.17 179.96,-45.35"/>
-</g>
-<!-- require new typesetting code&#45;&gt;extend type checker -->
-<g id="edge3" class="edge">
-<title>require new typesetting code&#45;&gt;extend type checker</title>
-<path fill="none" stroke="black" d="M231.23,-35.89C243.29,-44.95 256.18,-57.29 262.74,-72 269.26,-86.61 269.26,-93.39 262.74,-108 257.53,-119.69 248.32,-129.88 238.7,-138.12"/>
-<polygon fill="black" stroke="black" points="236.25,-135.6 230.61,-144.57 240.61,-141.07 236.25,-135.6"/>
-</g>
-</g>
-</svg>

gen0_virtuous_cycle/app/tc_gen0.hs

+module TC0 where
+
+main = do putStrLn "This should work"
+{-
 import PSLex
 
 import Control.Exception --  TODO: better Error Handling, not just crashing, with messages, you know...
@@ -6,6 +10,8 @@ import Control.Monad
 import Control.Applicative
 import Data.Maybe
 
+-- $> 1 + 4
+
 lookUpDef :: String -> MachineMyState (Maybe [ExpType])
 lookUpDef name = StateAlt $ \(w,s,p) -> Just $ (lookup name w, (w,s,p))
 
@@ -103,7 +109,7 @@ mainloop input =
     Nothing -> do putStrLn "no next State"
 
 main = do
-  s <- readFile "output.ps"
+  s <- readFile "../output.ps"
   let program = token2Type <$> parseBlocks (alexScanTokens s)
   mainloop (Just ("Starting Eval",(buildins,[],program)))
 
@@ -248,3 +254,5 @@ instance Monad (MyState s) where
   (>>=) (MyState a) a_s_of_b = MyState $ \s -> let (a_val, s') = (a s)
                                                    (MyState b_MyState) = (a_s_of_b a_val)
                                                in  (b_MyState s')
+
+-}

gen0_virtuous_cycle/cabal.project.local

+ignore-project: False
+tests: True
\ No newline at end of file

gen0_virtuous_cycle/dist-newstyle/build/x86_64-linux/ghc-9.4.8/gen0-virtuous-cycle-0.1.0.0/l/PSLex/build/PSLex/autogen/Paths_gen0_virtuous_cycle.hs

+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoRebindableSyntax #-}
+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
+{-# OPTIONS_GHC -w #-}
+module Paths_gen0_virtuous_cycle (
+    version,
+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
+    getDataFileName, getSysconfDir
+  ) where
+
+
+import qualified Control.Exception as Exception
+import qualified Data.List as List
+import Data.Version (Version(..))
+import System.Environment (getEnv)
+import Prelude
+
+
+#if defined(VERSION_base)
+
+#if MIN_VERSION_base(4,0,0)
+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+#else
+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
+#endif
+
+#else
+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+#endif
+catchIO = Exception.catch
+
+version :: Version
+version = Version [0,1,0,0] []
+
+getDataFileName :: FilePath -> IO FilePath
+getDataFileName name = do
+  dir <- getDataDir
+  return (dir `joinFileName` name)
+
+getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
+
+
+
+bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
+bindir     = "/home/hendrik/.cabal/bin"
+libdir     = "/home/hendrik/.cabal/lib/x86_64-linux-ghc-9.4.8/gen0-virtuous-cycle-0.1.0.0-inplace-PSLex"
+dynlibdir  = "/home/hendrik/.cabal/lib/x86_64-linux-ghc-9.4.8"
+datadir    = "/home/hendrik/.cabal/share/x86_64-linux-ghc-9.4.8/gen0-virtuous-cycle-0.1.0.0"
+libexecdir = "/home/hendrik/.cabal/libexec/x86_64-linux-ghc-9.4.8/gen0-virtuous-cycle-0.1.0.0"
+sysconfdir = "/home/hendrik/.cabal/etc"
+
+getBinDir     = catchIO (getEnv "gen0_virtuous_cycle_bindir")     (\_ -> return bindir)
+getLibDir     = catchIO (getEnv "gen0_virtuous_cycle_libdir")     (\_ -> return libdir)
+getDynLibDir  = catchIO (getEnv "gen0_virtuous_cycle_dynlibdir")  (\_ -> return dynlibdir)
+getDataDir    = catchIO (getEnv "gen0_virtuous_cycle_datadir")    (\_ -> return datadir)
+getLibexecDir = catchIO (getEnv "gen0_virtuous_cycle_libexecdir") (\_ -> return libexecdir)
+getSysconfDir = catchIO (getEnv "gen0_virtuous_cycle_sysconfdir") (\_ -> return sysconfdir)
+
+
+
+
+joinFileName :: String -> String -> FilePath
+joinFileName ""  fname = fname
+joinFileName "." fname = fname
+joinFileName dir ""    = dir
+joinFileName dir fname
+  | isPathSeparator (List.last dir) = dir ++ fname
+  | otherwise                       = dir ++ pathSeparator : fname
+
+pathSeparator :: Char
+pathSeparator = '/'
+
+isPathSeparator :: Char -> Bool
+isPathSeparator c = c == '/'

gen0_virtuous_cycle/dist-newstyle/build/x86_64-linux/ghc-9.4.8/gen0-virtuous-cycle-0.1.0.0/l/PSLex/build/PSLex/autogen/cabal_macros.h

+/* DO NOT EDIT: This file is automatically generated by Cabal */
+
+/* package gen0-virtuous-cycle-0.1.0.0 */
+#ifndef VERSION_gen0_virtuous_cycle
+#define VERSION_gen0_virtuous_cycle "0.1.0.0"
+#endif /* VERSION_gen0_virtuous_cycle */
+#ifndef MIN_VERSION_gen0_virtuous_cycle
+#define MIN_VERSION_gen0_virtuous_cycle(major1,major2,minor) (\
+  (major1) <  0 || \
+  (major1) == 0 && (major2) <  1 || \
+  (major1) == 0 && (major2) == 1 && (minor) <= 0)
+#endif /* MIN_VERSION_gen0_virtuous_cycle */
+/* package array-0.5.4.0 */
+#ifndef VERSION_array
+#define VERSION_array "0.5.4.0"
+#endif /* VERSION_array */
+#ifndef MIN_VERSION_array
+#define MIN_VERSION_array(major1,major2,minor) (\
+  (major1) <  0 || \
+  (major1) == 0 && (major2) <  5 || \
+  (major1) == 0 && (major2) == 5 && (minor) <= 4)
+#endif /* MIN_VERSION_array */
+/* package base-4.17.2.1 */
+#ifndef VERSION_base
+#define VERSION_base "4.17.2.1"
+#endif /* VERSION_base */
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(major1,major2,minor) (\
+  (major1) <  4 || \
+  (major1) == 4 && (major2) <  17 || \
+  (major1) == 4 && (major2) == 17 && (minor) <= 2)
+#endif /* MIN_VERSION_base */
+
+/* tool alex-3.3.0.0 */
+#ifndef TOOL_VERSION_alex
+#define TOOL_VERSION_alex "3.3.0.0"
+#endif /* TOOL_VERSION_alex */
+#ifndef MIN_TOOL_VERSION_alex
+#define MIN_TOOL_VERSION_alex(major1,major2,minor) (\
+  (major1) <  3 || \
+  (major1) == 3 && (major2) <  3 || \
+  (major1) == 3 && (major2) == 3 && (minor) <= 0)
+#endif /* MIN_TOOL_VERSION_alex */
+/* tool gcc-12.3.0 */
+#ifndef TOOL_VERSION_gcc
+#define TOOL_VERSION_gcc "12.3.0"
+#endif /* TOOL_VERSION_gcc */
+#ifndef MIN_TOOL_VERSION_gcc
+#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\
+  (major1) <  12 || \
+  (major1) == 12 && (major2) <  3 || \
+  (major1) == 12 && (major2) == 3 && (minor) <= 0)
+#endif /* MIN_TOOL_VERSION_gcc */
+/* tool ghc-9.4.8 */
+#ifndef TOOL_VERSION_ghc
+#define TOOL_VERSION_ghc "9.4.8"
+#endif /* TOOL_VERSION_ghc */
+#ifndef MIN_TOOL_VERSION_ghc
+#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\
+  (major1) <  9 || \
+  (major1) == 9 && (major2) <  4 || \
+  (major1) == 9 && (major2) == 4 && (minor) <= 8)
+#endif /* MIN_TOOL_VERSION_ghc */
+/* tool ghc-pkg-9.4.8 */
+#ifndef TOOL_VERSION_ghc_pkg
+#define TOOL_VERSION_ghc_pkg "9.4.8"
+#endif /* TOOL_VERSION_ghc_pkg */
+#ifndef MIN_TOOL_VERSION_ghc_pkg
+#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\
+  (major1) <  9 || \
+  (major1) == 9 && (major2) <  4 || \
+  (major1) == 9 && (major2) == 4 && (minor) <= 8)
+#endif /* MIN_TOOL_VERSION_ghc_pkg */
+/* tool haddock-2.27.0 */
+#ifndef TOOL_VERSION_haddock
+#define TOOL_VERSION_haddock "2.27.0"
+#endif /* TOOL_VERSION_haddock */
+#ifndef MIN_TOOL_VERSION_haddock
+#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\
+  (major1) <  2 || \
+  (major1) == 2 && (major2) <  27 || \
+  (major1) == 2 && (major2) == 27 && (minor) <= 0)
+#endif /* MIN_TOOL_VERSION_haddock */
+/* tool hpc-0.68 */
+#ifndef TOOL_VERSION_hpc
+#define TOOL_VERSION_hpc "0.68"
+#endif /* TOOL_VERSION_hpc */
+#ifndef MIN_TOOL_VERSION_hpc
+#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\
+  (major1) <  0 || \
+  (major1) == 0 && (major2) <  68 || \
+  (major1) == 0 && (major2) == 68 && (minor) <= 0)
+#endif /* MIN_TOOL_VERSION_hpc */
+/* tool hsc2hs-0.68.8 */
+#ifndef TOOL_VERSION_hsc2hs
+#define TOOL_VERSION_hsc2hs "0.68.8"
+#endif /* TOOL_VERSION_hsc2hs */
+#ifndef MIN_TOOL_VERSION_hsc2hs
+#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\
+  (major1) <  0 || \
+  (major1) == 0 && (major2) <  68 || \
+  (major1) == 0 && (major2) == 68 && (minor) <= 8)
+#endif /* MIN_TOOL_VERSION_hsc2hs */
+/* tool runghc-9.4.8 */
+#ifndef TOOL_VERSION_runghc
+#define TOOL_VERSION_runghc "9.4.8"
+#endif /* TOOL_VERSION_runghc */
+#ifndef MIN_TOOL_VERSION_runghc
+#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\
+  (major1) <  9 || \
+  (major1) == 9 && (major2) <  4 || \
+  (major1) == 9 && (major2) == 4 && (minor) <= 8)
+#endif /* MIN_TOOL_VERSION_runghc */
+/* tool strip-2.35 */
+#ifndef TOOL_VERSION_strip
+#define TOOL_VERSION_strip "2.35"
+#endif /* TOOL_VERSION_strip */
+#ifndef MIN_TOOL_VERSION_strip
+#define MIN_TOOL_VERSION_strip(major1,major2,minor) (\
+  (major1) <  2 || \
+  (major1) == 2 && (major2) <  35 || \
+  (major1) == 2 && (major2) == 35 && (minor) <= 0)
+#endif /* MIN_TOOL_VERSION_strip */
+
+#ifndef CURRENT_PACKAGE_KEY
+#define CURRENT_PACKAGE_KEY "gen0-virtuous-cycle-0.1.0.0-inplace-PSLex"
+#endif /* CURRENT_packageKey */
+#ifndef CURRENT_COMPONENT_ID
+#define CURRENT_COMPONENT_ID "gen0-virtuous-cycle-0.1.0.0-inplace-PSLex"
+#endif /* CURRENT_COMPONENT_ID */
+#ifndef CURRENT_PACKAGE_VERSION
+#define CURRENT_PACKAGE_VERSION "0.1.0.0"
+#endif /* CURRENT_PACKAGE_VERSION */