(* the Strictly False stack machine language *) fun say s = TextIO.output(TextIO.stdOut,"\n\n"^s^"\n\n"); fun versiondate() = say "September 12, 2005"; (* Sept. 12: The interpreter should now be able to distinguish between read-only and read/write files (it will raise errors if you attempt to use W or m with a file handle created by Z). There is now a Z command which opens a file read-only; the interpreter doesn't know the difference -- Z supplies it with an output stream to the file "dummy". Note that Z can crash if the file does not exist (no, this is handled now). The O command opens a file to read and write, so it destroys existing files when it opens them, apparently. Probably I should set it up so that it won't write to read-only files, but the common format is useful anyway. file IO is messed up somehow: it cannot execute files that I have written, only those that it itself has written, and not after it closes them. Does it have something to do with files being open for reading and writing at the same time? a command to open a file to read only? the M command will treat comments correctly. Arguments of the m command reversed, so that the fileID is closest to the opcode *) (* Sept. 11: corrected bu in "e" (eats one argument too many) *) (* Sept. 6: corrected a bug which made the natural form of a for next loop fail (numbers were being executed before programs on the data stack) *) (* Sept. 2: The stack now persists between runs of execute and executelines() executes lines entered at the console until a return is hit without any text. Display program text in braces (and ignore braces in execution). This doesn't conflict with comments because they never make it into program text at all (and we have no desire to explicitly force program text). The P command loads literal program text onto the data stack; any other command should avoid doing this (except for occasionally dropping unprotected program text onto the stack to be executed.) Tweaked display so that opcodes (Program[x]) will not have spaces between them in the display in list displays, even though notext atomizes them. Numerical opcodes (the program text "1" rather than the integer 1) are distinguished from the integer by being put in braces. To see, this, run P1. Commands setbraces() and setnobraces() turn the curly braces around program text in the display on and off. Solving the ambiguity between program text and data by requiring application of notext to any stack put on the data stack (except for the output of the P command) -- with notext turning data programs into data systematically. This should mean that equality on stacks will behave correctly, and weird data stacks will always behave lazily. The fileID in the File I/O commands should always be next to the file opcode. *) (* Sept 1: major update: the integer display now should work without comment. It appears to test OK for the positive integers at least. Unary minus is a generally available opcode, and space is no longer an opcode; the digits themselves work as single opcodes -- but with lookahead (a digit is not the same opcode when it is followed another digit, in effect). No funny rules about spaces; everything should work exactly as one should naively expect (except that leading zeroes do parse as individual numbers. Single digit numbers in a list must now be separated by spaces; oh well. Also, the digit adding opcodes do not announce themselves in trace. Negative display works too! Further remark: the documentation is ready! The defined opcode scheme worked in a simple test (reverse lists). At this point I should stop enhancing the language (though I note that it would be nice to be able to save a file handle to the array) and write documentation. Only debug at this point in response to actual program misbehavior. Don't install any new stuff until docs are finished and some programs have been written. Think seriously about static type-checking for this language. This language might be an interesting target to reason about. How would proofs be represented? How can on recognize that one is done reading a number and can safely discard Digit objects? *) (* Final August 31: The defined opcode feature is defined. The subtle part is getting recursion to work. This is intended to be static: there is no way to redefine an opcode once it is defined in a given run of the interpreter. This hasn't been tested yet; it completes my language definition in essence. even later: fixed a bug in reading over whitespace. There needs to be an effort to normalize program text, so it always looks the same? *) (* Also August 31: The array of memory is installed, with a very generous memory model: indexed variables can be initialized, redeclared locally, deallocated (returning to an earlier value if there was one), assigned to normally and evaluated normally. *) (* another August 31 comment: can this language be supplied with a static type checker? it does not seem impossible at all. another weirdness is that it is possible to get stacks with Digit objects in them by using the S command... These will look like standard objects but not act like them? In fact, an evil bug ensues if this is attempted...if all bugs were so easily fixed: purge Digits from the stack when the S command is issued. re the remark below, OpCode x has been evicted in favor of Program[x], and for all data d (incl. characters, stacks) Program[d] is not confused with d; it has slightly different execution behavior. Further, the now misnamed "notext" command no longer eliminates program text but parses it. When data is copied from the data stack to the program stack, it becomes program (the effect of this program is always simply to copy something that looks like the given data to the data stack, but if this program is sitting on the data stack it does something, and observably different behavior can result). Note that any stacks entered from the program are program material. [123] enters a program stack; [123][x~][i]# will put genuine integers on the stack (so does [123]!). The distinction between program and data here seems philosophically interesting... further remark: Opcode "1" is NOT the same thing as Int 1? This can be seen by looking at what will happen with the following stack: [Opcode #"1",Opcode #"\",...] This should flip two items and then add a 1, whereas [Int 1,OpCode #"\",...] would just sit there. The answer must be that the latter object cannot be put on the stack: but it can! However, Int 1 executes just like Opcode "1" when it gets to the program stack? Note that characters already have the same inert behavior, and there is certainly no OpCode 'a (for example). Note that Program "1" will have the desired effect. This seems to imply that notext will not work correctly? Maybe there is no need for OpCode x: Program [x] is the same thing. Moreover, Program['a] captures something that can't be represented with OpCode. It does seem that notext is not written quite correctly... ([Program "1\"] and [1,Program "\"] are supposedly identical but are different states of the stack. *) (* the more standard implementation of numerals is now in place. " " and "_" are now (eccentric) operators which grab as many digits as are available. There is an internal distinction between digits free to go into a multidigit numeral and digits already entered into a fixed number. You must write a space after a positive multidigit numeral, even at the end of a program or list. _ is not a general purpose unary negation operator; only write it after numerals. A hack which might fix the last issue is always to append a space to a text being executed (and read return as space). This would force something more like the usual style; but I'm not doing it yet. *) (* Differences from standard False @ used to be different but is now restored ? used to be different but is now restored pick is not there (but can be written) ) is flush no inline assembly (`x means [x], only for single characters x) the language is (dynamically) typed, so the peek/poke trick does not work (among other special effects; explicit casting is supported) only functions can be stored in character variables (but given the additional tools for handling lists/functions, this is more an apparent than a real limitation). Because of this, ; incorporates application in its effect. Multi-digit integers should now be read in something like the usual format, while preserving ideological purity: " " and "_" will be understood to be stack operators which read standard decimal notation. There is considerable additional functionality: one can carry out standard list operations on "functions" (in two flavors, since some components of lists have execution behavior and one does not always wish to encourage this!) Since all contents of character-labelled variables are functions, ; includes the effect of application. there is file I/O continuation passing is supported (see D and P)! pending is numerically addressed data memory and the ability to define opcodes. *) (* August 30: I see a completely different solution for integers which restores the False display. Let " " and "_" be operators, each doing something only when acting on a digit, and in that case consuming all following digits. Then standard numerals can be fodder for first and notextitem (but only when followed by a space!). Elimination of repeated spaces is sound because the output of a space command will always be ignored by another space command. Extra spaces are ignored; they do not trigger errors. Leading zeroes are not absorbed into multidigit numerals: they are read as separate zeros. DONE There is another difficulty with first: it needs to grab multidigit numbers as single chunks. I wrote the notext function which should convert a function to a unique form almost without program text. The only place where I actually use it is in the = for functions. I banished Opcode "1" and its kindred. fixed another bug in the first function. Something needs to be done about the dual representation of functions as lists and text, or else it needs to really be tightened up. Restored original False meaning of @ (just for compatibility, since this is also restored for ?). The old meaning is new \@ The preservation of order of arguments 1 and 2 is useful. The control structures now differ slightly in behavior and fundamentally in implementation (the profound change is in D and P, which now really support continuations). The bracket around the test is no longer wanted for ? (returning to the way False itself behaves). There are no longer subsidiary calculations going on: the "program stack" P honestly contains complete information about what is to be run. # behaves in the same way as before (except under trace, where it looks rather different) but the pending executions are actually recorded in the P parameter. I also had to fix i for the same reasons, and discovered a bug in incremental execution of program text. I seriously should consider converting program text to list structures? The mixture of parsing and stack operations is a little weird, though it seems to be transparent except to =. removed the prompt for character input from the program: this is easily supplied by the user (and can now be controlled by the user). env2 is another attempt at an environment, in some ways more satisfactory. input reacts badly with the current implementation of trace. *) (* August 29 status report Reason for doing this: Strictly False will be a good language for the Palm when I implement it there (easy to implement and easy to use in the sense of requiring few keystrokes). The purity of the single character approach is enhanced by the new integer display :-) And later, we find that something like the standard display can be justified on the stack machine. File commands appear to work. Defects: Clean up problems caused by the use of text in Program components in functions. These are very handy but can cause trouble: either make the simulation perfect or eliminate. If a function with program text is tested for equality the program text should perhaps be eliminated? This is hopefully accomplished with the change in integer display, despacing in the "rest" functions, and development of the notext function to put functions/lists in a standard form. But the incremental handling of text seems to be a perfectly reasonable way to do things, at least in this interpreter. The notext objects presumably also would be executed by this machine. Features to add: Casting between characters and integers is a legitimate feature. A function which casts from characters to opcodes is also a good idea.DONE Retrieving the stack as a data item, and checking whether it is empty are legitimate functions. How about replacing the stack? How about two-way access to the program being executed?DONE I implemented a test for empty stack, grabbing the data stack and putting it on the stack, replacing the data stack with its top element, and grabbing the program stack and putting it on the stack, and discarding the program stack and executing the function on top of the data stack (this enables continuation handling). The data stack always means "the data stack after any opcodes or program text on the data stack is executed" and any D command executed from the data stack will actually be executed from a correct program stack. D can only prevent pending conditional execution by arranging to return a false (this has been corrected). File I/O; open a file and bind it to a character. Get a character, put a character, execute a file and put a function in a file (this last command opens the file, saves the data in it, and closes it). Close a file and flush a file (ML only allows for flushing outstreams). Open file is DONE; read and write characters are DONE; output buffer is always flushed when doing input or closing file, so no need for flush command. The file read command R always leads its output with a boolean telling whether there is a character read or not. Errors as to existence of files stop the program. I implemented loading and saving of functions to files. This also meant that I need to enforce the condition that the execution of the display of a stack will be the same as the execution of the stack: to do this I introduce opcodes for true and false and a slightly demented but readable way of displaying multi-digit integers. This fixes a bug, actually: functions containing multi-digit numbers or truth values would not have executed correctly in previous versions? Ability to define new opcodes: take a defined function and "permanently" bind it to a character (from the standpoint of any fixed program). This command can only be issued in the programming environment and the defined character remains dynamically allocable. Ability to save data of all types to numerical addresses. This restores a cheat capability of False. This will be static storage (though functions/lists can be stored). Allocation of this memory might be an issue in a non-ML version. There are real advantages to my formulation of ?; it will stay the same. My @ is better (I reversed myself on both of these). i really is trace: my notes below about this were wrong. Think of the function as living in P, not on the stack. I could install an integer input mode, I suppose, and make it so that integers in multi-digit format can be read by the system.NOT NEEDED: there is now a standard way to write integers using single digit opcodes. Clean up the format of the user environment and install the stupid line editor. Write real documentation and set up a web page. Write to Wouter about it. The main philosophical issues are the typing and the ability to manipulate saved stacks (including executable programs) as lists (and the requisite need to assign (virtual) internal structure to programs). The invisible OpCode type is needed to preserve the idea that executing a function is simply dropping it onto the data stack. This is an essentially more powerful language than False (and probably still admits a small implementation: write in C and compile?) A mathematical issue is demonstrating that this language does combinators: do this by exhibiting the combinators and testing them. *) (* the language now works. It is somewhat different from the original False and these differences should be set out. *) (* in the help command, the language Pure False is now specified *) (* mod debugging I believe this implements a dialect of False which adds the ability to push items into "lambdas" (this makes it combinatorially complete). This dialect is fairly strongly dynamically typed: no casting. Only function definitions are supported by : and ;, but every character can be defined as a function. The " " and [ ] forms are not supported in the underlying opcodes: these programs are constructed by a string preprocessing step. Numerical input is restricted to 0-9 as in Befunge. *) (* I need to install the ability to run programs from the console or a file. The internal environment in which this is done should also allow control of the trace features. I need to install comments in the language. A help command with information about each opcode would be useful: the help command is now available; it takes a string argument, and single character strings can be used to get info about opcodes. I need to fix the (deliberately permitted) crashes: ML crashes will break the projected native Pure False programming environment, which is not a good thing (though I can use error handling to prevent this). Starting on this: the definition facility will no longer crash, and the conditional tests escape gracefully when they do not detect truth values. Division by zero is also corrected; I _think_ these are all the ML errors possible... There is still the need to guard against arithmetic overflow. This could be done neatly by putting all arithmetic in a suitable modulus?DONE Comments are installed. August 25th updates were bug fixes to list functions; writing a list reverse procedure was an eye-opener. Notice that treating i as trace is not correct at all, since the operators would get to act on later operators normally. There were difficulties with handling of the underflow situation and a very subtle confusion between Stack(nil) and Stack[Program nil]: probably best handled by eliminating embedded text. But embedded text does neatly solve the problem it was designed to handle, and for the moment seems to be correctly simulated. I now have the desktop environment mostly developed. Its look and feel need to be improved. The ability to turn off trace during a trace is useful. It would be nice if trusted functions could work as single steps under trace. I would like to have a line editor for Strictly False in the repertoire. The crashes are mostly repaired. A main aim for this is to implement it in another language (iziBasic, probably, but this might be via C as well). That's what the memory model stuff is for. *) (* It would be straightforward to allow static installation of new opcodes (basically similar to ; in implementation. This would of course be a programming environment command. Explicit integer/character type casting should be supported, since the implicit kind has been disabled. A "cast" opcode which takes an appropriate integer to a character and a character to an integer is reasonable. I have now added the ability to execute a function step by step in the language itself (i); it might be nice to add the ability to display the top opcode of a function and to display the stack as opcodes in the language; one could then debug programs inside the interpreter! No, one can't: opcodes will execute, but not on the right arguments! A real trace might copy all arguments to the stack, carry out one step, and encase the top item in a function. Such a command could be provided. Adding equality of functions violates type safety completely; what about adding equality of opcodes? Or does thinking of it in terms of equality of opcodes reveal that it is not a type safety violation to have equality of functions? Maybe it is simply that functions are a union type into which many types can be cast? *) (* Why is Pure False pure? with the addition of the p and o commands, it is combinatorially complete (the S and K combinators can be constructed; I should demonstrate this). there is a very small set of commands which is a complete pure calculus of stacks; that way lies madness, though. it is completely reliant on single character opcodes. 'X and `X are apparent exceptions, but really can be thought of as providing extensions to the alphabet. The same can be thought of X: and X; -- these can be thought of as allowing definition of and access to a further alphabet of defined opcodes. Even the "..." and "[...]" forms can be rephrased in terms of single character opcodes (I tried using this in the very first version, but the string preprocessor I wrote didn't work correctly on nested brackets; in any event one would have exponential blowup with bracket nesting). Note that variables are addressable by the language, since their names are characters which can be produced by program operations. it is typed, unlike earlier versions. there is no casting of objects from one type to another, and no messing with assembly code; programming in Pure False must be pure (though it is not completely safe :-) I'm now adding i j and x commands which give more list functionality. i pops off a function, executes its first command, and puts its tail back. j pops off a function, puts the one-element stack of the first element on, then puts the tail back. x checks whether the function on top is empty. In effect this gives hd, tl. There is a subtle problem with i: in its simplest version, it just grabs items of the form Program . It shouldn't do this. This is now fixed (the interpreter parses out the first component). After consideration, I added the function equality test; it behaves differently because it does not consume its arguments (they being potentially large). This makes x redundant, but it is still convenient (and makes more sense philosophically). I have made the arithmetic safe from overflow: for multiplication, this is rather tricky :-). Comments have been implemented. What would be needed for static type checking? Is it possible at all? Perhaps the language should be called Strictly False :-) *) (* Considerations for an implementation at an even lower level: cells in the Strictly False virtual machine contain a switch telling what kind of cell it is (boolean, integer, character, or program), the address of the next cell and the address of the last cell in the list (program) to which it belongs. The last cell address is useful because it makes it easy to take a program at the top of the master stack and put it at the top. How hard would it be to also have unique cells? This would require that cells have additional data that organizes them into a sorted tree. Last cell address idea doesn't work; one still needs to scan through to update last cell addresses in the list, so one gains nothing by recording it. For execution purposes, there is a master address that points into the heap: the address is changed on execution (and new cells may be created or destroyed). Do we avoid circular structures? Yes. So reference counting will work. Put in fields in addition: reference count, cells to the left in the sorted tree, cells to the right in the sorted tree. The order on cells is lexicographic on the switch, the data and the address of the next cell (the address of the last cell is of course strictly speaking redundant). Unused memory is organized into another linear list; more memory can presumably be requested and organized as needed. Unique reference is important because it makes the function equality test simple. In ML one can simulate this using a binary tree with cells numbered by position: in a flat tree this is harmless (the cells in use will be roughly a solidly filled initial segment of the naturals) This is advantageous since I don't have arrays (or at least I don't know how they work.) This makes it reasonably easy to get to an address. This observation means that one doesn't actually need a tree structure: flattening the tree means that we can just regard 2n and 2n+1 as the nodes to the left and right of n. So in an array, ref count, nodes in use to left and nodes in use to right are enough. *) (* the datatype of items allowed on the machine stack *) datatype StackItem = (* OpCode of char | *) Bool of bool | Int of int | Digits of int | Char of char | Program of char list | Stack of StackItem list; (* prevent integer overflow -- there should be no ML crashes. *) fun intfix0 n = n mod 200000000; fun intfix n = let val A = n mod 200000000 in if A<=100000000 then A else A-200000000 end; (* more care is required for multiplication to avoid overflow *) (* x*y = 2x*(y/2) = 2x*(y div 2 + y mod 2/2) = 2x*(y div 2) + x*y mod 2 *) fun multiply x y = if y=0 then 0 else if y<0 then intfix(multiply (~x) (~y)) else if y=1 then intfix x else intfix(multiply(intfix(2*x))(y div 2)+x*(y mod 2)); fun makestring n = Int.toString n; fun implode s = String.concat s fun explode s = List.map str (String.explode s); fun dropend s = let val A = rev (String.explode s) in if A<>nil andalso (hd A = #" " orelse hd A = #"_") then implode(map str (rev(tl A))) else s end; (* one can turn off the braces in program text display *) val BRACES = ref true; fun setbraces() = BRACES:=true; fun setnobraces() = BRACES:=false; fun isnumchar c = ord(c)>= ord(#"0") andalso ord(c)<=ord(#"9"); fun display (Bool x) = if x then "t" else "f" | display (Char x) = "'"^(str x) | display (Digits n) = display (Int n) | (* execution of an integer display will now put that integer on the stack *) display (Int x) = if x>=0 andalso x <= 9 then (makestring x) else if x>= ~9 andalso x < 0 then ((makestring (~x))^"_") else if x>9 then ((((display(Int(x div 10))))^ (display(Int(x mod 10))))) else if x< ~9 then ((display(Int(~x))))^("_") else "" | display (Program [x]) = if isnumchar x then if (!BRACES) then "{"^(str x)^"}" else str x else str x | display (Program L) = if (!BRACES) then "{"^(implode (map str L))^"}" else (implode (map str L)) | display (Stack L) = "["^(listdisplay L)^"]" and listdisplay nil = "" | listdisplay [x] = display x | listdisplay (Program[x]::Program[y]::L) = (display(Program[x]))^ (listdisplay(Program[y]::L)) | listdisplay (x::L) = (display x)^" "^(listdisplay L); val DEFINITIONS = ref [(#"x",[Stack nil])]; (* defined functions *) val _ = DEFINITIONS:=nil; val OPCODES = ref (!DEFINITIONS); val _ = OPCODES:=nil; (* management of the databases *) (* all databases are inhabited by lists so nil is a safe default object *) fun drop x nil = nil | drop x ((y,z)::L) = if x = y then drop x L else ((y,z)::drop x L); fun add x nil L = drop x L | add x y L = ((x,y)::drop x L); (* this is now safe. *) fun find x nil = nil | find x ((y,z)::L) = if x=y then z else find x L; fun foundin x nil = false | foundin x ((y,z)::L) = if x = y then true else foundin x L; (* the standard input buffer *) val INSTREAM = ref [#"x"]; val _ =INSTREAM:=nil; fun Tl nil = nil | Tl [x] = [x] | Tl x = tl x; (* the file database *) val FILES = ref [(#"a",[(TextIO.openOut("boojum.txt"),TextIO.openIn("boojum.txt"),true)])]; fun p1(x,y,z) = x; fun p2(x,y,z) = y; fun p3(x,y,z) = z; val _ = (TextIO.closeOut(p1(hd(find #"a" (!FILES)))); TextIO.closeIn((p2(hd(find #"a" (!FILES)))));FILES:=nil); fun getstringto c nil = nil | getstringto c (x::L) = if x=c then nil else (x::(getstringto c L)); fun crest c nil = nil | crest c (x::L) = if x=c then L else crest c L; val getquotestring = getstringto #"\""; fun despace nil = nil | despace (#" "::L) = despace L | despace (#"\n"::L) = despace L | despace (#"{"::L) = despace L | despace (#"}"::L) = despace L | despace L = L; (* the array (numerically addressed memory cells) *) val ARRAY=ref [(1,[Stack nil])]; val _ = ARRAY:=nil; fun quoterest s = despace((crest #"\"") s); fun getprogram nil = (say "Close bracket missing";nil) | getprogram ((#"]")::L) = nil | getprogram ((#"[")::L) = [#"["]@(getprogram L)@[#"]"]@(getprogram (programrest L)) | getprogram ((#"\"")::L) = [#"\""]@(getquotestring L)@[#"\""]@(getprogram (quoterest L)) | getprogram (x::L) = (x::(getprogram L)) and programrest nil = nil | programrest((#"]")::L) = despace L | programrest ((#"[")::L) = programrest (programrest L) | programrest ((#"\"")::L) = programrest (quoterest L) | programrest (x::L) = programrest L; fun numcharval c = ord(c)-ord(#"0"); (* num lists are reversed for evaluation *) fun numlisteval nil = 0 | numlisteval (n::L) = intfix(n+(multiply(10)(numlisteval L))); fun getnumlist nil = nil | getnumlist (c::L) = if isnumchar c then (c::(getnumlist L)) else nil; fun restnumlist nil = nil | restnumlist (c::L) = if isnumchar c then restnumlist L else (c::L); fun first nil = nil | first L = if hd L = #" " orelse hd L = #"\n" orelse hd L = #"{" orelse hd L = #"}" then first (tl L) else if hd L = #"\"" then ((#"\"")::((getquotestring (tl L))@[#"\""])) else if hd L = #"[" then ((#"[")::((getprogram (tl L))@[#"]"])) else if hd L = #"'" then if tl L = nil then (say "Character not identified";nil) else [hd L,hd(tl L)] else if hd L = #"`" then if tl L = nil then (say "Static opcode not identified";nil) else [hd L,hd(tl L)] else if hd L <> #"0" andalso isnumchar (hd L) then let val A = getnumlist L and B = restnumlist L in if B=nil then A else if hd(B) = #"_" then A@[#"_"] else A end else [hd L]; fun rest nil = nil | rest L = if hd L = #" " orelse hd L = #"\n" orelse hd L = #"{" orelse hd L = #"}" then rest (tl L) else if hd L = #"\"" then quoterest (tl L) else if hd L = #"[" then programrest (tl L) else if hd L = #"'" orelse hd L = #"`" then if tl L = nil then nil else despace(tl(tl L)) else if hd L <> #"0" andalso isnumchar (hd L) then let val A = getnumlist L and B = restnumlist L in if B = nil then nil else if hd B = #"_" then despace(tl B) else (despace B) end else despace(tl L); fun boolhead ((Bool x)::L) = true | boolhead x = false; val FILENAME = ref ""; fun openfile x ((Char c)::L) = (FILENAME:=(str c)^(!FILENAME);openfile x L) | openfile x L = if (!FILENAME) = "" then say "No file name read!" else (if not(foundin x (!FILES)) then FILES:=add x [(TextIO.openOut((!FILENAME)),TextIO.openIn((!FILENAME)),true)](!FILES) else say "This character is already bound to a file"; FILENAME:=""); (* open file to read only *) fun openfile2 x ((Char c)::L) = (FILENAME:=(str c)^(!FILENAME);openfile2 x L) | openfile2 x L = if (!FILENAME) = "" then say "No file name read!" else if not(foundin x (!FILES)) then (FILES:=(add x [(TextIO.openOut(("dummy")),TextIO.openIn((!FILENAME)),false)](!FILES)) handle Io x => say "No such file to open read-only") else (say "This character is already bound to a file"; FILENAME:=""); fun restfile ((Char c)::L) = restfile L | restfile L = L; fun help c = if c= "B" then say ("B converts the defined function associated with its character\n"^ "argument to a new opcode") else if c= "a" orelse c= "A" orelse c= "I" orelse c = "e" then say ("These commands manipulate the indexed data variables.\n\n"^ "I declares a variable and initializes it. The index is the first\n"^ "argument (second in the stack) and the value is second argument\n"^ "(top of stack). Variables can be declared again (local decs)\n\n"^ "e deallocates a variable declaration. This is useful for recovering\n"^ "a variable which was concealed by a local declaration. Deallocating\n"^ "an undeclared variable is fatal.\n\n"^ "A assigns a variable (first argument) a value (second argument)\n"^ "in the usual way. a returns the value of a variable (its first\n"^ "argument).") else if c= "O" orelse c = "R" orelse c = "W" orelse c = "F" orelse c = "Z" then say ("The basic file I/O commands are\n"^ "O open a file: use first character on stack as file ID, then \n"^ " use the rest of the characters as the name. R read a character\n"^ " from a file (ID read from top of stack. Puts a boolean on top of the\n"^ " stack: if the character is not read, just \"false\"; if a character is\n"^ " read it puts the character on then \"true\" on top.\n"^ "W write a character (second item) to a file ID (top).\n"^ "F closes a file (File ID on top of stack).\n"^ "Z opens a file to read only.\n"^ "R,W,F all crash if the file ID isn't found in the database.") else if c = "t" orelse c = "f" then say "t loads true onto the stack and f loads false onto the stack" else if c = "M" orelse c = "m" then say ("M executes the file whose ID is on top of the stack.\n"^ "m writes the function second on the stack to the file ID which\n"^ "is on top of the stack.") else if c = "s" then say "Tests whether the data stack is empty" else if c = "d" then say "Replaces the data stack with its top element (a stack)" else if c = "P" then say "Puts the program stack (continuation) on the top of the stack" else if c = "D" then say "Discards the current program stack and executes the function on top of the stack" else if c = "c" then say ("c is a type casting command: toggles between integers and characters,\n"^ "applying modular arithmetic to convert large or negative integers.") else if c = "C" then say ("C is a type casting command: it toggles between characters and\n"^ "inert opcodes") else if c = "t" orelse c = "T" orelse c = "U" orelse c = "V" then say ("The opcodes T,U,V implement environment functions useful for\n"^ "tracing. T toggles the trace function on and off. U gives the stack\n"^ "display. V gives the current continuation (pending commands).\n\n"^ "In the shell, T turns trace off and t turns it on." ) else if c = "b" orelse c = "X" then say ("In the shell b signals the beginning of a program: it appears\n"^ "on the line before the program begins; X ends the program\n"^ "(appearing at the beginning of a line") else if c = "L" orelse c = "S" then say ("L/S is a shell command: load/save from/to the following filename (which\n"^ "should be separated by a single space from the L or S -- the extension\n"^ ".sf will be supplied; S is also an opcode (copy the data stack to the top of itself)") else if c = "l" then say "This lists the current program in the shell" else if c = " " orelse c = "\n" then say ("Whitespace is ignored, and\n"^ "plays no essential role in Strictly False, with the exception that\n"^ "whitespace following a string of digits represents the opcode that\n"^ "reads multidigit numerals. The r opcode will print a carriage\n"^ "return.\n\n"^ "Space appears as the opcode when opcodes or whole programs are\n"^ "being executed from the stack and under some error conditions.") else if c = "?" then say ("The ? opcode is a conditional construct. Its first argument\n"^ "(second in stack) is boolean and if it is true the second argument\n"^ "(a function on top of the stack) is executed and otherwise discarded") else if c = "#" then say ("The # opcode is a loop construct. The top function is the body and\n"^ "the second function on the stack is the test. The test is run first;\n"^ "as long as the test leaves a (consumed) truth value of true on\n"^ "top of the stack the body will be repeated. A truth value of false\n"^ "causes the body to be discarded. A non-truth value crashes.") else if c = "!" then say ("The function at the top of the stack is unpacked and placed\n"^ "on top of the stack. This is intended to serve as function\n"^ "application, but it is more general.") else if c = "`" then say ("This is a pseudo-opcode. For any character X, `X is effectively\n"^ "another character with the meaning [X] (a function with X in it).\n"^ "This provides an inert form in which opcodes can be inserted into\n"^ "functions by the o command. Totally different from False. When\n"^ "executed this item is put on the stack.") else if c = "'" then say ("This is a pseudo-opcode. 'X is the character X. (push this\n"^ "on the stack)") else if c = "n" then say ("This is the empty stack considered as a program: push it\n"^ "onto the stack.") else if c = "p" then say ("This is a new capability in Pure False: the top item on the\n"^ "stack is pushed into the second item on the stack (a function)\n"^ "(as first item). This allows a theoretically interesting bit\n"^ "of function editing (along with the o command)\n"^ "Both arguments are removed and replaced with the result.") else if c = "o" then say ("The first and second elements of the stack, functions,\n"^ "are composed (the first one to be done first), removed from\n"^ "the stack and replaced with the composition. In combination\n"^ "with the p command, a theoretically interesting degree of\n"^ "function editing is obtained.") else if c = "%" then say "Drop the top element from the stack" else if c = "\\" then say "Swap the top two elements of the stack" else if c = "@" then say "Rotates third element of the stack to the top: xyz->zxy" else if c = "$" then say "Duplicate the top element of the stack" else if c = "0" orelse c = "1" orelse c = "2" orelse c = "3" orelse c = "4" orelse c = "5" orelse c = "6" orelse c = "7" orelse c = "8" orelse c = "9" orelse c = "_" then say ("Each digit is an opcode, loading that digit onto the stack.\n"^ "\" \" is a special opcode which reads multidigit numbers of any\n"^ "length (so a multidigit number must be followed by a space to be\n"^ "read as a single item: otherwise it will be executed as a list of\n"^ "digits); _ is similar to space except that it reads negative integers\n"^ "(notice that _ is _not_ a general purpose unary negation operator;\n"^ "it cannot be expected to work correctly except following a string\n"^ "of digits (though it sometimes might)." ) else if c = "^" then say ("This is character input: a single character from standard input\n"^ "is placed on the stack. This is the only primitive input command.\n\n"^ "Input is buffered: you can type as many characters as you like\n"^ "at the input prompt >> and the program will accept these as needed.\n"^ "The ) command clears this buffer of any unused characters.") else if c = "," orelse c = "." orelse c = "r" orelse c = "q" then say ("There are four output commands. , prints (and consumes) the\n"^ "character on the stack. . prints (and consumes) the integer on\n"^ "the stack. Integer output can be multi-digit (impure but\n"^ "convenient) and is preceded by a space.\n"^ "Type errors cause crashes. q prints a quote and r\n"^ "effects a carriage return.\n\n"^ "in the shell, q means quit") else if c = "+" orelse c = "-" orelse c = "*" orelse c = "/" then say ("These are the usual integer arithmetic operations. Two items\n"^ "are popped off the stack and operated on and replaced with the\n"^ "result (the second item on the stack is first argument)\n\n"^ "Support for additional operations (unary minus and mod) is likely\n"^ "to be added. Integers are expected: type errors cause crashes.") else if c = "=" orelse c = "<" orelse c = ">" then say ("Comparison operators: overloaded to compare integers to each other\n"^ "or characters to each other. Type errors stop the show. Two arguments\n"^ "are popped off the stack, compared and replaced with the appropriate\n"^ "truth value.\n\n"^ "Functions can also be compared (dangerous): in this case\n"^ "the arguments are not consumed!") else if c = "~" orelse c = "&" orelse c = "|" then say ("Logical operations. ~ is logical negation (unary) and the others\n"^ "are binary. The appropriate number of arguments, which must be\n"^ "truth values, is popped off the stack and replaced with the result.") else if c = ":" orelse c = ";" orelse c = "E" then say ("Each character can be used as a variable. Only functions can\n"^ "be assigned as variable values (though it is easy to hack around this\n"^ "with the help of p and o). : takes two arguments: the top of the\n"^ "stack is a character (one must use ' to address a specific character\n"^ "literally, not as in False) and the second item on the stack is a function\n"^ "which is bound to that variable. Both are discarded. ; takes one\n"^ "argument, a character (consumed): the associated function is unpacked onto the\n"^ "stack and executed (it does not need to be applied with !)\n\n"^ "The E command is like ; but does not execute the function." ) else if c = ")" then say ("This command flushes the ML output buffer and the interpreter's\n"^ "input buffer.") else if c = "\"" then say ("Characters enclosed in quotes are printed to standard output\n"^ "and discarded. The Hello, world function is \"Hello, world\"!\n\n"^ "The r command allows printing of a quote; returns in strings\n"^ "are allowed by Pure False but difficult to produce in ML.\n"^ "The q command allows printing of a double quote") else if c = "[" then say ("Characters enclosed in brackets are a function (a stack placed\n"^ "on the stack). Brackets can be nested. The ! command executes\n"^ "a bracketed function (removes it from the stack, unpacks it\n"^ "and places all its contents on the stack). Some other commands\n"^ "can do this as well (? # ;). The p and o commands allow manipulation\n"^ "of functions, which was not supported in False.") else if c = "i" orelse c = "j" orelse c = "x" then say ("i allows execution of one step in the function on the top of the\n"^ "stack: remove the function from the stack, supply the top element\n"^ "to the stack and execute, then replace the tail of the function;\n"^ "of course this also allows functions with data in them to serve\n"^ "as list data structures. j is a static version: put the head of\n"^ "the function on in a 1-element list, then put the tail of the function on.\n"^ "x tests the function on top of the stack to see if it is empty\n"^ "(note that underflow is a show-stopper!); x does not remove the function,\n"^ "just adds the truth value concerning its emptiness or lack thereof.") else if c = "{" then say ("Comments begin with { and end with }. They may be nested and multi-line.\n\n"^"In displayed stack, braces indicate executable program text embedded in lists.") else say ("No help available on "^c); (* this should produce a standard expanded form of a term without embedded program text (with one exception) *) (* notext is now a misnomer: it creates a standard form for program text, but it does not convert it to data *) fun notextitem [#"'",x] = Char x | notextitem [#"`",x] = if ord(x) >= ord (#"0") andalso ord(x) <= ord(#"9") then Stack[Int (ord(x)-ord(#"0"))] else Stack[Program[x]] | notextitem [x] = if ord(x) >= ord (#"0") andalso ord(x) <= ord(#"9") then Int (ord(x)-ord(#"0")) else Program [x] | notextitem (#"["::L) = (Stack(notextlist(rev(tl(rev L))))) | notextitem (#"\""::L) = Program(#"\""::L) | (* no other representation for this! *) notextitem (x::L) = if isnumchar x then if hd(rev(x::L)) = #"_" then Int(~(numlisteval (map numcharval (tl(rev(x::L)))))) else Int(numlisteval (map numcharval (rev(x::L)))) else Char (chr 0) | notextitem nil = Char (chr 0) and notextlist nil = nil | notextlist (#" "::L) = notextlist L | notextlist (#"\n"::L) = notextlist L | notextlist L = (notextitem(first L))::(notextlist(rest L)) and notextlist2 ((Program L)::M) = (notextlist L)@(notextlist2 M) | notextlist2 ((Stack L)::M) = (notext(Stack L))::(notextlist2 M) | notextlist2 (x::M) = x::(notextlist2 M) | notextlist2 nil = nil and notext (Stack L) = Stack(notextlist2 L) | notext T = T; fun getnumlist2 (Digit::(Int n)::L) = if n>=0 andalso n<=9 then n::(getnumlist2 L) else nil | getnumlist2 x = nil; fun restnumlist2 (Digit::(Int n)::L) = if n>=0 andalso n<=9 then restnumlist2 L else ((Int n)::L) | restnumlist2 x = x; fun posintread L = let val M = getnumlist2 L in if M= nil then L else ((Int(numlisteval M))::(restnumlist2 L)) end; fun negintread L = let val M = getnumlist2 L in if M = nil orelse hd (M) = 0 then L else ((Int(intfix(~(numlisteval M))))::(restnumlist2 L)) end; val TRACE = ref true; val PAUSE = ref true; fun settrace() = TRACE:=true; fun setnotrace() = TRACE := false; fun setpause() = PAUSE:=true; fun setnopause() = PAUSE:=false; (* fun show code L = if (!TRACE) then (TextIO.output(TextIO.stdOut, "\n opcode: "^(str code)^"\n\n stack: "^(display(Stack L))^"\n\n");TextIO.flushOut(TextIO.stdOut); if (!PAUSE) then INSTREAM:=((String.explode(TextIO.inputN(TextIO.stdIn,1)))@(!INSTREAM)) else (); L) else L; *) fun show code L = if (!TRACE) then (TextIO.output(TextIO.stdOut, "\n opcode: "^(str code)^"\n\n stack: "^(display(Stack L))^"\n\n"); TextIO.flushOut(TextIO.stdOut); if (!PAUSE) then TextIO.inputN(TextIO.stdIn,1) else ""; L) else L; fun nodigits (Digits n ::L) = (Int n::(nodigits L)) | nodigits (x::L) = (x::(nodigits L)) | nodigits nil = nil; (* fun mark0 ((Int 0)::Digit::L) = (Digit::(Int 0)::Digit::L) | mark0 L = L; *) (* correct text of defined opcodes to retain recursion *) fun correctrecsubs x nil = nil | correctrecsubs x (#"'"::x1::(#";")::L) = if x = x1 then (x::(correctrecsubs x L)) else (#"'"::x1::(#";")::(correctrecsubs x L)) | correctrecsubs x (y::L) = (y::(correctrecsubs x L)); fun correctrec x A = let val AA = String.explode(listdisplay A) in [Program(correctrecsubs x AA)] end; fun decomment nil = nil | decomment (#"{"::L) = crest (#"}") (decomment L) | decomment (x::L) = x::(decomment L); (* the interpreter engine *) fun (* ignore whitespace (except for lookahead with integers)*) Execute ((#" ")::P) L = Execute (P) L | Execute (#"\n"::P) L = Execute P L | (* ignore braces from program text display *) Execute ((#"{")::P) L = Execute (P) L | Execute (#"}"::P) L = Execute P L | (* program text objects could be constructed out of opcodes but in practice are not. The distinction is usually transparent, except for equality *) (* reorganization of text program structures *) Execute P ((Stack((Program nil)::L))::M) = Execute P ((Stack L)::M) | (* Execute P ((Stack((Program [x])::L))::M) = Execute P ((Stack((OpCode(x))::L))::M) | *) (* Execute P ((Stack((Program L)::(Program M)::N))::S) = Execute P ((Stack(Program (L@M)::N))::S) | *) (* opcodes and program text on stack -- introduced by application *) (* Execute P ((OpCode x)::L) = Execute (x::P) (show (#" ")L) | *) Execute P ((Program Q)::L) = Execute (Q@P) (show (#" ")L) | (* read multidigit numerals *) (* Execute (#" "::P) (Digit::L) = Execute P (show (#" ")(posintread (Digit::L))) | Execute (#"_"::P) (Digit::L) = Execute P (show (#"_")(negintread (Digit::L))) | Execute (#" "::P) L = Execute P L | Execute (#"0"::P) L = (Execute P (show(#"0") (mark0(Int 0::L)))) | Execute (#"1"::P) L = (Execute P (show(#"1")(Digit::Int 1::( L)))) | Execute (#"2"::P) L = (Execute P (show(#"2")(Digit::Int 2::( L)))) | Execute (#"3"::P) L = (Execute P (show(#"3")(Digit::Int 3::( L)))) | Execute (#"4"::P) L = (Execute P (show(#"4")(Digit::Int 4::( L)))) | Execute (#"5"::P) L = (Execute P (show(#"5")(Digit::Int 5::( L)))) | Execute (#"6"::P) L = (Execute P (show(#"6")(Digit::Int 6::( L)))) | Execute (#"7"::P) L = (Execute P (show(#"7")(Digit::Int 7::( L)))) | Execute (#"8"::P) L = (Execute P (show(#"8")(Digit::Int 8::( L)))) | Execute (#"9"::P) L = (Execute P (show(#"9")(Digit::Int 9::( L)))) | Execute P (Digit::L) = Execute P L | Execute P ((Stack(Digit::M))::L) = Execute P ((Stack(M))::L) | *) Execute (#"1"::P) ((Digits n)::L) = if P <> nil andalso isnumchar(hd P) then Execute (P) ((Digits(intfix(1+multiply 10 n)))::L) else Execute (P) (show #"1" ((Int(intfix(1+multiply 10 n)))::L)) | Execute (#"1"::P) L = if P<>nil andalso isnumchar (hd P) then Execute (P) (Digits 1::L) else Execute (P) (show #"1" (Int 1::L)) | Execute (#"2"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(2+multiply 10 n)))::L) else Execute (P) (show #"2" ((Int(intfix(2+multiply 10 n)))::L)) | Execute (#"2"::P) L = if P<>nil andalso isnumchar (hd P) then Execute (P) (Digits 2::L) else Execute (P) (show #"2" (Int 2::L)) | Execute (#"3"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(3+multiply 10 n)))::L) else Execute (P) (show #"3" ((Int(intfix(3+multiply 10 n)))::L)) | Execute (#"3"::P) L = if P<>nil andalso isnumchar (hd P) then Execute (P) (Digits 3::L) else Execute (P) (show #"3" (Int 3::L)) | Execute (#"4"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(4+multiply 10 n)))::L) else Execute (P) (show #"4" ((Int(intfix(4+multiply 10 n)))::L)) | Execute (#"4"::P) L = if P <> nil andalso isnumchar(hd P) then Execute (P) (Digits 4::L) else Execute (P) (show #"4" (Int 4::L)) | Execute (#"5"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(5+multiply 10 n)))::L) else Execute (P) (show #"5" ((Int(intfix(5+multiply 10 n)))::L)) | Execute (#"5"::P) L = if P<>nil andalso isnumchar(hd P) then Execute (P) (Digits 5::L) else Execute (P) (show #"5" (Int 5::L)) | Execute (#"6"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(6+multiply 10 n)))::L) else Execute (P) (show #"6" ((Int(intfix(6+multiply 10 n)))::L)) | Execute (#"6"::P) L = if P<>nil andalso isnumchar (hd P) then Execute (P) (Digits 6::L) else Execute (P) (show #"6" (Int 6::L)) | Execute (#"7"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(7+multiply 10 n)))::L) else Execute (P) (show #"7" ((Int(intfix(7+multiply 10 n)))::L)) | Execute (#"7"::P) L = if P <> nil andalso isnumchar (hd P) then Execute (P) (Digits 7::L) else Execute (P) (show #"7" (Int 7::L)) | Execute (#"8"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(8+multiply 10 n)))::L) else Execute (P) (show #"8" ((Int(intfix(8+multiply 10 n)))::L)) | Execute (#"8"::P) L = if P<>nil andalso isnumchar(hd P) then Execute (P) (Digits 8::L) else Execute (P) (show #"8" (Int 8::L)) | Execute (#"9"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(9+multiply 10 n)))::L) else Execute (P) (show #"9" ((Int(intfix(9+multiply 10 n)))::L)) | Execute (#"9"::P) L = if P<>nil andalso isnumchar(hd P) then Execute (P) (Digits 9::L) else Execute (P) (show #"9" (Int 9::L)) | Execute (#"0"::P) ((Digits n)::L) = if P<>nil andalso isnumchar (hd P) then Execute (P) ((Digits(intfix(0+multiply 10 n)))::L) else Execute (P) (show #"0" ((Int(intfix(0+multiply 10 n)))::L)) | Execute (#"0"::P) L = Execute P (show #"0" (Int 0::L)) | Execute P ((Digits n)::L) = Execute P ((Int n)::L) | Execute P ((Stack(Digits n::M))::L) = Execute P ((Stack((Int n)::M))::L) | (* two kinds of executables on the stack: program text objects and opcodes. *) (* finished with program *) Execute nil L = show (#" ")L | (* control structures *) (* this is the original False conditional; just take out the brackets around tests and current programs ought to work *) (* it's much simpler... *) Execute (#"?"::P) ((Stack y)::(Bool true)::L) = Execute (#"!"::P) (show (#"?")((Stack y)::L)) | Execute (#"?"::P) ((Stack y)::(Bool false)::L) = Execute P (show (#"?") L) | (* the loop construction -- notice that the pending future executions are now on the program stack *) Execute ((#"#")::P) ((Stack y)::(Stack x)::M) = Execute (#"!":: (String.explode( display( Stack(y@ [Stack x]@ [Stack y]@ [Program [#"#"]])))@ [#"?"]@ P)) (show (#"#") ((Stack x)::M)) | (* application *) Execute (#"!"::P) ((Stack M)::L) = (Execute P (show(#"!")((Program(String.explode(listdisplay M)))::(L)))) | (* inert forms of opcodes *) (* something needs to be done with iterated ` and `'s followed by ' *) (* answer: ` should not be iterated: it is strictly used to put active opcodes in inert form: `x is synoymous with [x] only for single characters (and this is only meaningful if x is an opcode) *) (* deferred crashes can be caused by misuse of `, since the system does not check for meaningfulness of such opcodes *) Execute (#"`"::x::P) L = (* if ord(x)>=ord(#"0") andalso ord(x)>=ord(#"9") then (Execute P (show(#"`")(Stack [Int (ord(x)-ord(#"0"))]::(L)))) else (Execute P (show(#"`")(Stack [OpCode x]::(L))))*) Execute P (show (#"`") ((Stack[Program [x]])::L)) | (* character constants *) Execute (#"'"::x::P) L = (Execute P (show(#"'")(Char x::(L)))) | (* the empty stack *) Execute (#"n"::P) L = (Execute P (show(#"n")(Stack nil::(L)))) | (* add to stack at front *) Execute (#"p"::P) (x::(Stack M)::L) = (Execute P (show(#"p")((Stack (x::M))::(L)))) | (* compose stacks -- needed to add opcodes at front *) (* this is analogous to ! in a certain sense *) Execute (#"o"::P) ((Stack L)::(Stack M)::N) = (Execute P (show(#"o")(Stack (nodigits((L)@M))::N))) | (* executes first command in a function; also implements hd, tl *) (* needs to dissect text program items *) (* contrary to misinformed comments above, i can be used to implement trace *) Execute (#"i"::P) ((Stack ((Program L)::N))::M) = Execute ((String.explode(display(Stack (((Program(rest L))::N)))))@P) (show(#"i") ((Program(first L))::M)) | (* this is a static [hd]/tl operation; it is needed to avoid the peculiar effects of popping opcodes *) (* there should be an underflow error exception for j; there is none for i because an empty stack is simply a skip command and disappears when executed. I think there is for i now, too *) Execute (#"j"::P) ((Stack ((Program (x::L))::N))::M) = Execute P (show (#"j")(( (Stack ((Program(rest ((x::L))))::N)))::(Stack [Program(first ((x::L)))])::M)) | Execute (#"i"::P) ((Stack (y::N))::M) = Execute ((String.explode(display (Stack (tl(nodigits(y::N))))))@P) (show (#"i") ((hd(nodigits(y::N)))::M)) | Execute (#"j"::P) ((Stack (y::N))::M) = Execute P (show (#"j")((Stack (tl(nodigits (y::N)))):: (Stack ([hd(nodigits(y::N))])::M))) | Execute (#"x"::P) ((Stack M)::L) = Execute P (show(#"x")(Bool(M=nil)::(Stack M)::L)) | (* drop *) Execute (#"%"::P) ((y::L)) = (Execute P (show(#"%")((L)))) | (* swap *) Execute (#"\\"::P) ((x::y::L)) = (Execute P (show(#"\\")((y::x::(L))))) | (* swap with third item -- changed back to rot in False *) Execute (#"@"::P) ((x::y::z::L)) = (Execute P (show(#"@")(z::x::y::(L)))) | Execute (#"$"::P) (x::L) = (Execute P (show(#"$")(x::x::L))) | (* character input *) (* I took out the prompt: this is easily provided by the user *) Execute (#"^"::P) (L) = (Execute P (show(#"^")( Char(if (!INSTREAM) <> nil then let val A = hd (!INSTREAM) in (INSTREAM:=tl(!INSTREAM);A) end else (TextIO.flushOut(TextIO.stdOut); INSTREAM:=(rev(Tl(rev(((String.explode(TextIO.input(TextIO.stdIn))))))))@ (!INSTREAM);let val A = hd (!INSTREAM) in (INSTREAM:=tl(!INSTREAM);A) end)) ::L))) | (* character output *) Execute (#","::P) (Char x::L) = ((TextIO.output(TextIO.stdOut,str x);Execute P (show(#",") L))) | (* integer output *) (* this is impure but easy *) Execute (#"."::P) (Int x::L) = ((TextIO.output(TextIO.stdOut," "^makestring x);Execute P (show(#".") L))) | (* print a carriage return *) Execute (#"r"::P) L = (TextIO.output(TextIO.stdOut,"\n");Execute P (show(#"r") L)) | (* print a quotation mark *) Execute (#"q"::P) L = ((TextIO.output(TextIO.stdOut,"\"");Execute P (show(#"q") L))) | (* arithmetic *) (* intfix converts everything to mod 200000000 and makes numbers greater than 100000000 negative; this averts overflow. For multiplication, a special function is needed to make this safe. *) Execute (#"+"::P) ((Int y)::(Int x)::L) = (Execute P (show(#"+") ((Int(intfix(x+y)))::L))) | Execute (#"*"::P) ((Int y)::(Int x)::L) = (Execute P (show(#"*") ((Int(multiply x y))::L))) | Execute (#"-"::P) ((Int y)::(Int x)::L) = (Execute P (show(#"-")((Int(intfix(x-y)))::L))) | Execute (#"/"::P) ((Int y)::(Int x)::L) = if y=0 then (say "Division by zero";show(#" ")((Int y)::(Int x)::L))else (Execute P (show(#"/")((Int(intfix(x div y)))::L))) | (* unary negation is back! *) Execute (#"_"::P) ((Int x)::L) = Execute P (show (#"_")(Int (intfix(~x))::L)) | (* arithmetic tests *) Execute (#"="::P) ((Int x)::(Int y)::L) = (Execute P (show(#"=")((Bool(x = y))::L))) | Execute (#"<"::P) ((Int y)::(Int x)::L) = (Execute P (show(#"<")((Bool(x < y))::L))) | Execute (#">"::P) ((Int y)::(Int x)::L) = (Execute P (show(#">")((Bool(x > y))::L))) | (* character tests *) Execute (#"="::P) ((Char x)::(Char y)::L) = (Execute P (show(#"=")((Bool(x = y))::L))) | Execute (#"<"::P) ((Char y)::(Char x)::L) = (Execute P (show(#"<")((Bool(x < y))::L))) | Execute (#">"::P) ((Char y)::(Char x)::L) = (Execute P (show(#">")((Bool(x > y))::L))) | (* function equality test: note that arguments are not consumed! *) (* the effects of the usually transparent Program construction (programs from text) are visible to = at the moment; I suppose I could fix this but one should not expect an equality operator on programs to work! *) (* the notext function should make this honest *) Execute (#"="::P) ((Stack N)::(Stack M)::L) = (Execute P (show(#"=")(((Bool(notextlist2 N=notextlist2 M)) ::(Stack N)::(Stack M)::L)))) | (* logic *) Execute (#"t"::P) L = Execute P (show (#"t")((Bool true)::L)) | Execute (#"f"::P) L = Execute P (show (#"f")((Bool false)::L)) | Execute (#"~"::P) ((Bool x)::L) = (Execute P (show(#"~")((Bool(not(x)))::L))) | Execute (#"&"::P) ((Bool x)::(Bool y)::L) = (Execute P (show(#"&")((Bool(x andalso y))::L))) | Execute (#"|"::P) ((Bool x)::(Bool y)::L) = (Execute P (show(#"|")((Bool(x orelse y))::L))) | Execute (#"="::P) ((Bool x)::(Bool y)::L) = (Execute P (show (#"=") ((Bool(x=y))::L))) | (* casting *) (* character/integer *) Execute (#"c"::P) ((Int x)::L) = Execute P (show (#"c")((Char (chr(x mod 256))::L))) | Execute (#"c"::P) ((Char x)::L) = Execute P (show (#"c")((Int(ord x))::L)) | (* character/opcode *) Execute (#"C"::P) ((Char x)::L) = (* if ord(x)>= ord(#"0") andalso ord(x)<=ord(#"9") then Execute P (show (#"C")((Stack([Int (ord(x)-ord(#"0"))]))::L)) else Execute P (show (#"C")((Stack([OpCode x]))::L)) *) Execute P (show (#"C")((Stack([Program[x]]))::L)) | Execute (#"C"::P) ((Stack([Program [x]]))::L) = Execute P (show (#"C")((Char x)::L)) | (* Dangerous machine manipulations: access and manipulate the data stack and program stack (!) as objects *) (* data stack access *) (* is the data stack empty? *) Execute (#"s"::P) L = if L = nil then Execute P (show (#"s")((Bool true)::L)) else Execute P (show (#"s")((Bool false)::L)) | (* get the data stack as an object *) Execute (#"S"::P) L = Execute P (show (#"S")((Stack((nodigits L)))::(nodigits L))) | (* replace the data stack with its top element *) Execute (#"d"::P) ((Stack M)::L) = Execute P (show (#"d") M) | (* program stack access *) (* P and D together allow something like continuations *) (* get the program stack as an object *) Execute (#"P"::P) L = Execute P (show (#"P")(Stack([Program P])::L)) | (* replace the program stack with the function on top of the stack *) (* nD is "stop"! *) (* note that before D is executed, all opcodes and program texts on the data stack have already been put into the program stack; so the program text/opcode distinction is still transparent *) Execute (#"D"::P) L = Execute [#"!"] (show (#"D") L) | (* indirection: only function definitions are allowed *) Execute (#":"::P) ((Char x)::(Stack y)::L) = ((DEFINITIONS := add x y (!DEFINITIONS); Execute P (show(#":") L))) | Execute (#";"::P) ((Char x)::L) = let val A = find x (!DEFINITIONS) in if A = nil then (say "Definition not found"; show #" " L) else (Execute (#"!"::P) (show(#";")((Stack (A))::L)))end | Execute (#"E"::P) ((Char x)::L) = let val A = find x (!DEFINITIONS) in if A = nil then (say "Definition not found"; show #" " L) else (Execute (P) (show(#"E")((Stack (A))::L)))end | (* define a new opcode using a : definition *) (* this is static: there is no way to remove a defined opcode *) (* correctrec should fix it so that recursion works correctly *) Execute (#"B"::P) ((Char x)::L) = if find x (!OPCODES) <> nil then (say "Opcode already defined"; show #" " L) else let val A = find x (!DEFINITIONS) in if A = nil then (say ("Definition not found");show #" " L) else (OPCODES:= add x (correctrec x A) (!OPCODES);Execute P (show (#"B") L)) end | (* flushes input and output streams *) Execute (#")"::P) L = (TextIO.flushOut(TextIO.stdOut);INSTREAM:=nil; Execute P (show(#")") L)) | (* file I/O *) (* open a file *) Execute (#"O"::P) ((Char x)::L) = (if foundin x (!FILES) then (say "File already exists";show (#" ") L) else (FILENAME:="";openfile x L; if not(foundin x (!FILES)) then (say"File not created"; show (#" ") L) else (Execute P (show (#"O") (restfile L))))) | (* open a file to read only *) Execute (#"Z"::P) ((Char x)::L) = (if foundin x (!FILES) then (say "File already exists";show (#" ") L) else (FILENAME:="";openfile2 x L; if not(foundin x (!FILES)) then (say"File not created"; show (#" ") L) else (Execute P (show (#"Z") (restfile L))))) | (* read a character of input from a file *) Execute (#"R"::P) ((Char x)::L) = if not(foundin x (!FILES)) then (say "File not found";show (#" ") L) else let val A = (TextIO.flushOut(p1(hd(find x (!FILES)))); TextIO.inputN(p2(hd(find x (!FILES))),1)) in if A = "" then (Execute P (show (#"R")((Bool false)::L))) else Execute P (show (#"R")((Bool true)::(Char(hd(String.explode A)))::L)) end | (* write a character of output to a file *) Execute (#"W"::P) ((Char x)::(Char y)::L) = if not (foundin x (!FILES)) then (say "File not found";show (#" ") L) else if not(p3(hd(find x (!FILES)))) then (say "File is read only"; show (#" ") L) else (TextIO.output(p1(hd(find x (!FILES))),str y); TextIO.flushOut(p1(hd(find x (!FILES)))) ;Execute P (show (#"W")L)) | (* close file *) Execute (#"F"::P) ((Char x)::L) = if not(foundin x (!FILES)) then (say "File not found to close";show #" " L) else (TextIO.flushOut(p1(hd(find x (!FILES)))); TextIO.closeOut(p1(hd(find x (!FILES)))); TextIO.closeIn(p2(hd(find x (!FILES)))); FILES := drop x (!FILES); Execute P (show (#"F") L)) | (* execute a file *) Execute (#"M"::P) ((Char x)::L) = if not(foundin x (!FILES)) then (say "File not found";show (#"M") L) else (TextIO.flushOut((p1(hd(find x (!FILES))))); Execute ((decomment(String.explode(TextIO.input(p2(hd(find x (!FILES)))))))@P) (show (#"M") L)) | (* write a function to a file *) Execute (#"m"::P) ((Char x)::(Stack M)::L) = if not (foundin x (!FILES)) then (say "File not found";show (#"m") L) else if not(p3(hd(find x (!FILES)))) then (say "File is read only"; show (#"m") L) else (TextIO.output(p1(hd(find x (!FILES))),listdisplay M); TextIO.flushOut(p1(hd(find x (!FILES)))); Execute P (show (#"m") L)) | Execute (#"\""::P) L = (TextIO.output(TextIO.stdOut,implode(map str (getquotestring P))); Execute (quoterest P) (show(#"\"") L)) | Execute (#"["::P) L = Execute (programrest P) (show (#"[")(notext(Stack[Program(getprogram P)])::L)) | (* array commands *) (* initialize a variable (or locally redeclare it) *) Execute (#"I"::P) (x::(Int n)::L) = Execute P ((let val A = find n (!ARRAY) in ARRAY:= add n (x::A) (!ARRAY) end);show #"I" L) | (* free a variable *) Execute (#"e"::P) ((Int n)::L) = let val A = find n (!ARRAY) in if A = nil then (say "Deallocation failed";show #" " L) else (ARRAY := add n (tl A) (!ARRAY);Execute P (show #"e" L)) end | (* assign to a variable *) Execute (#"A"::P) (x::(Int n)::L) = let val A = find n (!ARRAY) in if A = nil then (say "Assignment failed";show #" " L) else (ARRAY:=add n (x::(tl A)) (!ARRAY);Execute P(show #"A" L)) end | (* return value of a variable *) Execute (#"a"::P) ((Int n)::L) = let val A = find n (!ARRAY) in if A = nil then (say "Variable is undefined";show #" " L) else Execute P (show #"a" ((hd A)::L)) end | (* toggle the trace feature *) Execute (#"T"::P) L = (TRACE := not(!TRACE);PAUSE:=not(!PAUSE);Execute P L) | (* display the stack *) Execute (#"U"::P) M = (say (display(Stack M));TextIO.flushOut(TextIO.stdOut); Execute P M) | (* display the current continuation *) Execute (#"V"::P) M = (say (implode (map str P)); Execute P M) | Execute (#"h"::P) ((Char c)::L) = (help (str c);Execute P L) | Execute (x::P) L = if foundin x (!OPCODES) then Execute (#"!"::P) (show x ((Stack(find x (!OPCODES)))::L)) else ((TextIO.output(TextIO.stdOut,"\n\nStopped (usually due to type errors)\n\n");(show x L))); (* we need a preprocessor with the less ambitious aim of removing comments (the first version tried to eliminated quoted strings and brackets! *) (* our aim is to use the form {...} and allow nested comments *) (* the interpreter *) val THESTACK = ref [Program [#"p"]]; val _ = THESTACK:=nil; fun execute s = (THESTACK:= (Execute (decomment (String.explode s)) (!THESTACK)); say "\n\n"); fun getlines() = let val A = String.explode(TextIO.input(TextIO.stdIn)) in if A = [#"\n"] then nil else A@(getlines()) end; fun executelines() = (THESTACK:=Execute (decomment(getlines())) (!THESTACK);say "\n\n"); (* examples (* calculates powers of 2 recursively *) execute"[$1[=$]![2\\@%]?[~]![1-'e;$+]?]'e:"; *) (* more examples trace utility: trace execution of the function on top of the stack: "[[x~]{while it is not empty}[i"the stack:"rUr"the continuation:"rVr]#!]'t:" example execute "[\"Do you want to compare characters? \")^'y=][\"Input two characters: \")^^r=$['y,]?~['n,]?r]#"; S example 4 [$[1+]!\[[*]\p]!!] ! nd 4 [1+] [n[!!]o[[*]\p]p[!\]o\p[$]o] !! nd 4 [1+] [[*]\p] [n[p[!\]o\p[$]o]o\p[n[!!]o]o] !!! [n[p[!\]o\p[$]o]o\p[n[!!]o]o] is the S combinator! *)