SHARE
TWEET

Untitled

a guest Mar 26th, 2019 73 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (*
  2. HX-2019-03-26:
  3.  
  4. The original code is available at
  5. https://gist.github.com/ashalkhakov/c3577e97b20020fde31f84447fd1e056
  6.  
  7. I turned runCommand into a polymorphic function and
  8. also made Command a linear datatype (i.e., dataviewtype)
  9.  
  10. *)
  11.  
  12. (*
  13.  
  14. inspired by this discussion:
  15.  
  16. https://groups.google.com/forum/#!topic/ats-lang-users/fICcWumT9RE
  17.  
  18. runnable over at glot.io:
  19.  
  20. https://glot.io/snippets/fapb07meuz
  21.  
  22. to build and run:
  23.  
  24. patscc -DATS_MEMALLOC_LIBC main.dats && a.out
  25. *)
  26. #include
  27. "share/atspre_staload.hats"
  28.  
  29. %{
  30.  
  31. // NOTE: this is really from ATS2 prelude
  32. // (newer version of prelude includes this)
  33. extern
  34. atstype_ptr
  35. atspre_fileref_get_line_string_main2
  36. (
  37.   atstype_int bsz0
  38. , atstype_ptr filp0
  39. , atstype_ref nlen0 // int *nlen
  40. )
  41. {
  42. //
  43.   int bsz = bsz0 ;
  44.   int ofs1 = 0, ofs2 = 0;
  45.   int *nlen = (int*)nlen0;
  46.   FILE *filp = (FILE*)filp0 ;
  47.   char *buf1, *buf2, *pres ;
  48. //
  49.   buf1 = atspre_malloc_gc(bsz) ;
  50. //
  51.   while (1) {
  52.     buf2 = buf1+ofs1 ;
  53.     pres = fgets(buf2, bsz-ofs1, filp) ;
  54.     if (!pres)
  55.     {
  56.       if (feof(filp))
  57.       {
  58.         *buf2 = '\0' ;
  59.         *nlen = ofs1 ; return buf1 ;
  60.       } else {
  61.         atspre_mfree_gc(buf1) ;
  62.         *nlen = -1 ; return (char*)0 ;
  63.       } // end of [if]
  64.     }
  65. //
  66.     ofs2 = strlen(buf2) ;
  67. //
  68.     if
  69.     (ofs2 > 0) ofs1 += ofs2 ; else return buf1;
  70. //
  71. // HX: ofs1 > 0 holds at this point
  72. // HX: the newline symbol needs to be trimmed:
  73. //
  74.     if(
  75.     buf1[ofs1-1]=='\n'
  76.     ) {
  77.     buf1[ofs1-1] = '\0'; *nlen = ofs1-1 ; return buf1 ;
  78.     } // end of [if]
  79. //
  80. // HX: there is room // so there are no more chars:
  81. //
  82.     if (ofs1+1 < bsz) { ( *nlen = ofs1 ) ; return buf1 ; }
  83. //
  84. // HX: there is no room // another call to [fgets] is needed:
  85. //
  86.     bsz *= 2 ;
  87.     buf2 = buf1 ;
  88.     buf1 = atspre_malloc_gc(bsz) ;
  89.     memcpy(buf1, buf2, ofs1) ; atspre_mfree_gc(buf2) ;
  90.   } // end of [while]
  91. //
  92.   return buf1 ; // HX: this is really deadcode
  93. //
  94. } // end of [atspre_fileref_get_line_string_main2]
  95.    
  96. %}
  97.  
  98. (* ****** ****** *)
  99.  
  100. // well, this is untested and may be ignored.
  101. // initially this block was introduced so that
  102. // we might allocate the temporaries for "binds" on stack
  103. %{^
  104.  
  105. #include <alloca.h>
  106.  
  107. #if __STDC_VERSION__ >= 201112L /* C11 */
  108.  
  109. #include <stdalign.h>
  110.  
  111. #define ALIGN_OF(type) (alignof(type))
  112.  
  113. #else /* not C11 */
  114.  
  115. #define ALIGN_OF(type) ((size_t)&((struct { char c; type d; } *)0)->d)
  116.  
  117. #endif
  118.  
  119. // using GCC "statement expressions"
  120. #define ALLOCA_TYPE(type) ({ \
  121.    const int align = ALIGN_OF(type); \
  122.    const int n = sizeof(type); \
  123.    void *p = alloca(n + align - 1); \
  124.    (type *)(((UINT_PTR)p + (ALIGN_OF(type) - 1)) & ~(ALIGN_OF(type) - 1)); \
  125. })
  126.  
  127. %}
  128.  
  129. (* ****** ****** *)
  130.  
  131. // an abstract type of "commands"
  132. absvtype
  133. Command_vtype(a:vtype) = ptr
  134. vtypedef Command(a:vtype) = Command_vtype(a)
  135.  
  136. // a command interpreter
  137. // NOTE: it requires the user to provide a continuation
  138. extern
  139. fun
  140. runCommand
  141. {a:vtype}
  142. (c:Command(a:vtype)): (a)
  143.  
  144. // the returned command will perform c1, then c2
  145. extern
  146. fun seq
  147. (c1:Command(unit), c2: Command(unit)): Command(unit)
  148.  
  149. // a more powerful sequencing operator: this feeds the output of c1
  150. // into c2
  151. extern
  152. fun
  153. bind
  154. {a:vtype}{b:vtype}
  155. (c1:Command(a), c2: a -<cloptr1> Command(b)): Command(b)
  156.  
  157. // build a command that will provide us with input from  user
  158. extern
  159. fun cread (): Command(string)
  160. // build a command to print a string to console
  161. extern
  162. fun cprint (s:string): Command(unit)
  163.  
  164. (* ****** ****** *)
  165.  
  166. extern
  167. fun
  168. fgetstring
  169.   (inp: FILEref): string
  170.  
  171. local
  172.  
  173. // the command sub-language
  174. datavtype
  175. Command(vtype) =
  176.   | Nop(unit)
  177.   | Read(string)
  178.   | Print(unit) of string
  179.   | Seq(unit) of (Command(unit), Command(unit))
  180.   | {a,b:vtype} Bind(b) of (Command(a), a -<cloptr1> Command(b))
  181.  
  182. assume Command_vtype = Command
  183.  
  184. in // in of [local]
  185.  
  186. implement
  187. cprint (s) = Print s
  188. implement
  189. cread () = Read ()
  190. implement
  191. seq(c1, c2) = Seq(c1, c2)
  192. implement
  193. bind{a}{b}(c1, fc2) = Bind(c1, fc2)
  194.  
  195. implement
  196. fgetstring (inp) = let
  197. //
  198. var nlen: int // uninitialized
  199. val line = fileref_get_line_string_main(inp, nlen)
  200. prval () = lemma_strnptr_param(line)
  201. //
  202. in
  203.   g0ofg1(strnptr2string(line))
  204. end // end of [fgetstring]
  205.  
  206. implement
  207. runCommand{a}(c) =
  208.   case+ c of
  209.   | ~Nop() => unit
  210.   | ~Print(s) =>
  211.     let val () = print (s) in unit end
  212.   | ~Read() => fgetstring(stdin_ref)
  213.   | ~Seq (c1, c2) =>
  214.     let val _ = runCommand(c1) in runCommand(c2) end
  215.   | ~Bind(c1, fc2) =>
  216.     let
  217.       val r1 = fc2(runCommand(c1))
  218.     in
  219.       cloptr_free($UNSAFE.castvwtp0{cloptr(void)}(fc2)); runCommand(r1)
  220.     end
  221.  
  222. end // end of [local]
  223. //
  224. (* ****** ****** *)
  225.  
  226. extern
  227. fun
  228. test0 (): void
  229. implement
  230. test0 () = let
  231.   val hello =
  232.   let val h1 = cprint "hi" val h2 = cprint "hi" in seq (h1, h2) end // here. twice the effect!
  233.   val hello = seq (hello, cprint "\n")
  234.   val unit() = runCommand (hello)
  235.  
  236.   // a bigger program
  237.   // (this one shows how the interpreter interacts with the command-building
  238.   // process, which is our program)
  239.   val greet = let
  240.     val h = cprint "what is your name?\n"
  241.     val g = cread ()
  242.     val f = lam (name) =<cloptr1> seq (cprint "hello, ", seq (cprint name, cprint "\n"))
  243.   in
  244.     seq (h, bind (g, f))
  245.   end
  246.   val unit() = runCommand (greet)
  247. in
  248.   (*nop*)
  249. end
  250.  
  251. implement
  252. main0 () = test0 ()
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top