Wibbles, notes, and the start of the bedrock library.

bedrock/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

bedrock/bedrock.cabal

@@ -0,0 +1,25 @@
+-- Initial bedrock.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                bedrock
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+license:             PublicDomain
+license-file:        LICENSE
+-- author:              
+-- maintainer:          
+-- copyright:           
+-- category:            
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  Hs-source-dirs:      src
+  exposed-modules:     Data.Bedrock,
+                       Data.Bedrock.Exceptions,
+                       Data.Bedrock.TypeCheck,
+                       Data.Bedrock.Evaluate
+  -- other-modules:       
+  build-depends:       base ==4.6.*, ansi-wl-pprint,
+                       parsec, containers, mtl

bedrock/examples/HelloException.rock

@@ -0,0 +1,22 @@
+main =
+    value, n := @withExceptionHandler exceptionHandler() throwException( (False) );
+    @print value;
+    @print n;
+
+    value, n := @withExceptionHandler exceptionHandler() throwException( (True) );
+    @print value;
+    @print n;
+
+    @return()
+
+exceptionHandler exception =
+    @return (exception, 1)
+
+throwException input =
+	case input of
+		True ->
+			@throw (Exception)
+		| False ->
+			@return( (NoException), 0 )
+
+

bedrock/examples/HelloWorld.rock

@@ -0,0 +1,4 @@
+main =
+	ptr := @store (HelloWorld);
+	@print ptr;
+	@exit

bedrock/examples/example.rock

@@ -0,0 +1,69 @@
+getHead ptr =
+	list := @fetch ptr;
+	case list of
+		  Nil ->
+		  	@alloc 2;
+			e := @store (Error 1);
+			@throw e
+	  	| Cons head tail ->
+			@unit head
+
+getHeadCps ptr exh cont =
+	list := @fetch ptr;
+	case list of
+		  Nil ->
+		  	@alloc 2;
+		  	e := @store (Error 1);
+			@tail apply exh, e
+	  	| Cons head tail ->
+			@tail apply cont, head
+
+storeLength exh cont = 
+	@alloc 3;
+	p := @store (lengthCps);
+	@tail apply cont, Just p
+
+length listPtr =
+	list := @fetch listPtr;
+	case list of
+		Nil ->
+			@unit 0
+		| Cons head tail ->
+			v := length tail;
+			l := @add v 1;
+			@unit l
+
+lengthCps listPtr cont =
+	list := @fetch listPtr;
+	case list of
+		Nil ->
+			@tail apply cont, 0
+		| Cons head tail ->
+			@alloc 2;
+			newCont := @store (lengthCps cont);
+			@tail lengthCps tail, newCont
+
+lengthCps cont n =
+	l := @add v 1;
+	@tail apply cont, l
+
+apply partial arg =
+	fn := @fetch partial;
+	case fn of
+		lengthCps cont _ ->
+			@tail lengthCps cont, arg
+		| printResult _ ->
+			@tail printResult arg
+
+throw e cont =
+	case cont of
+		lengthCps cont2 _ ->
+			@tail throw e, cont2
+		| ExceptionHandler handler cont ->
+			@tail handler e,cont
+
+withExceptionHandler cont handler partial =
+	exh := @store (ExceptionHandler handler, cont);
+	@tail apply partial, exh
+
+

bedrock/examples/exceptions.rock

@@ -0,0 +1,24 @@
+unsafeHead listPtr =
+    list := @fetch listPtr;
+    case listPtr of
+        Nil ->
+            e := @store (EmptyListException);
+            @throw e
+        | Cons head tail ->
+            @unit(head)
+
+safeHead onEmpty listPtr =
+    val := @withExceptionHandler safeHeadHandler(onEmpty) unsafeHead(listPtr);
+    @unit(val)
+
+safeHeadHandler onEmpty exception =
+    @unit(onEmpty)
+
+
+plus a b =
+    @unit()
+
+suspendedFunction =
+    ptr := @store (plus 10 _);
+    unsafeHead(ptr);
+    @unit()

bedrock/src/Data/Bedrock.hs

@@ -0,0 +1,75 @@
+module Data.Bedrock where
+
+data Name = Name
+	{ nameModule     :: [String]
+	, nameIdentifier :: String
+	, nameUnique     :: Int
+	} deriving (Show, Eq, Ord)
+data Type = NodePtr | RawNode | Primitive | MissingType
+	deriving (Show, Eq, Ord)
+data Variable = Variable
+	{ variableName :: Name
+	, variableType :: Type
+	} deriving (Show, Eq, Ord)
+
+data Module = Module
+	{ nodes     ::     [Node]
+	, functions :: [Function]
+	-- CAFs?
+	}
+
+data NodeName
+	= ConstructorName Name
+	| FunctionName Name Int
+		-- ^ name of the function and the number of missing arguments.
+	deriving (Show, Eq)
+
+data Node = Node
+	deriving (Show)
+
+data Function = Function
+	{ fnName      :: Name
+	, fnArguments :: [Variable]
+	, fnBody      :: Expression
+	} deriving (Show)
+
+data Pattern
+	= NodePat NodeName [Variable]
+	| LitPat Literal
+	deriving (Show)
+data Alternative = Alternative Pattern Expression
+	deriving (Show)
+
+data Literal
+	= LiteralInt Integer -- compile error if Integer to too large
+	deriving (Show, Eq)
+
+data Argument
+	= RefArg Variable
+	| LitArg Literal
+	| NodeArg NodeName [Argument]
+	deriving (Show)
+
+data SimpleExpression
+	= Literal Literal
+	| Application Name [Argument]
+	| WithExceptionHandler Name [Argument] Name [Argument]
+	-- Built-in
+	| Alloc Int
+	| Store NodeName [Argument]
+	| Fetch Variable
+	| Load Variable Int
+	| Add Argument Argument
+	| Print Variable
+	deriving (Show)
+
+data Expression
+	= Case Variable [Alternative] (Maybe Expression)
+	| Bind [Variable] SimpleExpression Expression
+	| Return [Argument]
+	| Throw Argument
+	| TailCall Name [Argument]
+	| Invoke Variable [Argument]
+	| Exit
+	deriving (Show)
+