home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / apteryx / example.ps < prev    next >
Text File  |  1994-01-27  |  1KB  |  46 lines
  1. (program example)
  2.  
  3. (uses wincrt wintypes winprocs)
  4.  
  5. (/* "Code to provide str facility in code generator")
  6. (const (LoadStringBufferLen 200) )
  7. (var (LoadStringBuffer PChar) )
  8.  
  9. (func LString ( (n integer) ) PChar
  10.   (begin
  11.     (LoadString HInstance n LoadStringBuffer LoadStringBufferLen)
  12.     (= LString LoadStringBuffer) ) )
  13.  
  14. (open-string-table "example" 1000)
  15.  
  16. (/* "This is a recursively defined factorial function")
  17. (func factorial ( (n longint) ) longint
  18.   (begin
  19.     (if (= 0 n)
  20.       (= factorial 1)
  21.       (= factorial (* n (factorial (- n 1)))) ) ) )
  22.  
  23. (var (i longint) )
  24. (var (factorials (array ( (.. 1 10) )longint)))
  25.  
  26. (def-stmt-macro from-one-to-ten (var &rest stmts)
  27.   `(for (,var 1 10) ,@stmts) )
  28.  
  29. (def-stmt-macro write2 (&rest items)
  30.   `(begin
  31.      ,@(mapcar
  32.          #'(lambda (item)
  33.              (if (eq item :nl) '(writeln) `(write ,item)) )
  34.          items) ) )
  35.  
  36. (module-begin
  37.   (GetMem LoadStringBuffer LoadStringBufferLen)
  38.   (write2 (str "Factorial numbers") :nl :nl
  39.     (str "  from 1 to 10") :nl :nl :nl)
  40.   (writeln)
  41.   (from-one-to-ten i
  42.     (= ([] factorials i) (factorial i) ) )
  43.   (from-one-to-ten i
  44.     (writeln i " = " ([] factorials i)) ) )
  45.  
  46.