Support symbolic variables

ml-proto/README.md

@@ -155,8 +155,7 @@ type: i32 | i64 | f32 | f64
 memtype: <type> | i8 | i16
 
 value: <int> | <float>
-var: <int>
-name: "<char>*"
+var: <int> | $<name>
 
 unop:  neg | abs | not | ...
 binop: add | sub | mul | ...
@@ -169,7 +168,7 @@ expr:
   ( if <expr> <expr> <expr> )
   ( if <expr> <expr> )                ;; = (if <expr> <expr> (nop))
   ( loop <expr>* )                    ;; = (loop (block <expr>*))
-  ( label <expr>* )                   ;; = (label (block <expr>*))
+  ( label <name>? <expr>* )           ;; = (label (block <expr>*))
   ( break <var> <expr>* )
   ( break )                           ;; = (break 0)
   ( switch.<type> <expr> <case>* <expr> )
@@ -195,14 +194,14 @@ case:
   ( case <value> <expr>* fallthru? )  ;; = (case <int> (block <expr>*) fallthru?)
   ( case <value> )                    ;; = (case <int> (nop) fallthru)
 
-func:   ( func <param>* <result>* <local>* <expr>* )
-param:  ( param <type>* )
+func:   ( func <name>? <param>* <result>* <local>* <expr>* )
+param:  ( param <type>* ) | ( param <name> <type> )
 result: ( result <type>* )
-local:  ( local <type>* )
+local:  ( local <type>* ) | ( local <name> <type> )
 
 module: ( module <func>* <global>* <export>* <table>* <memory>? <data>* )
-global: ( global <type>* )
-export: ( export <name> <var> )
+export: ( export "<char>*" <var> )
+global: ( global <type>* ) | ( global <name> <type> )
 table:  ( table <var>* )
 memory: ( memory <int> <int>? )
 data:   ( data "<char>*" )

ml-proto/src/ast.ml

@@ -2,6 +2,25 @@
  * (c) 2015 Andreas Rossberg
  *)
 
+(*
+ * Throughout the implementation we use consistent naming conventions for
+ * syntactic elements, associated with the types defined here and in a few
+ * other places:
+ *
+ *   x : var
+ *   v : value
+ *   e : expr
+ *   f : func
+ *   m : modul
+ *
+ *   t : value_type
+ *   s : func_type
+ *   c : context / config
+ *
+ * These conventions mostly follow standard practice in language semantics.
+ *)
+
+
 open Values
 
 
@@ -97,7 +116,7 @@ and func' =
 }
 
 type export = export' Source.phrase
-and export' = {name : string; func : var }
+and export' = {name : string; func : var}
 
 type table = var list Source.phrase
 

ml-proto/src/check.ml

@@ -27,8 +27,7 @@ type context =
 }
 
 let lookup category list x =
-  try List.nth list x.it
-  with Failure _ ->
+  try List.nth list x.it with Failure _ ->
     error x.at ("unknown " ^ category ^ " " ^ string_of_int x.it)
 
 let func c x = lookup "function" c.funcs x
@@ -38,6 +37,7 @@ let global c x = lookup "global" c.globals x
 let table c x = lookup "table" c.tables x
 let label c x = lookup "label" c.labels x
 
+
 (* Type comparison *)
 
 let check_type actual expected at =
@@ -264,17 +264,18 @@ let check_func c f =
                   returns = List.map it results} in
   check_expr c' (List.map it results) e
 
-let check_table c table =
-  match table.it with
+let check_table c tab =
+  match tab.it with
   | [] ->
-    error table.at "empty table"
+    error tab.at "empty table"
   | x::xs ->
     let s = func c x in
     List.iter (fun xI -> check_func_type (func c xI) s xI.at) xs;
     {c with tables = c.tables @ [s]}
 
-let check_export c x =
-  ignore (func c x.it.func)
+let check_export c ex =
+  let {name = _; func = x} = ex.it in
+  ignore (func c x)
 
 let check_module m =
   let {funcs; exports; tables; globals; memory; data} = m.it in

ml-proto/src/eval.ml

@@ -41,8 +41,7 @@ type config =
 }
 
 let lookup category list x =
-  try List.nth list x.it
-  with Failure _ ->
+  try List.nth list x.it with Failure _ ->
     error x.at ("runtime: undefined " ^ category ^ " " ^ string_of_int x.it)
 
 let func c x = lookup "function" c.modul.funcs x
@@ -259,15 +258,16 @@ and eval_func m f vs =
 let init m =
   let {Ast.funcs; exports; tables; globals; memory = (n, _); data} = m.it in
   let memory = Memory.create (Int64.to_int n) in
-  let add_to_map m x = ExportMap.add x.it.name (List.nth funcs x.it.func.it) m in
-  let exports = List.fold_left add_to_map ExportMap.empty exports in
-  let tables = List.map (fun t -> List.map (fun x -> List.nth funcs x.it) t.it) tables in
-  let globals = List.map eval_decl globals in
   Memory.init memory data;
-  { funcs; exports; tables; globals; memory }
+  let func x = List.nth funcs x.it in
+  let export ex = ExportMap.add ex.it.name (func ex.it.func) in
+  let exports = List.fold_right export exports ExportMap.empty in
+  let tables = List.map (fun tab -> List.map func tab.it) tables in
+  let globals = List.map eval_decl globals in
+  {funcs; exports; tables; globals; memory}
 
-let invoke m x vs =
-  let f = export m (x @@ Source.no_region) in
+let invoke m name vs =
+  let f = export m (name @@ no_region) in
   eval_func m f vs
 
 let eval e =

ml-proto/src/lexer.mll

@@ -106,7 +106,7 @@ let num = ('+' | '-')? digit+
 let int = num
 let float = (num '.' digit+) | num ('e' | 'E') num
 let text = '"' character* '"'
-let atom = (letter | digit | '_' | tick | symbol)*
+let name = '$' (letter | digit | '_' | tick | symbol)+
 
 let ixx = "i" ("32" | "64")
 let fxx = "f" ("32" | "64")
@@ -255,6 +255,8 @@ rule token = parse
   | "invoke" { INVOKE }
   | "asserteq" { ASSERTEQ }
 
+  | name as s { VAR s }
+
   | ";;"[^'\n']*eof { EOF }
   | ";;"[^'\n']*'\n' { Lexing.new_line lexbuf; token lexbuf }
   | "(;" { comment (Lexing.lexeme_start_p lexbuf) lexbuf; token lexbuf }