Commits

catseye  committed a5062da

Initial import of WIP Deturgenchry documentation and implementation.

  • Participants

Comments (0)

Files changed (6)

+#!/bin/sh
+
+mkdir -p bin
+cd src && ghc Main.hs -o ../bin/deturgenchry
+#!/bin/sh
+
+rm -f src/*.o src/*.hi bin/deturgenchry
+

File doc/Deturgenchry.markdown

+The Deturgenchry Programming Language
+=====================================
+
+WORK IN PROGRESS  
+Version 0.x, sometime in the twenty-tens  
+Chris Pressey, Cat's Eye Technologies
+
+Introduction
+------------
+
+_Deturgenchry_ is a simple object-oriented language with several
+distinguishing features.
+
+First, Deturgenchry is a _single-assignment_ language.  Neither local (to a
+method) bindings, nor the members of an object, are mutable: they may not
+be changed.  Another local binding with a new name must be used, or another
+instance of the object (with a new value substituted for the given member)
+must be created.
+
+Second, the implicit parameter `self` passed to a method does not refer
+directly to the object instance on which the method was invoked; it refers
+to the *method* instance, currently executing.  To get to the object
+instance you have to say `self.object`.  And, since this is the currently
+executing method instance, this is maybe where the local variables live:
+`self.x`, `self.y`, etc.
+
+Third, unlike most OO languages where only a single implicit `self`
+parameter is passed, in Deturgenchry *two* parameters are passed implicitly:
+the `self` and the `other`.  This dark symmetry is in honour of modern
+psychoanalytic mumbo-jumbo or whatever.  The `other` refers to the method
+instance that called the currently executing method.
+
+Fourth, there is no `return` statement.  Instead, the `other` is
+reactivated.
+
+This could possibly lead to a restriction: each method may contain only
+*one* call site for any given method.  That is, no method may contain more
+than one call to any given method inside its definition.  This allows the
+correct "return zone" to be known when re-activating the `other`: it is just
+after the (unique, we now know) location of the call to the current method.
+
+(Of course, there may be a problem with this if the `other` is stored
+somewhere and passed to a method that the `other` did not directly call...)
+
+Example
+-------
+
+    class Junk {
+      method do_it(n) {
+        self' = (self.x = n)
+        pass other {self', self.y}
+      }
+    }
+
+"Discussion"
+------------
+
+Recall that one way to make a recursive anonymous function /x/ is to pass
+/x/ as the first argument of the function.  The function then invokes this
+parameter to recurse.
+
+This opens up a few possibilities.  This first argument can be made implicit
+and can be called `self`.  Further, self need not always be self exactly
+(like how `self` can be a subclass in OO code.)  Further still, `self` could
+be a continuation which is (semi-)implicitly continued.
+
+Grammar
+-------
+
+    Program      ::= {ClassDefn}.
+    ClassDefn    ::= "class" name "{" {MethodDefn} "}".
+    MethodDefn   ::= "method" name "(" [name {"," name}] ")" Statement.
+    Statement    ::= Block | Conditional | Transfer | Assignment.
+    Block        ::= "{" {Statement} "}".
+    Conditional  ::= "if" Expr Statement "else" Statement.
+    Transfer     ::= "pass" Expr Expr.
+    Assignment   ::= name<new,local> "=" Expr.
+    Expr         ::= RefExpr
+                   | "new" name<class>
+                   | IntegerLiteral.
+    RefExpr      ::= name<local> {"." name} [SetExpr | CallExpr].
+    SetExpr      ::= "[" name "=" Expr {"," name "=" Expr} "]".
+    CallExpr     ::= "(" Expr {"," Expr} ")"].
+
+Examples
+--------
+
+This is a bit of an experiment in test-driven language design.  I have
+a rough idea for how the language should work, so I'm going to
+write a bunch of programs in the language, as tests for an
+interpreter which doesn't exist yet.  Then I'm going to write
+the interpreter to make the tests pass.
+
+    -> Functionality "Interpret Deturgenchry Program" is implemented by
+    -> shell command "./deturgenchry %(test-file)"
+
+    -> Tests for functionality "Interpret Deturgenchry Program"
+
+Tiara Evaluation
+----------------
+
+A program consists of zero or more class definitions.  When a program
+is run, a class named `Main` is sought, an instance of it is created,
+and the nullary method `main` on it is invoked.
+
+    | class Main {
+    |   method main() {
+    |   }
+    | }
+    = Null
+
+    | class Arbitrage {
+    |   method main() {
+    |   }
+    | }
+    ? No Main class with main() method found
+
+    | class Main {
+    |   method harangue() {
+    |   }
+    | }
+    ? No Main class with main() method found
+
+    | class Main {
+    |   method main(n) {
+    |   }
+    | }
+    ? Too few parameters passed to method
+
+The main method may return control to the operating system (or whatever
+started running the program) by passing a value to `other`.
+
+    | class Main {
+    |   method main() {
+    |     pass other 5
+    |   }
+    | }
+    = IntVal 5
+
+Local variables may be assigned values.
+
+    | class Main {
+    |   method main() {
+    |     k = 5
+    |   }
+    | }
+    = Null
+
+Local variables may be referenced in expressions.
+
+    | class Main {
+    |   method main() {
+    |     k = 5
+    |     pass other k
+    |   }
+    | }
+    = IntVal 5
+
+Code in a method may instantiate objects of any class.
+
+    | class Junk {}
+    | class Main {
+    |   method main() { pass other new Junk }
+    | }
+    = ObjVal "Junk" []
+
+Classes don't have to have been defined yet to be referenced.
+
+    | class Main {
+    |   method main() { pass other new Junk }
+    | }
+    | class Junk {}
+    = ObjVal "Junk" []
+
+Classes don't even have to be defined at all, to be referenced.
+They're assumed to be "plain" classes in this case, with no relationship
+to any other classes.
+
+    | class Main {
+    |   method main() { pass other new Junk }
+    | }
+    = ObjVal "Junk" []
+
+A class may contain methods.  A method may be invoked on an instance
+in the usual fashion.
+
+    | class Junk {
+    |   method fire(n) {
+    |     pass other n
+    |   }
+    | }
+    | class Main {
+    |   method main() {
+    |     o = new Junk
+    |     k = o.fire(2)
+    |     pass other k
+    |   }
+    | }
+    = IntVal 2
+
+The number of actual parameters passed to a method must match the number
+of formal parameters the method declares.
+
+    | class Main {
+    |   method fire(a,b,c) { pass other b }
+    |   method main() {
+    |     o = new Main
+    |     k = o.fire(4,5,6)
+    |     pass other k
+    |   }
+    | }
+    = IntVal 5
+
+    | class Main {
+    |   method fire(a,b,c) { pass other b }
+    |   method main() {
+    |     o = new Main
+    |     k = o.fire(4,5)
+    |     pass other k
+    |   }
+    | }
+    ? Too few parameters passed to method
+
+    | class Main {
+    |   method fire(a,b,c) { pass other b }
+    |   method main() {
+    |     o = new Main
+    |     k = o.fire(4,5,6,7)
+    |     pass other k
+    |   }
+    | }
+    ? Too many parameters passed to method
+
+A method has access to the currently executing method: `self`.
+This value is actually a continuation.
+
+    | class Junk {
+    |   method fire() {
+    |     pass other self
+    |   }
+    | }
+    | class Main {
+    |   method main() {
+    |     o = new Junk
+    |     pass other o.fire()
+    |   }
+    | }
+    = ContVal (ObjVal "Junk" []) "fire" []
+
+Methods provide access to the object they're attached to.
+
+    | class Junk {
+    |   method fire() {
+    |     pass other self.object
+    |   }
+    | }
+    | class Main {
+    |   method main() {
+    |     o = new Junk
+    |     pass other o.fire()
+    |   }
+    | }
+    = ObjVal "Junk" []
+
+Deturgenchry is single-assignment.  It is not possible to assign to any
+parameter to the current method, or any variable that has already
+been bound, or to `self` or `other`.
+
+    | class Main {
+    |   method main() {
+    |     o = new Main
+    |     o = new Main
+    |     pass other o
+    |   }
+    | }
+    ? Attempted re-assignment of bound name o
+
+    | class Main {
+    |   method main() {
+    |     self = new Main
+    |     pass other self
+    |   }
+    | }
+    ? Attempted re-assignment of bound name self
+
+    | class Main {
+    |   method main() {
+    |     other = new Main
+    |     pass other new Main
+    |   }
+    | }
+    ? Attempted re-assignment of bound name other
+
+The standard if-else construct is a standard enough conditional.  There is no
+boolean type; there is only a special Null value, which represents falsehood.
+Everything else is truthy.
+
+    | class Bubkis {
+    | }
+    | class Main {
+    |   method main() {
+    |     if self {
+    |       pass other new Main
+    |     } else pass other new Bubkis
+    |   }
+    | }
+    = ObjVal "Main" []
+
+A method which doesn't pass anything back to other implicitly passes Null
+back to other.
+
+    | class Bubkis {
+    |    method fantastic() {}
+    | }
+    | class Main {
+    |   method main() {
+    |     b = new Bubkis
+    |     if b.fantastic() {
+    |         pass other new Main
+    |     } else pass other new Bubkis
+    |   }
+    | }
+    = ObjVal "Bubkis" []
+
+There is a built-in class called StdLib.  Instances of this class expose
+methods to do common useful things, like arithmetic.
+
+    | class Main {
+    |   method main() {
+    |     stdlib = new StdLib
+    |     pass other stdlib.gt(4, 5)
+    |   }
+    | }
+    = Null
+
+This is a complicated, contrived, syntactically correct Deturgenchry program.
+
+    | class binkie {
+    |   method foo() {
+    |       if self {} else {}
+    |   }
+    |   method bar(whee, y) {
+    |       if y
+    |         m = whee.x
+    |       else {
+    |         m = whee[x = y]
+    |       }
+    |       pass other m
+    |   }
+    | }
+    | class schmoo {
+    | }
+    | class Main {
+    |   method main() {
+    |     pass other new Main
+    |   }
+    | }
+    = ObjVal "Main" []

File src/Deturgenchry.hs

+module Deturgenchry where
+
+import Text.ParserCombinators.Parsec
+
+-- ========== MAPS ========== --
+
+data Map k v = Binding k v (Map k v)
+             | EmptyMap
+             deriving (Eq, Ord)
+
+get _ EmptyMap = Nothing
+get key (Binding key' val map)
+    | key == key' = Just val
+    | otherwise   = get key map
+
+set key val map = Binding key val (strip key map)
+
+strip key EmptyMap = EmptyMap
+strip key (Binding key' val map)
+    | key == key' = strip key map
+    | otherwise   = Binding key' val (strip key map)
+
+merge map EmptyMap = map
+merge map (Binding key val rest) =
+    merge (set key val map) rest
+
+instance (Show k, Show v) => Show (Map k v) where
+    show EmptyMap = "[]"
+    show (Binding k v map) = (show k) ++ "=" ++ (show v) ++ "\n" ++ show map
+
+-- ========== Grammar ========== --
+
+-- Program      ::= {ClassDefn}.
+-- ClassDefn    ::= "class" name "{" {MethodDefn} "}".
+-- MethodDefn   ::= "method" name "(" [name {"," name}] ")" Statement.
+-- Statement    ::= Block | Conditional | Transfer | Assignment.
+-- Block        ::= "{" {Statement} "}".
+-- Conditional  ::= "if" Expr Statement "else" Statement.
+-- Transfer     ::= "pass" Expr Expr.
+-- Assignment   ::= name "=" Expr.
+-- Expr         ::= RefExpr | "new" name | IntegerLiteral.
+-- RefExpr      ::= name {"." name} [SetExpr | CallExpr].
+-- SetExpr      ::= "[" name "=" Expr {"," name "=" Expr} "]".
+-- CallExpr     ::= "(" Expr {"," Expr} ")".
+
+-- ========== AST ========== --
+
+type Name = String
+
+data Program    = Program [ClassDefn]
+    deriving (Show, Ord, Eq)
+
+data ClassDefn  = ClassDefn Name [MethodDefn]
+    deriving (Show, Ord, Eq)
+
+data MethodDefn = MethodDefn Name [Name] Statement
+    deriving (Show, Ord, Eq)
+
+data Statement  = Block [Statement]
+                | Conditional Expr Statement Statement
+                | Transfer Expr Expr
+                | Assign Name Expr
+    deriving (Show, Ord, Eq)
+
+data Expr       = Get [Name]
+                | Call [Name] [Expr]
+                | Mod [Name] [(Name, Expr)]
+                | IntLit String
+                | New Name
+    deriving (Show, Ord, Eq)
+
+-- ========== PARSER ========== --
+
+name :: Parser Name
+name = do
+    c <- letter
+    cs <- many alphaNum
+    spaces
+    return (c:cs)
+
+classDefn :: Parser ClassDefn
+classDefn = do
+    string "class"
+    spaces
+    n <- name
+    string "{"
+    spaces
+    ms <- many (methodDefn)
+    string "}"
+    spaces
+    return (ClassDefn n ms)
+
+methodDefn :: Parser MethodDefn
+methodDefn = do
+    string "method"
+    spaces
+    n <- name
+    string "("
+    spaces
+    ps <- sepBy (name) (string "," >> spaces)
+    string ")"
+    spaces
+    s <- statement
+    return (MethodDefn n ps s)
+
+statement :: Parser Statement
+statement = (blockStatement <|> condStatement <|> xferStatement <|> assignment)
+
+blockStatement :: Parser Statement
+blockStatement = do
+    string "{"
+    spaces
+    ss <- many (statement)
+    string "}"
+    spaces
+    return (Block ss)
+
+condStatement :: Parser Statement
+condStatement = do
+    string "if"
+    spaces
+    e <- expr
+    s1 <- statement
+    string "else"
+    spaces
+    s2 <- statement
+    return (Conditional e s1 s2)
+
+xferStatement :: Parser Statement
+xferStatement = do
+    string "pass"
+    spaces
+    dest <- expr
+    stuff <- expr
+    return (Transfer dest stuff)
+
+assignment :: Parser Statement
+assignment = do
+    n <- name
+    string "="
+    spaces
+    e <- expr
+    return (Assign n e)
+
+expr :: Parser Expr
+expr = (try intLit) <|> (try newExpr) <|> refExpr
+
+intLit :: Parser Expr
+intLit = do
+    d <- digit
+    ds <- many digit
+    spaces
+    return (IntLit (d:ds))
+
+newExpr :: Parser Expr
+newExpr = do
+    string "new"
+    spaces
+    n <- name
+    return (New n)
+
+refExpr :: Parser Expr
+refExpr = do
+    names <- sepBy1 (name) (string ".")
+    spaces
+    e <- (modExpr names <|> callExpr names <|> getExpr names)
+    return e
+
+modExpr names = do
+    string "["
+    spaces
+    pairs <- sepBy1 (modification) (string "," >> spaces)
+    string "]"
+    spaces
+    return (Mod names pairs)
+  where
+    modification = do
+        n <- name
+        string "="
+        spaces
+        e <- expr
+        return (n, e)
+
+callExpr names = do
+    string "("
+    spaces
+    es <- sepBy (expr) (string "," >> spaces)
+    string ")"
+    spaces
+    return (Call names es)
+
+getExpr names = do
+    return (Get names)
+
+program :: Parser Program
+program = do
+    cs <- many (classDefn)
+    return (Program cs)
+
+-- ========== RUNTIME ========== --
+
+data ContObj = Ctx (Map Name Object)
+             | Obj Object
+             | Objs [Object]
+
+type Continuation = ContObj -> ContObj
+
+data ContV = ContV Continuation
+instance Show ContV where
+    show (ContV _) = ""
+instance Eq ContV where
+    ContV _ == ContV _ = False
+
+data Object = IntVal Integer
+            | ObjVal String (Map Name Object)
+            | ContVal (Map Name Object) ContV
+            | Self
+            | Null
+    deriving (Show, Eq)
+
+only name Nothing = error ("No such attribute " ++ name ++ " on value")
+only _ (Just x) = x
+
+getAttribute name (ObjVal c m) = only name (get name m)
+getAttribute name (ContVal m k) = only name (get name m)
+getAttribute name value = error ("Can't get attributes from value " ++ (show value))
+
+-- ========== INTERPRETER ========== --
+
+interpret prog = do
+    print (evalProg prog)
+
+---------------------------------------------------
+evalProg :: Program -> Object
+
+evalProg p =
+    case (getClass "Main" p) of
+        Nothing -> error "No Main class with main() method found"
+        Just mainClass ->
+            case (getMethod "main" mainClass) of
+                Nothing -> error "No Main class with main() method found"
+                Just mainMethod ->
+                    let
+                        final = ContV id
+                        r = callMethod p (ContVal EmptyMap final) mainMethod []
+                    in
+                        case r of
+                            Ctx c -> Null
+                            Obj o -> o
+
+getClass name (Program []) = Nothing
+getClass name (Program (c@(ClassDefn candidate _methods):rest))
+    | candidate == name = Just c
+    | otherwise         = getClass name (Program rest)
+
+getMethod name (ClassDefn _ []) = Nothing
+getMethod name (ClassDefn className (m@(MethodDefn candidate _args _stmt):rest))
+    | candidate == name = Just m
+    | otherwise         = getMethod name (ClassDefn className rest)
+
+callMethod p other (MethodDefn name formals stmt) actuals =
+    case (length actuals) - (length formals) of
+        0 ->
+            let
+                ctx = buildContext formals actuals
+                ctx' = set "self" Self ctx
+                ctx'' = set "other" other ctx'
+            in
+                evalStatement p ctx'' stmt id
+        n | n > 0 ->
+            error "Too many parameters passed to method"
+        n | n < 0 ->
+            error "Too few parameters passed to method"
+
+buildContext [] [] = EmptyMap
+buildContext (formal:formals) (actual:actuals) =
+    set formal actual (buildContext formals actuals)
+
+---------------------------------------------------
+evalStatement :: Program -> (Map Name Object) -> Statement -> Continuation -> ContObj
+
+evalStatement p ctx (Block []) cc =
+    Ctx ctx
+evalStatement p ctx (Block (stmt:rest)) cc =
+    evalStatement p ctx stmt (\(Ctx ctx') ->
+        evalStatement p ctx' (Block rest) cc)
+
+evalStatement p ctx (Conditional e s1 s2) cc =
+    evalExpr p ctx e (\(Obj value) ->
+        case value of
+            Null -> evalStatement p ctx s2 cc
+            _    -> evalStatement p ctx s1 cc)
+
+evalStatement p ctx (Transfer dest e) _ =
+    evalExpr p ctx e (\(Obj value) ->
+        evalExpr p ctx dest (\(Obj (ContVal m (ContV k))) ->
+            k $ Obj value))
+
+evalStatement p ctx (Assign name e) cc =
+    evalExpr p ctx e (\(Obj value) ->
+        case get name ctx of
+            Nothing -> cc $ Ctx $ set name value ctx
+            Just _  -> error ("Attempted re-assignment of bound name " ++ name))
+
+---------------------------------------------------
+evalExpr :: Program -> (Map Name Object) -> Expr -> Continuation -> ContObj
+
+evalExpr p ctx (Get [name]) cc =
+    case get name ctx of
+        Nothing -> error ("Name " ++ name ++ " not in scope")
+        Just val -> cc $ Obj val
+evalExpr p ctx (Get (name:names)) cc =
+    evalExpr p ctx (Get names) (\(Obj value) ->
+        cc $ Obj $ getAttribute name value)
+
+evalExpr p ctx (Call [localName, methodName] exprs) cc =
+    evalExprs p ctx exprs [] (\(Objs actuals) ->
+        evalExpr p ctx (Get [localName]) (\(Obj (ObjVal className attrs)) ->
+            let
+                Just klass = getClass className p
+                Just method = getMethod methodName klass
+                newOther = ContVal ctx $ ContV cc
+            in
+                callMethod p newOther method actuals))
+
+evalExpr p ctx (Mod names pairs) cc =
+    cc $ Obj Null
+
+evalExpr p ctx (IntLit i) cc =
+    cc $ Obj $ IntVal (evalIntLit i)
+
+evalExpr p ctx (New className) cc =
+    cc $ Obj $ ObjVal className EmptyMap
+
+---------------------------------------------------
+
+evalExprs p ctx [] vals cc =
+    cc $ Objs vals
+
+evalExprs p ctx (expr:exprs) vals cc =
+    evalExpr p ctx expr (\(Obj val) ->
+        evalExprs p ctx exprs (val:vals) cc)
+
+---------------------------------------------------
+
+evalIntLit [] = 0
+evalIntLit (d:ds) =
+    (evalIntLit ds) * 10 + (digitVal d)
+
+digitVal '0' = 0
+digitVal '1' = 1
+digitVal '2' = 2
+digitVal '3' = 3
+digitVal '4' = 4
+digitVal '5' = 5
+digitVal '6' = 6
+digitVal '7' = 7
+digitVal '8' = 8
+digitVal '9' = 9
+
+-- ========== DRIVER ========== --
+
+pa x = do
+  parseTest program x
+
+runDeturgenchry programText =
+    case parse (program) "" programText of
+        Left err -> error (show err)
+        Right prog -> show (evalProg prog)
+module Main where
+
+import System
+import Text.ParserCombinators.Parsec
+
+import Deturgenchry
+
+main = do
+    [fileName] <- getArgs
+    result <- parseFromFile (program) fileName
+    case (result) of
+        Left err -> do
+            print err
+            -- exitWith $ ExitFailure 1
+        Right prog -> do
+            interpret prog
+            -- exitWith $ ExitFailure 0
+#!/bin/sh
+
+cd bin && falderal -b test ../doc/Deturgenchry.markdown