Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 2cf8e0fa12
Fetching contributors…

Cannot retrieve contributors at this time

248 lines (209 sloc) 6.809 kb
# Prelude is where we define macros that std.lsr uses
#
# primitives
#
# eq a b -> true if they are equal or false otherwise
#
# getType value -> an option containing the type
#
# is value type -> true if the value has type type, false otherwise
#
# eval ast -> evaluates ast and returns the result
#
# parse string -> an Either with ast or error msg (give it two functions)
#
# pretty value -> pretty print a value
#
# funcSource func -> option with function's src or none if no source (e.g. primitive or lambda)
#
# MONADS
#
# bind m binding -> transform a monad with a function and continue with result of function
#
# print string -> print a string and continue with false
#
# prompt string -> ask user for input and continue with value
#
# return value -> continus with value
#
# js string -> run JS code and continue with value
#
# createS -> create a new state variable and continue with it
#
# getS var -> get the value from the state variable var and continue with it
#
# setS var val -> set the state variable var to val and continue with false
#
# STRING functions
#
# concat list -> string
#
# AST-constructors
#
# lit value -> a lit AST node, containing value
#
# ref var-name -> a ref AST node, containing var-name
#
# lambda var-name body-ast -> a lambda AST node, with var-name and the body AST
#
# apply func-ast body-ast -> an apply AST node, with func and body ASTs
#
# prim arg rest-ast -> a prim AST node, rest-ast should either be a ref or a prim
#
#@auto
defGroup '[' ']'
#@auto
defGroup 'concat[' ']'
#@auto
defToken '|'
#@auto
defToken ','
#@auto
defToken '<-'
id x = x
# make a new function that takes two args in opposite order than the original function
# eq. flip cons nil 1 gives cons: [1]
flip f = \a b . f b a
compose f g = \x . f ( g x)
# The Y combinator, for reference
#
# Y = \g . (\x . g (x x)) \x . g (x x)
# rec = \f . f (Y f)
# booleans
true = \a b . a
false = \a b . b
and a b = a b false
or a = a true
not a = a false true
neq a b = not (eq a b)
# choices
left v = \l r . l v
right v = \l r . r v
some x = \yes no . yes x
some2 a b = \yes no . yes a b
none = \yes no . no
# numerics
iszero = eq 0
positive = < 0
-- = (flip -) 1
++ = + 1
even? x = iszero (% x 2)
odd? x = eq 1 (% x 2)
max a b = (gt a b) a b
min a b = (lt a b) a b
# some basic list functions
# some list functions are primitives, for the time being: cons, nil
# cons a b = \f . f a b
# nil = \a b . b
isStream x = false
isStream x::cons = true
isStream x::lexCons = true
head l::cons = l \h t . h
tail l::cons = l \h t . t
head l::lexCons = l \h s t e . h
tail l::lexCons = l \h s t e . t
length l = (eq l nil) 0 (++ (length (tail l) ) )
last l = eq (tail l) nil
head l
last (tail l)
startPos l::lexCons = lexStart l
startPos t::token = t \t p . p
endPos l::lexCons = lexEnd l
endPos t::token = + (tokenStart t) (strlen (tokenName t))
pairFunc l = false
pairFunc l::cons = cons
pairFunc l::lexCons = lexConsFuzzy
pairFunc l::token = lexConsFuzzy
lexConsFuzzy h t = null? t
lexCons h (startPos h) nil (endPos h)
lexCons h (startPos h) t (endPos t)
null? x = false
null? x::nil = true
# make a new list by applying func (which takes exactly 1 arg) to each element of list
# eg. map (+ 1) [4 27 54] gives cons: [5 28 55]
map func list = _map (pairFunc list) func list
_map pairF func list = null? list
nil
pairF (func (head list)) (_map pairF func (tail list))
# foldl (\prev el . ...) list
# foldr (\el prev . ...) list
# call func on list items and previous result of fold
# foldl uses the head of the list for the previous results
# foldr uses the tail of the list for the previous results
# foldr can work on infinite lists, but foldl cannot
foldl func arg list = foldl func (func arg (head list)) (tail list)
foldl func arg list::nil = arg
foldl1 func list = foldl func (head list) (tail list)
foldl1 func list::nil = nil
foldr func arg list = null? list
arg
func (head list) (foldr func arg (tail list))
foldr1 func list = eq (tail list) nil
head list
func (head list) (foldr1 func (tail list))
foldr1 func list::nil = nil
append l1 l2 = _append (pairFunc l1) l1 l2
append l1::nil l2 = l2
_append pairF l1 l2 = pairF (head l1) (_append pairF (tail l1) l2)
_append pairF l1::nil l2 = l2
reverse l = subreverse l nil
subreverse l result = l (\h t D . subreverse t (cons h result)) result
if = id
at l x = (iszero (x)) (head l) (at (tail l) (-- (x) ) )
index_combine x y = (or (eq x nil) (eq y nil)) (nil) (+ x y)
# return nil if not found, or 0 based index of the first match
indexof l x = if (eq l nil) (nil) (if (eq x (head l)) (0) (index_combine 1 (indexof (tail l) x ) ) )
# position does the same thing as indexof, but takes the args in opposite order
position l x = indexof x l
# Macros
#
# List constructor macro
#
# pure Lambda Calculus list constructor, for reference
#[ =(]= \item c . c \rest . cons item rest
#, =.= \f item c . c \rest . f (cons item rest)
#] =)= \f . f nil
#| =.= \f rest g . f rest
[ list =M= constructList (tail list)
constructList list = cl (head list) (tokString (head list)) (tail list)
constructList list::nil = nil
cl h hs t = eq hs '|'
eq (length t) 2
# -- scanner ensures: eq (tokString (head (tail t))) ']'
cons (head t) nil
error "Bad list format."
eq hs ']'
# -- scanner ensures: eq t nil
cons 'nil' nil
eq hs ','
constructList t
cons (cons 'cons' (cons h (constructList t))) nil
tokString x = x
tokString t::token = t \t p . t
identMacro list =M= tail list
macroCons list =M= cons 'cons' (tail list)
concat[ list =M= cons 'concat' (cons (cons '[' (tail list)) nil)
doFilter parseDefs list = transformDo list
transformDo list = list
transformDo list::cons = subDos list
transformDo list::lexCons = subDos list
subDos list = eq 'do' (tokString (head list))
foldr1 (\el . doClause el) (subNextDos (tail list))
subNextDos list
subNextDos nonlist = nonlist
subNextDos list::cons = listSubNextDos list
subNextDos list::lexCons = listSubNextDos list
listSubNextDos list = eq '.' (tokString (head list))
cons (head list) (transformDo (tail list))
cons (transformDo (head list)) (subNextDos (tail list))
doClause clause rest = doExtractVar clause '<-'
\var . cons 'bind' (cons (tail (tail clause)) (cons '\\' (cons var (cons '.' (cons rest nil)))))
doExtractVar clause '='
\var . cons (cons '\\' (cons var (cons '.' (cons rest nil)))) (cons (tail (tail clause)) nil)
cons 'bind' (cons clause (cons '\\' (cons '_' (cons '.' (cons rest nil)))))
doExtractVar list tokName = none
doExtractVar list::cons tokName = listDoExtractVar list tokName
doExtractVar list::lexCons tokName = listDoExtractVar list tokName
listDoExtractVar list tokName = or (null? (tail list)) (neq tokName (tokString (head (tail list))))
none
some (head list)
Jump to Line
Something went wrong with that request. Please try again.