diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Smurf.dcl | 20 | ||||
| -rw-r--r-- | Smurf.icl | 94 | ||||
| -rw-r--r-- | run.icl | 17 | ||||
| -rw-r--r-- | run.prj | 1 | ||||
| -rw-r--r-- | tree.icl | 16 | ||||
| -rw-r--r-- | tree.prj | 61 |
8 files changed, 181 insertions, 31 deletions
@@ -2,6 +2,7 @@ *.exe *.out run +tree # Directory used to store object files, abc files and assembly files Clean System Files/ @@ -1,5 +1,5 @@ CPM=cpm -OBJ=run +OBJ=run tree DEPS=Smurf.dcl Smurf.icl SmurfParse.dcl SmurfParse.icl all: $(OBJ) @@ -24,6 +24,15 @@ from Data.Maybe import ::Maybe , store :: Store } +:: IO io = IO (io -> .(String, io)) (String io -> io) + +:: ListIO = { input :: [String] + , output :: [String] + } + +:: Transition = (-->) infix 1 (Program, [String], State) ([String], [String], State) +:: DerivationTree :== [Transition] + derive gEq Stm instance == Stm @@ -34,6 +43,13 @@ instance fromChar Stm instance zero State instance toString State -step :: !Program State !*File -> *(Maybe (!Program, State), *File) -run :: !Program State *File -> *(Maybe State, *File) +instance zero ListIO + +instance toString Transition +instance toString DerivationTree + +step :: !Program State u:io u:(IO u:io) -> u:(Maybe (!Program, State), u:io) +run :: !Program State io (IO io) -> (Maybe State, io) +listIO :: IO ListIO +tree :: !Program !State !ListIO (IO ListIO) -> Maybe DerivationTree @@ -11,12 +11,19 @@ from Data.Func import $ import Control.Applicative import Control.Monad import Data.Maybe +import Data.List +from Text import class Text(concat), instance Text String import GenEq +import GenPrint import SmurfParse derive gEq Stm +derive gPrint (,) + +(<+) infixr 5 :: a b -> String | toString a & toString b +(<+) a b = toString a +++ toString b instance == Stm where == a b = a === b @@ -52,55 +59,67 @@ where instance zero State where zero = { stack = zero, store = zero } +instance zero ListIO where zero = {input=[], output=[]} + instance toString State where - toString {stack, store} - = "Stack:\n" - +++ foldl (+++) "" [" " +++ val +++ "\n" \\ val <- stack] - +++ "Store:\n" - +++ foldl (+++) "" [" " +++ var +++ " : " +++ val +++ "\n" - \\ (var, val) <- store] - -run :: !Program State *File -> *(Maybe State, *File) -run prog st io - # (mbProgSt, io) = step prog st io + toString {stack,store} = "(" <+ printToString stack <+ "," <+ printToString store <+ ")" + +instance toString Transition +where + toString ((p1, ip1, st1) --> (ip2, op, st2)) + = "<" <+ simple 2 p1 <+ "," <+ st1 <+ "," <+ printToString ip1 <+ "> -> (" + <+ printToString ip2 <+ "," <+ printToString op <+ "," <+ st2 <+ ")" + where + simple :: !Int !Program -> String + simple _ [] = "λ" + simple i pgm + | i <= length pgm = concat $ intersperse ":" $ map toString pgm + = concat $ intersperse ":" $ map toString (take i pgm) + +instance toString DerivationTree +where + toString ts = concat $ intersperse "\n" $ map toString $ reverse ts + +run :: !Program State io (IO io) -> (Maybe State, io) +run prog st io iofuncs + # (mbProgSt, io) = step prog st io iofuncs | isNothing mbProgSt = (Nothing, io) # (prog, st) = fromJust mbProgSt - = if (isEmpty prog) (Just st, io) (run prog st io) + = if (isEmpty prog) (Just st, io) (run prog st io iofuncs) -step :: !Program State !*File -> *(Maybe (!Program, State), *File) -step [] st io +step :: !Program State u:io u:(IO u:io) -> u:(Maybe (!Program, State), u:io) +step [] st io _ = (pure ([], st), io) -step [Push s:p] st io +step [Push s:p] st io _ = (pure (p, { st & stack = push s st.stack }), io) -step [Input:p] st io - # (ip, io) = freadline io - # ip = ip % (0, size ip - 2) +step [Input:p] st io (IO input _) + # (ip, io) = input io = (pure (p, { st & stack = push ip st.stack }), io) -step [Output:p] st io +step [Output:p] st io (IO _ output) # mbSStk = pop st.stack | isNothing mbSStk = (empty, io) # (s, stk) = fromJust mbSStk - = (pure (p, { st & stack = stk }), io <<< s) -step [Cat:p] st io + = (pure (p, { st & stack = stk }), output s io) +step [Cat:p] st io _ = (pop st.stack >>= \(x,stk) -> pop stk >>= \(y,stk`) -> pure (p, { st & stack = push (y +++ x) stk` }), io) -step [Head:p] st io +step [Head:p] st io _ = (pop st.stack >>= \(x,stk) -> head x >>= \x` -> pure (p, { st & stack = push x` stk }), io) -step [Tail:p] st io +step [Tail:p] st io _ = (pop st.stack >>= \(x,stk) -> tail x >>= \x` -> pure (p, { st & stack = push x` stk }), io) -step [Quotify:p] st io +step [Quotify:p] st io _ = (pop st.stack >>= \(x,stk) -> pure (p, { st & stack = push (quotify x) stk }), io) -step [Put:p] st io +step [Put:p] st io _ = (pop st.stack >>= \(var,stk) -> pop stk >>= \(val,stk`) -> pure (p, { st & stack = stk`, store = put var val st.store }), io) -step [Get:p] st io +step [Get:p] st io _ = (pop st.stack >>= \(var,stk) -> pure (p, { st & stack = push (get var st.store) stk }), io) -step [Exec:p] st io +step [Exec:p] st io _ = (pop st.stack >>= parse o fromString o fst >>= \p -> pure (p, zero), io) @@ -137,3 +156,26 @@ where quot ['"':cs] = ['\\':'"':quot cs] quot [c:cs] = [c:quot cs] +listIO :: IO ListIO +listIO = IO read write +where + read :: ListIO -> (String, ListIO) + read io=:{input} = (hd input, { io & input=tl input }) + + write :: String ListIO -> ListIO + write s io=:{output} = { io & output=output ++ [s] } + +tree :: !Program !State !ListIO (IO ListIO) -> Maybe DerivationTree +tree pgm st io iof + # init = (pgm, io.input, st) + # (mbPgmSt, io) = step pgm st io iof + | isNothing mbPgmSt = empty + # (pgm, st) = fromJust mbPgmSt + | isEmpty pgm = pure [ init --> (io.input, io.output, st) + , ([],io.input,st) --> (io.input,[],st) + ] + # mbTree = tree pgm st io iof + | isNothing mbTree = empty + # tree = fromJust mbTree + # [child=:(_ --> final):children] = fromJust mbTree + = pure [init --> final:child:children] @@ -45,10 +45,12 @@ where loop :: Bool ![Stm] !Program !State !*File -> *File loop v brk p st f # p = if v (trace (foldl (+++) "" (map toString p) +++ "\n") p) p - # (mbProgSt, f) = step p st f + # (mbProgSt, f) = step p st f iofunc | isNothing mbProgSt = f <<< "NOTHING!!!\n" # (prog, st) = fromJust mbProgSt - | isEmpty prog = f <<< "\n---------------------------\n" <<< toString st + | isEmpty prog + | v = f <<< "\n---------------------------\n" <<< toString st + = f | not (isBrk prog) = loop v brk prog st f # f = f <<< "---> " <<< toString (hd prog) <<< " ? " # (cmd, f) = freadline f @@ -62,6 +64,17 @@ where isBrk [(Push _):_] = isMember (Push "") brk isBrk [stm:_] = isMember stm brk + iofunc :: *IO *File + iofunc = IO read show + where + read :: *File -> *(String, *File) + read f + # (s, f) = freadline f + = (s % (0, size s - 2), f) + + show :: String *File -> *File + show s f = f <<< s + options = [ Option ['i'] ["infile"] (ReqArg IFile "FILE") "Smurf file" , Option ['b'] ["break"] @@ -40,6 +40,7 @@ Global Paths Path: {Project}/ Path: {Application}/lib/Generics/ + Path: {Application}/lib/StdLib/ Path: {Application}/lib/clean-platform/OS-Independent/ Path: {Application}/lib/clean-platform/OS-Linux-64/ Precompile: diff --git a/tree.icl b/tree.icl new file mode 100644 index 0000000..82e0ae9 --- /dev/null +++ b/tree.icl @@ -0,0 +1,16 @@ +module tree + +import StdEnv + +import Data.Maybe, Data.List +from Data.Func import $ + +import System.CommandLine, System.GetOpt + +import Smurf +import SmurfParse + +Start = toString devtree +where + (Just devtree) = tree pgm zero zero listIO + (Just pgm) = parse ['"abc""123"+o'] diff --git a/tree.prj b/tree.prj new file mode 100644 index 0000000..3859aa8 --- /dev/null +++ b/tree.prj @@ -0,0 +1,61 @@ +Version: 1.4 +Global + ProjectRoot: . + Target: StdEnv + Exec: {Project}/tree + CodeGen + CheckStacks: False + CheckIndexes: True + Application + HeapSize: 2097152 + StackSize: 512000 + ExtraMemory: 8192 + IntialHeapSize: 204800 + HeapSizeMultiplier: 4096 + ShowExecutionTime: False + ShowGC: False + ShowStackSize: False + MarkingCollector: False + DisableRTSFlags: False + StandardRuntimeEnv: True + Profile + Memory: False + MemoryMinimumHeapSize: 0 + Time: False + Stack: False + Output + Output: BasicValuesOnly + Font: Monaco + FontSize: 9 + WriteStdErr: False + Link + LinkMethod: Static + GenerateRelocations: False + GenerateSymbolTable: False + GenerateLinkMap: False + LinkResources: False + ResourceSource: + GenerateDLL: False + ExportedNames: + Paths + Path: {Project}/ + Path: {Application}/lib/Generics/ + Path: {Application}/lib/StdLib/ + Path: {Application}/lib/clean-platform/OS-Independent/ + Path: {Application}/lib/clean-platform/OS-Linux-64/ + Precompile: + Postlink: +MainModule + Name: tree + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False |