Add prototype of evaluation

Author: engboris

examples/syntax.sg

@@ -35,20 +35,24 @@
 'interactive debugging of execution
 '(trace #ineq)
 
-'''
 'dynamic definition of constellation
-(def c (process
-  (const (star (+n0 0)))               'base constellation
-  (const (star (-n0 X) (+n1 (s X))))   'interacts with previous
-  (const (star (-n1 X) (+n2 (s X)))))) 'interacts with previous
-
-'galaxy definition
-(def g (galaxy
-  (test1 (const (star (+f a) ok)))
-  (test2 (const (star (+f b) ok)))))
-
+(:= c (process
+  (+n0 0)                 'base constellation
+  [(-n0 X) (+n1 (s X))]   'interacts with previous
+  [(-n1 X) (+n2 (s X))])) 'interacts with previous
+(show #c)
+
+'constellation with fields
+(:= g [
+  [+test1 [(+f a) ok]]
+  [+test2 [(+f b) ok]]])
 (show #g)
 
+'field access and evaluation
+<show eval exec (union #g @[-test1])>
+<show eval exec (union #g @[-test2])>
+
+'''
 'reactive effects
 (run (const
   (star (+&print X))

src/expr.ml

@@ -82,7 +82,7 @@ let symbol_of_str (s : string) : idfunc =
 let rec ray_of_expr : expr -> ray = function
   | Symbol s -> to_func ((Muted, symbol_of_str s), [])
   | Var s -> to_var s
-  | Unquote _ -> failwith "error: cannot unquote ray"
+  | Unquote e -> failwith ("error: cannot unquote ray " ^ to_string e)
   | List [] -> failwith "error: ray cannot be empty"
   | List (Symbol h :: t) ->
     to_func ((Muted, symbol_of_str h), List.map ~f:ray_of_expr t)
@@ -102,7 +102,7 @@ let rec raylist_of_expr (e : expr) : ray list =
   match e with
   | Symbol k when equal_string k nil_op -> []
   | Symbol _ | Var _ -> [ ray_of_expr e ]
-  | Unquote _ -> failwith "error: cannot unquote star"
+  | Unquote e -> failwith ("error: cannot unquote star " ^ to_string e) 
   | List [ Symbol s; h; t ] when equal_string s cons_op ->
     ray_of_expr h :: raylist_of_expr t
   | e -> failwith ("error: unhandled star " ^ to_string e)
@@ -118,7 +118,7 @@ let rec constellation_of_expr : expr -> marked_constellation = function
   | Symbol k when equal_string k nil_op -> []
   | Symbol s -> [ Unmarked { content = [ var (s, None) ]; bans = [] } ]
   | Var x -> [ Unmarked { content = [ var (x, None) ]; bans = [] } ]
-  | Unquote _ -> failwith "error: can't unquote constellation"
+  | Unquote e -> failwith ("error: can't unquote constellation" ^ to_string e)
   | List [ Symbol s; h; t ] when equal_string s cons_op ->
     star_of_expr h :: constellation_of_expr t
   | List g -> [ Unmarked { content = [ ray_of_expr (List g) ]; bans = [] } ]
@@ -154,20 +154,32 @@ let rec galaxy_expr_of_expr (e : expr) : galaxy_expr =
   (* union *)
   | List (Symbol k :: gs) when equal_string k "union" ->
     Union (List.map ~f:galaxy_expr_of_expr gs)
+  (* process *)
+  | List (Symbol k :: gs) when equal_string k "process" ->
+    Process (List.map ~f:galaxy_expr_of_expr gs)
+  (* kill *)
+  | List [ Symbol k; g ] when equal_string k "kill" ->
+    Kill (galaxy_expr_of_expr g)
+  (* clean *)
+  | List [ Symbol k; g ] when equal_string k "clean" ->
+    Clean (galaxy_expr_of_expr g)
   (* exec *)
   | List [ Symbol k; g ] when equal_string k "exec" ->
     Exec (galaxy_expr_of_expr g)
   (* linear exec *)
   | List [ Symbol k; g ] when equal_string k "linexec" ->
     LinExec (galaxy_expr_of_expr g)
-  (* raw constellation *)
+  (* linear exec *)
+  | List [ Symbol k; g ] when equal_string k "eval" ->
+    Eval (ray_of_expr g)
+  (* KEEP LAST -- raw constellation *)
   | List g -> Raw (Const (constellation_of_expr (List g)))
 
 (* ---------------------------------------
    Stellogen program of Expr
    --------------------------------------- *)
 
-let rec decl_of_expr : expr -> declaration = function
+let decl_of_expr : expr -> declaration = function
   (* definition := *)
   | List [ Symbol k; x; g ] when equal_string k def_op ->
     Def (ray_of_expr x, galaxy_expr_of_expr g)

src/sgen_ast.ml

@@ -34,6 +34,7 @@ and galaxy_expr =
   | Clean of galaxy_expr
   | Kill of galaxy_expr
   | Process of galaxy_expr list
+  | Eval of ray
 
 and substitution =
   | Extend of ray_prefix

src/sgen_eval.ml

@@ -81,6 +81,7 @@ and map_galaxy_expr env ~f : galaxy_expr -> (galaxy_expr, err) Result.t =
   | Process gs ->
     let* procs = List.map ~f:(map_galaxy_expr env ~f) gs |> Result.all in
     Process procs |> Result.return
+  | Eval e -> Eval e |> Result.return
 
 let rec replace_id env (_from : ident) (_to : galaxy_expr) e :
   (galaxy_expr, err) Result.t =
@@ -114,7 +115,7 @@ let rec replace_id env (_from : ident) (_to : galaxy_expr) e :
   | Process gs ->
     let* procs = List.map ~f:(replace_id env _from _to) gs |> Result.all in
     Process procs |> Result.return
-  | Raw _ | Id _ -> e |> Result.return
+  | Raw _ | Id _ | Eval _ -> e |> Result.return
 
 let subst_vars env _from _to =
   map_galaxy_expr env ~f:(subst_all_vars [ (_from, _to) ])
@@ -296,6 +297,16 @@ and eval_galaxy_expr ~notyping (env : env) :
   | Subst (e, SGal (x, _to)) ->
     let* fill = replace_id env x _to e in
     eval_galaxy_expr ~notyping env fill
+  | Eval e ->
+    let* eval_e = Expr.galaxy_expr_of_expr (expr_of_ray e)
+      |> eval_galaxy_expr ~notyping env in
+    eval_galaxy_expr ~notyping env (Raw eval_e)
+
+and expr_of_ray = function
+  | Var (x, None) -> Expr.Var x
+  | Var (x, Some i) -> Expr.Var (x ^ Int.to_string i)
+  | Func (pf, args) ->
+    Expr.List (Symbol (Lsc_ast.string_of_polsym pf) :: List.map ~f:expr_of_ray args)
 
 and galaxy_to_constellation ~notyping env :
   galaxy -> (marked_constellation, err) Result.t = function