Reimplement string literals

Author: engboris

examples/syntax.sg

@@ -1,33 +1,49 @@
-'static definition of constellation
-(:= x [
-  [+a]
+'define ray
+(:= a (-f X))
+
+'define star
+(:= b [(-f X)])
+
+'define constellation
+(:= c [
+  @[+a] 'focus
   [-a b]])
 
-(:= y #x)
+'full focus
+(show @[ [a] [b] [c] ])
+
+'identifier
+(:= x #a)
 
-(:= z (-f X))
+'union
+(:= x (union #a #b))
 
 'string literals
-'(:= w ["hello world"])
+(:= s ["hello world"])
 
 'cons
-(:= w [(+w [0 1 0 1 e])])
+' [0 1 e] == %cons(0 (%cons 1 %nil))
+(:= w (+w [0 1 0 1]))
+
+'stack
+' <s s 0> == (s (s 0))
+(:= n (+nat <s s 0>))
 
-'print result of execution
+'execution
 (:= x [(+f X) X])
 (:= y (-f a))
+(:= ex (exec (union #x #y)))    'non-linear
+(:= ex (linexec (union #x #y))) 'linear
+
+'show constellation
 <show exec (union @#x #y)>
+(show [ [a] [b] [c] ])
+(show #s)
 
 'complex identifiers
 (:= (f a b) [(function a b)])
 (show #(f a b))
 
-'show (literal) contellations
-(show [ [a] [b] [c] ])
-
-'full focus
-(show @[ [a] [b] [c] ])
-
 'inequality constraints
 (:= ineq [
   [(+f a)]
@@ -39,7 +55,7 @@
 'interactive debugging of execution
 '(trace #ineq)
 
-'dynamic definition of constellation
+'process
 (:= c (process
   (+n0 0)                 'base constellation
   [(-n0 X) (+n1 (s X))]   'interacts with previous
@@ -77,15 +93,16 @@
 '  [#1=>[(+f X) X)]]
 '  [#2=>(-f a)]>
 
-'checkers & typechecking
-(:= checker [
-  [+interaction (union @#tested #test)]
-  [+expect ok]])
-
+'define type
 (spec nat [
   [(-nat 0) ok]
   [(-nat (s N)) (+nat N)]])
 
+'expect
+(:= x 0)
+(== x 0)
+'(== x 1)
+
 'manual type checking
 (:= 0 (+nat 0))
 (:= test @(exec (union @#0 #nat)))

nvim/syntax/stellogen.vim

@@ -1,6 +1,6 @@
 syn clear
 
-syn keyword sgKeyword kill clean eval show use exec spec linear trace process run union
+syn keyword sgKeyword kill clean eval show use exec spec linexec trace process run union
 syn match sgComment "\s*'[^'].*$"
 syn match sgId "#\%(\l\|\d\)\w*"
 syn region sgComment start="'''" end="'''" contains=NONE

src/expr.ml

@@ -8,6 +8,7 @@ module Raw = struct
   type t =
     | Symbol of string
     | Var of ident
+    | String of string
     | Focus of t
     | Unquote of t
     | List of t list
@@ -32,6 +33,8 @@ let unquote_op = "#"
 
 let focus_op = "@"
 
+let string_op = primitive "string"
+
 let def_op = ":="
 
 let expect_op = "=="
@@ -55,6 +58,7 @@ let rec to_string : expr -> string = function
 let rec expand_macro : Raw.t -> expr = function
   | Raw.Symbol s -> Symbol s
   | Raw.Var x -> Var x
+  | Raw.String s -> List [ Symbol string_op; Symbol s ]
   | Raw.Unquote e' -> Unquote (expand_macro e')
   | Raw.Focus e' -> List [ Symbol focus_op; expand_macro e' ]
   | Raw.List es -> List (List.map ~f:expand_macro es)

src/lexer.ml

@@ -40,10 +40,34 @@ and read lexbuf =
   | '|' -> BAR
   | '\'' -> comment lexbuf
   | "'''" -> comments lexbuf
-  | '"' -> STRMARK
+  | '"' -> string_literal lexbuf
   | space | newline -> read lexbuf
   | eof -> EOF
   | _ ->
     raise
       (SyntaxError
          ("Unexpected character '" ^ Utf8.lexeme lexbuf ^ "' during lexing") )
+
+and string_literal lexbuf =
+  let buffer = Buffer.create 32 in
+  let rec loop () =
+    match%sedlex lexbuf with
+    | '"' -> STRING (Buffer.contents buffer)
+    | '\\', any ->
+        let escaped =
+          match%sedlex lexbuf with
+          | 'n' -> '\n'
+          | 't' -> '\t'
+          | '\\' -> '\\'
+          | '"' -> '"'
+          | _ -> failwith "Unknown escape sequence"
+        in
+        Buffer.add_char buffer escaped;
+        loop ()
+    | eof -> failwith "Unterminated string literal"
+    | any ->
+        Buffer.add_string buffer (Sedlexing.Utf8.lexeme lexbuf);
+        loop ()
+    | _ -> failwith "Invalid character in string literal"
+  in
+  loop ()

src/parser.mly

@@ -4,7 +4,7 @@ open Expr.Raw
 
 %token <string> VAR
 %token <string> SYM
-%token STRMARK
+%token <string> STRING
 %token AT
 %token BAR
 %token LPAR RPAR
@@ -39,6 +39,7 @@ let params :=
 let expr :=
   | ~=SYM; <Symbol>
   | ~=VAR; <Var>
+  | ~=STRING; <String>
   | UNQUOTE; ~=expr; <Unquote>
   | AT; ~=expr; <Focus>
   | ~=pars(expr+); <List>

src/sgen_ast.ml

@@ -27,12 +27,10 @@ and substitution =
   | SGal of ident * sgen_expr
 
 type err =
-  | ReservedWord of string
   | ExpectError of marked_constellation * marked_constellation * ident
   | UnknownID of string
 
-type env =
-  { objs : (ident * sgen_expr) list }
+type env = { objs : (ident * sgen_expr) list }
 
 let initial_env = { objs = [] }
 

src/sgen_eval.ml

@@ -95,9 +95,6 @@ let pp_err e : (string, err) Result.t =
   let open Lsc_ast.StellarRays in
   let open Printf in
   match e with
-  | ReservedWord x ->
-    sprintf "%s: identifier '%s' is reserved.\n" (red "ReservedWord Error") x
-    |> Result.return
   | ExpectError (x, e, Func ((Null, f), [])) when equal_string f "default" ->
     sprintf "%s:\n* expected: %s\n* got: %s\n" (red "Expect Error")
       (x |> remove_mark_all |> string_of_constellation)